- py-configparser-cvs@common-lisp.net - mailman3.common-lisp.net

[py-configparser-cvs] r21 - in branches/1.0.x: . tests
by ehuelsmann＠common-lisp.net 14 Mar '08

14 Mar '08

Author: ehuelsmann Date: Fri Mar 14 17:26:31 2008 New Revision: 21 Modified: branches/1.0.x/LICENSE (contents, props changed) branches/1.0.x/README (contents, props changed) branches/1.0.x/config.lisp (contents, props changed) branches/1.0.x/package.lisp (contents, props changed) branches/1.0.x/parser.lisp (contents, props changed) branches/1.0.x/py-configparser.asd (contents, props changed) branches/1.0.x/tests/py-configparser-tests.asd (contents, props changed) branches/1.0.x/tests/tests.lisp (contents, props changed) Log: Merge -r19 from trunk (DECLAIM fix and setting of properties). Modified: branches/1.0.x/LICENSE ============================================================================== --- branches/1.0.x/LICENSE (original) +++ branches/1.0.x/LICENSE Fri Mar 14 17:26:31 2008 @@ -1,23 +1,23 @@ -(This is the MIT / X Consortium license as taken from - http://www.opensource.org/licenses/mit-license.html) - -Copyright (c) 2008 Erik Huelsmann - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE -LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION -OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2008 Erik Huelsmann + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Modified: branches/1.0.x/README ============================================================================== --- branches/1.0.x/README (original) +++ branches/1.0.x/README Fri Mar 14 17:26:31 2008 @@ -1,52 +1,52 @@ -$URL$ -$Id$ - -py-configparser -=============== - -This package provides the same functionality as the Python configparser module, -implemented in pure Common Lisp. - - -Differences between the two -=========================== - -The CL version makes a strong distinction in the parser on one hand and the in-memory -storage management on the other hand. Because of it, the CL version doesn't call its -objects 'Parser', but 'config' instead. - -The parser/writer part of the package provides the three functions READ-STREAM, -READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' -and 'write'. - - -API mapping -=========== - -The functions provided in the Python module (which are all methods of the ConfigParser -class): - -ConfigParser() -> (make-config) -defaults() -> (defaults <config>) -sections() -> (sections <config>) -add_section(name) -> (add-section <config> name) -has_section(name) -> (has-section-p <config> name) -options(section_name) -> (options <config> section-name) -has_option(section_name, name) -> (has-option-p <config> section-name name) -read(filenames) -> (read-files <config> filenames) -readfd(fp) -> (read-stream <config> stream) -get(section, option[, raw[, vars]]) -> - (get-option <config> section option &key expand defaults type) -getint(section, option) -> [folded into get-option using 'type' key] -getfloat(section, option) -> [folded into get-option using 'type' key] -getboolean(section, option) -> [folded into get-option using 'type' key] -items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) -set(section, option, value) -> (set-option <config> section-name option-name value) -write(fp) -> (write-stream <config> stream) -remove_option(section, option) -> (remove-option <config> section-name option-name) -remove_section(section) -> (remove-section <config> section-name) - -Note that the above is just a simple mapping table, but is all you need to get -you started. Documentation from the ConfigParser module should sufficiently document -this package. However minor differences in parameter and method naming may occur. - +$URL$ +$Id$ + +py-configparser +=============== + +This package provides the same functionality as the Python configparser module, +implemented in pure Common Lisp. + + +Differences between the two +=========================== + +The CL version makes a strong distinction in the parser on one hand and the in-memory +storage management on the other hand. Because of it, the CL version doesn't call its +objects 'Parser', but 'config' instead. + +The parser/writer part of the package provides the three functions READ-STREAM, +READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' +and 'write'. + + +API mapping +=========== + +The functions provided in the Python module (which are all methods of the ConfigParser +class): + +ConfigParser() -> (make-config) +defaults() -> (defaults <config>) +sections() -> (sections <config>) +add_section(name) -> (add-section <config> name) +has_section(name) -> (has-section-p <config> name) +options(section_name) -> (options <config> section-name) +has_option(section_name, name) -> (has-option-p <config> section-name name) +read(filenames) -> (read-files <config> filenames) +readfd(fp) -> (read-stream <config> stream) +get(section, option[, raw[, vars]]) -> + (get-option <config> section option &key expand defaults type) +getint(section, option) -> [folded into get-option using 'type' key] +getfloat(section, option) -> [folded into get-option using 'type' key] +getboolean(section, option) -> [folded into get-option using 'type' key] +items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) +set(section, option, value) -> (set-option <config> section-name option-name value) +write(fp) -> (write-stream <config> stream) +remove_option(section, option) -> (remove-option <config> section-name option-name) +remove_section(section) -> (remove-section <config> section-name) + +Note that the above is just a simple mapping table, but is all you need to get +you started. Documentation from the ConfigParser module should sufficiently document +this package. However minor differences in parameter and method naming may occur. + Modified: branches/1.0.x/config.lisp ============================================================================== --- branches/1.0.x/config.lisp (original) +++ branches/1.0.x/config.lisp Fri Mar 14 17:26:31 2008 @@ -1,297 +1,297 @@ - -(cl:in-package :py-configparser) - -;; The conditions (errors) - -(define-condition configparser-error (error) ()) - -;; Errors for the configuration management side -(define-condition config-error (configparser-error) ()) -(define-condition no-section-error (config-error) ()) -(define-condition duplicate-section-error (config-error) ()) -(define-condition no-option-error (config-error) ()) -(define-condition interpolation-error (config-error) ()) -(define-condition interpolation-depth-error (interpolation-error) ()) -(define-condition interpolation-missing-option-error (interpolation-error) ()) -(define-condition interpolation-syntax-error (interpolation-error) ()) - - -;; -;; Configuration storage and management routines -;; - - -;; The structures -;; Note: because ABCL has issues with its CLOS support -;; (as per 1-1-2008), we use structures below to -;; be maximally portable. - - -(defstruct section - name - options) - -(defstruct config - (defaults (make-section :name "DEFAULT")) - sections - (option-name-transform-fn #'string-downcase) - (section-name-transform-fn #'identity)) - -(defun norm-option-name (config option-name) - (funcall (config-option-name-transform-fn config) option-name)) - -(defun norm-section-name (config section-name) - (funcall (config-section-name-transform-fn config) section-name)) - -(defun %validate-section-name (name) - (when (or (= 0 (length name)) - (find #\] name) - (find #\Newline name) - (find #\Return name)) - (error 'no-section-error)) ;; Invalid section name, signal so. - name) - -(defun %validate-option-name (name) - (when (or (= 0 (length name)) - (eql (aref name 0) #\[) - (find #\Space name) - (find #\Tab name) - (find #\Return name) - (find #\Newline name)) - (error 'no-option-error));; No such option error - name) - -;; non-API -(defun %get-section (config section-name) - (if (string= "DEFAULT" section-name) - (config-defaults config) - (let* ((norm-section-name (norm-section-name config section-name)) - (section (find norm-section-name (config-sections config) - :key #'section-name - :test #'string=))) - (unless section - (error 'no-section-error)) ;; no-such-section error - section))) - -;; non-API -(defun %get-option (config section-name option-name if-does-not-exist) - (let* ((section (%get-section config section-name)) - (norm-option (norm-option-name config option-name)) - (option (assoc norm-option - (section-options section) - :test #'string=))) - (if (null option) - (if (eq if-does-not-exist :error) - (error 'no-option-error) ;; no such option error - (values (car (push (list (%validate-option-name option-name)) - (section-options section))) - section)) - (values option section)))) - -;; -;; The API -;; - -(defun defaults (config) - "Returns an alist containing instance wide defaults, where the -elements are 2-element dotted lists: the CDR is the value -associated with the key." - (section-options (config-defaults config))) - -(defun sections (config) - "Returns a list of names of defined sections." - (mapcar #'section-name (config-sections config))) - -(defun has-section-p (config section-name) - "Returns `NIL' when the section is not added to the config yet, -some other value if it is." - (handler-case - (%get-section config section-name) - (no-section-error () nil))) - -(defun add-section (config section-name) - "Adds a new section to the config. - -If the section exists, the `duplicate-section-error' is raised." - (%validate-section-name section-name) - (let ((norm-section-name (funcall (config-section-name-transform-fn config) - section-name))) - (when (has-section-p config section-name) - (error 'duplicate-section-error)) - (car (push (make-section :name norm-section-name) - (config-sections config))))) - -(defun options (config section-name) - "Returns a list of option names which are defined in the given section." - (let ((section (%get-section config section-name))) - (mapcar #'first (section-options section)))) - -(defun has-option-p (config section-name option-name) - "Returns a generalised boolean with a value of `NIL' when -the specified option does not exist in the specified section -and some other value otherwise." - (handler-case - (%get-option config section-name option-name :error) - (no-option-error () nil))) - -;; non-API -(defun %extract-replacement (option-value) - ;; Returns: (VALUES replacement-option start end) or NIL - (let ((%-pos (position #\% option-value))) - (when (and %-pos - (< (+ 3 %-pos) (length option-value)) - (eql (aref option-value (1+ %-pos)) #$ )) - (let ((paren-pos (position #$ option-value :start %-pos))) - (unless (and paren-pos - (< (1+ paren-pos) (length option-value)) - (eql (aref option-value (1+ paren-pos)) #\s)) - (error 'interpolation-syntax-error)) - ;; syntax error: %(..)s is minimally required - (when (<= 0 (- paren-pos %-pos 2)) - (let ((replacement-name - (make-array (- paren-pos %-pos 2) - :element-type (array-element-type option-value) - :displaced-to option-value - :displaced-index-offset (+ 2 %-pos)))) - (when (= 0 (length replacement-name)) - ;; some preconditions on replacement-name - (error 'interpolation-syntax-error)) - (values replacement-name %-pos (1+ paren-pos)))))))) - -;; non-API -(defun %option-value (config section option-name &key defaults) - (if (string= option-name "__name__") - (section-name section) - (let* ((norm-option-name (norm-option-name config option-name)) - (option (has-option-p config (section-name section) option-name))) - (if option - (cdr option) - (labels ((get-value (repositories) - (when (null repositories) - (error 'interpolation-missing-option-error)) - ;; no such option error - (let ((value (assoc norm-option-name (car repositories) - :test #'string=))) - (if value - (cdr value) - (get-value (cdr repositories)))))) - (get-value (list (section-options section) - defaults - (defaults config)))))))) - -;; non-API -(defun %expand-option-value (config section option-value defaults - &optional dependees) - (multiple-value-bind - (replacement-name start end) - (%extract-replacement option-value) - (unless replacement-name - ;; nothing to do here... - (return-from %expand-option-value option-value)) - - (let ((norm-replacement (norm-option-name config replacement-name)) - (replacement-value (%option-value config section - replacement-name - :defaults defaults))) - (when (member norm-replacement dependees :test #'string=) - (error 'interpolation-depth-error)) ;; recursive dependency... - (%expand-option-value - config - section - (concatenate 'string - (subseq option-value 0 start) - (%expand-option-value config - section - replacement-value - defaults - (cons norm-replacement dependees)) - (subseq option-value (1+ end) (length option-value))) - defaults - dependees)))) - -(defun get-option (config section-name option-name - &key (expand t) defaults type) - "Returns the value of the specified option in the specified section. - -If `expand' is `NIL', any options which depend on other options -won't be expanded and the raw configuration value is returned. - -When `defaults' is an alist of which the elements are dotted lists of -key/value pairs, these values are used in the expansion of option values. - -`type' may be one of `:boolean', `:number' or it may remain unspecified." - (multiple-value-bind - (option section) - (%get-option config section-name option-name :error) - (flet ((convert-boolean (v) - (cond - ((member v '("1" "yes" "true" "on") :test #'string=) - T) - ((member v '("0" "no" "false" "off") :test #'string=) - NIL) - (t - (error 'not-a-boolean)))) - (convert-number (v) - (parse-number:parse-number v))) - (let ((string-value - (if expand - (%expand-option-value config - section (cdr option) - defaults - (list option-name)) - (cdr option)))) - (cond - ((eq type :boolean) - (convert-boolean string-value)) - ((eq type :number) - (convert-number string-value)) - ((null type) - string-value) - (t - (error "Illegal `type' parameter value."))))))) - -(defun set-option (config section-name option-name value) - "Sets the value of the specified option in the specified section. - -If the section does not exist, a `no-section-error' is raised. If the -option does not exist, it is created." - (let ((option (%get-option config section-name option-name :create))) - (setf (cdr option) value))) - -(defun items (config section-name &key (expand t) defaults) - "Returns an alist of which the items are dotted lists of key/value -pairs being the option names and values specified in the given section. - -When `expand' is `NIL', options are returned in raw form. Otherwise -option values are expanded. - -The definition of `defaults' is the same as for `get-option'." - (let ((section (%get-section config section-name))) - (if expand - (mapcar #'(lambda (x) - (cons (car x) (get-option config section-name - (car x) ;; option-name - :expand t - :defaults defaults))) - (section-options section)) - (section-options section)))) - -(defun remove-option (config section-name option-name) - "Remove the specified option from the given section." - (multiple-value-bind - (option section) - (%get-option config section-name option-name :error) - (setf (section-options section) - (remove option (section-options section))))) - -(defun remove-section (config section-name) - "Remove the specified section. - -In case the section name equals the magic name `DEFAULT', -an error is raised, since this section can't be removed." - (when (string= section-name "DEFAULT") - (error 'no-section-error)) ;; no such section error - (let ((section (%get-section config section-name))) - (setf (config-sections config) - (remove section (config-sections config))))) - + +(cl:in-package :py-configparser) + +;; The conditions (errors) + +(define-condition configparser-error (error) ()) + +;; Errors for the configuration management side +(define-condition config-error (configparser-error) ()) +(define-condition no-section-error (config-error) ()) +(define-condition duplicate-section-error (config-error) ()) +(define-condition no-option-error (config-error) ()) +(define-condition interpolation-error (config-error) ()) +(define-condition interpolation-depth-error (interpolation-error) ()) +(define-condition interpolation-missing-option-error (interpolation-error) ()) +(define-condition interpolation-syntax-error (interpolation-error) ()) + + +;; +;; Configuration storage and management routines +;; + + +;; The structures +;; Note: because ABCL has issues with its CLOS support +;; (as per 1-1-2008), we use structures below to +;; be maximally portable. + + +(defstruct section + name + options) + +(defstruct config + (defaults (make-section :name "DEFAULT")) + sections + (option-name-transform-fn #'string-downcase) + (section-name-transform-fn #'identity)) + +(defun norm-option-name (config option-name) + (funcall (config-option-name-transform-fn config) option-name)) + +(defun norm-section-name (config section-name) + (funcall (config-section-name-transform-fn config) section-name)) + +(defun %validate-section-name (name) + (when (or (= 0 (length name)) + (find #\] name) + (find #\Newline name) + (find #\Return name)) + (error 'no-section-error)) ;; Invalid section name, signal so. + name) + +(defun %validate-option-name (name) + (when (or (= 0 (length name)) + (eql (aref name 0) #\[) + (find #\Space name) + (find #\Tab name) + (find #\Return name) + (find #\Newline name)) + (error 'no-option-error));; No such option error + name) + +;; non-API +(defun %get-section (config section-name) + (if (string= "DEFAULT" section-name) + (config-defaults config) + (let* ((norm-section-name (norm-section-name config section-name)) + (section (find norm-section-name (config-sections config) + :key #'section-name + :test #'string=))) + (unless section + (error 'no-section-error)) ;; no-such-section error + section))) + +;; non-API +(defun %get-option (config section-name option-name if-does-not-exist) + (let* ((section (%get-section config section-name)) + (norm-option (norm-option-name config option-name)) + (option (assoc norm-option + (section-options section) + :test #'string=))) + (if (null option) + (if (eq if-does-not-exist :error) + (error 'no-option-error) ;; no such option error + (values (car (push (list (%validate-option-name option-name)) + (section-options section))) + section)) + (values option section)))) + +;; +;; The API +;; + +(defun defaults (config) + "Returns an alist containing instance wide defaults, where the +elements are 2-element dotted lists: the CDR is the value +associated with the key." + (section-options (config-defaults config))) + +(defun sections (config) + "Returns a list of names of defined sections." + (mapcar #'section-name (config-sections config))) + +(defun has-section-p (config section-name) + "Returns `NIL' when the section is not added to the config yet, +some other value if it is." + (handler-case + (%get-section config section-name) + (no-section-error () nil))) + +(defun add-section (config section-name) + "Adds a new section to the config. + +If the section exists, the `duplicate-section-error' is raised." + (%validate-section-name section-name) + (let ((norm-section-name (funcall (config-section-name-transform-fn config) + section-name))) + (when (has-section-p config section-name) + (error 'duplicate-section-error)) + (car (push (make-section :name norm-section-name) + (config-sections config))))) + +(defun options (config section-name) + "Returns a list of option names which are defined in the given section." + (let ((section (%get-section config section-name))) + (mapcar #'first (section-options section)))) + +(defun has-option-p (config section-name option-name) + "Returns a generalised boolean with a value of `NIL' when +the specified option does not exist in the specified section +and some other value otherwise." + (handler-case + (%get-option config section-name option-name :error) + (no-option-error () nil))) + +;; non-API +(defun %extract-replacement (option-value) + ;; Returns: (VALUES replacement-option start end) or NIL + (let ((%-pos (position #\% option-value))) + (when (and %-pos + (< (+ 3 %-pos) (length option-value)) + (eql (aref option-value (1+ %-pos)) #$ )) + (let ((paren-pos (position #$ option-value :start %-pos))) + (unless (and paren-pos + (< (1+ paren-pos) (length option-value)) + (eql (aref option-value (1+ paren-pos)) #\s)) + (error 'interpolation-syntax-error)) + ;; syntax error: %(..)s is minimally required + (when (<= 0 (- paren-pos %-pos 2)) + (let ((replacement-name + (make-array (- paren-pos %-pos 2) + :element-type (array-element-type option-value) + :displaced-to option-value + :displaced-index-offset (+ 2 %-pos)))) + (when (= 0 (length replacement-name)) + ;; some preconditions on replacement-name + (error 'interpolation-syntax-error)) + (values replacement-name %-pos (1+ paren-pos)))))))) + +;; non-API +(defun %option-value (config section option-name &key defaults) + (if (string= option-name "__name__") + (section-name section) + (let* ((norm-option-name (norm-option-name config option-name)) + (option (has-option-p config (section-name section) option-name))) + (if option + (cdr option) + (labels ((get-value (repositories) + (when (null repositories) + (error 'interpolation-missing-option-error)) + ;; no such option error + (let ((value (assoc norm-option-name (car repositories) + :test #'string=))) + (if value + (cdr value) + (get-value (cdr repositories)))))) + (get-value (list (section-options section) + defaults + (defaults config)))))))) + +;; non-API +(defun %expand-option-value (config section option-value defaults + &optional dependees) + (multiple-value-bind + (replacement-name start end) + (%extract-replacement option-value) + (unless replacement-name + ;; nothing to do here... + (return-from %expand-option-value option-value)) + + (let ((norm-replacement (norm-option-name config replacement-name)) + (replacement-value (%option-value config section + replacement-name + :defaults defaults))) + (when (member norm-replacement dependees :test #'string=) + (error 'interpolation-depth-error)) ;; recursive dependency... + (%expand-option-value + config + section + (concatenate 'string + (subseq option-value 0 start) + (%expand-option-value config + section + replacement-value + defaults + (cons norm-replacement dependees)) + (subseq option-value (1+ end) (length option-value))) + defaults + dependees)))) + +(defun get-option (config section-name option-name + &key (expand t) defaults type) + "Returns the value of the specified option in the specified section. + +If `expand' is `NIL', any options which depend on other options +won't be expanded and the raw configuration value is returned. + +When `defaults' is an alist of which the elements are dotted lists of +key/value pairs, these values are used in the expansion of option values. + +`type' may be one of `:boolean', `:number' or it may remain unspecified." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (flet ((convert-boolean (v) + (cond + ((member v '("1" "yes" "true" "on") :test #'string=) + T) + ((member v '("0" "no" "false" "off") :test #'string=) + NIL) + (t + (error 'not-a-boolean)))) + (convert-number (v) + (parse-number:parse-number v))) + (let ((string-value + (if expand + (%expand-option-value config + section (cdr option) + defaults + (list option-name)) + (cdr option)))) + (cond + ((eq type :boolean) + (convert-boolean string-value)) + ((eq type :number) + (convert-number string-value)) + ((null type) + string-value) + (t + (error "Illegal `type' parameter value."))))))) + +(defun set-option (config section-name option-name value) + "Sets the value of the specified option in the specified section. + +If the section does not exist, a `no-section-error' is raised. If the +option does not exist, it is created." + (let ((option (%get-option config section-name option-name :create))) + (setf (cdr option) value))) + +(defun items (config section-name &key (expand t) defaults) + "Returns an alist of which the items are dotted lists of key/value +pairs being the option names and values specified in the given section. + +When `expand' is `NIL', options are returned in raw form. Otherwise +option values are expanded. + +The definition of `defaults' is the same as for `get-option'." + (let ((section (%get-section config section-name))) + (if expand + (mapcar #'(lambda (x) + (cons (car x) (get-option config section-name + (car x) ;; option-name + :expand t + :defaults defaults))) + (section-options section)) + (section-options section)))) + +(defun remove-option (config section-name option-name) + "Remove the specified option from the given section." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (setf (section-options section) + (remove option (section-options section))))) + +(defun remove-section (config section-name) + "Remove the specified section. + +In case the section name equals the magic name `DEFAULT', +an error is raised, since this section can't be removed." + (when (string= section-name "DEFAULT") + (error 'no-section-error)) ;; no such section error + (let ((section (%get-section config section-name))) + (setf (config-sections config) + (remove section (config-sections config))))) + Modified: branches/1.0.x/package.lisp ============================================================================== --- branches/1.0.x/package.lisp (original) +++ branches/1.0.x/package.lisp Fri Mar 14 17:26:31 2008 @@ -1,57 +1,57 @@ - -;; This package is actuall two things: -;; 1) a configuration management utility -;; 2) a configuration file parser/writer in the .INI format -;; -;; But in the Python module this distinction hasn't been implemented -;; this stringently, meaning we're stuck to the current naming scheme. - -;; There's no reason however that you can't create your own format -;; and parse that, storing it in the config object as defined in this -;; package. (However, if you already use this module, you might as well -;; use the INI format as persistent format.) - - -(cl:defpackage #:py-configparser - (:use #:cl) - (:export - ;; common condition class - #:configparser-error - - ;; configuration storage type - #:config - - ;; Configuration management - ;; Error classes - #:no-section-erorr - #:duplicate-section-error - #:no-option-error - #:interpolation-error - #:interpolation-depth-error - #:interpolation-missing-option-error - #:interpolation-syntax-error - - ;; Functions - #:make-config - #:defaults - #:sections - #:has-section-p - #:add-section - #:options - #:has-option-p - #:get-option - #:set-option - #:items - #:remove-option - #:remove-section - - ;; Configuration file parsing - ;; Error classes - #:parsing-error - #:missing-section-header-error - - ;; Functions - #:read-stream - #:read-files - #:write-stream)) - + +;; This package is actuall two things: +;; 1) a configuration management utility +;; 2) a configuration file parser/writer in the .INI format +;; +;; But in the Python module this distinction hasn't been implemented +;; this stringently, meaning we're stuck to the current naming scheme. + +;; There's no reason however that you can't create your own format +;; and parse that, storing it in the config object as defined in this +;; package. (However, if you already use this module, you might as well +;; use the INI format as persistent format.) + + +(cl:defpackage #:py-configparser + (:use #:cl) + (:export + ;; common condition class + #:configparser-error + + ;; configuration storage type + #:config + + ;; Configuration management + ;; Error classes + #:no-section-erorr + #:duplicate-section-error + #:no-option-error + #:interpolation-error + #:interpolation-depth-error + #:interpolation-missing-option-error + #:interpolation-syntax-error + + ;; Functions + #:make-config + #:defaults + #:sections + #:has-section-p + #:add-section + #:options + #:has-option-p + #:get-option + #:set-option + #:items + #:remove-option + #:remove-section + + ;; Configuration file parsing + ;; Error classes + #:parsing-error + #:missing-section-header-error + + ;; Functions + #:read-stream + #:read-files + #:write-stream)) + Modified: branches/1.0.x/parser.lisp ============================================================================== --- branches/1.0.x/parser.lisp (original) +++ branches/1.0.x/parser.lisp Fri Mar 14 17:26:31 2008 @@ -1,235 +1,235 @@ - -(cl:in-package #:py-configparser) - -(declaim '(special *line-no* *current-section* *file-name* - *current-input*)) - -;; Errors for the parsing side - -(define-condition parsing-error (configparser-error) - ((line-no :initarg :line-no :initform *line-no* :reader line) - (file :initarg :file :initform *file-name* :reader file) - (section :initarg :section :initform *current-section* :reader section) - (message :initarg :text :reader message)) - (:report (lambda (c stream) - (format stream "~A at line ~A" (message c) (line c))))) -(define-condition missing-section-header-error (parsing-error) ()) - - - -;; The reader - -(declaim '(inline %read-char %unread-char)) - -(defun %read-char (stream) - (let ((ch (read-char stream nil :eof))) - (when (eql ch #\Newline) - (incf *line-no*)) - (if (eq ch :eof) #\Newline ch))) - -(defun ensure-section (config section-name) - (handler-case - (%get-section config section-name) - (no-section-error () - (add-section config section-name))) - section-name) - -(defun is-whitespace (c) - (or (eq c #\Space) - (eq c #\Tab) - (eq c #\Return))) - -(defun is-comment-char (c) - (or (eq c #\;) - (eq c #\#))) - -(defun skip-whitespace (s) - (loop for c = (%read-char s) - while (is-whitespace c))) - -(defun skip-emtpy-line (s) - (loop for c = (%read-char s) - if (eq c #\Newline) do (return) - else unless (is-whitespace c) - do (error 'parsing-error - :text "Non-empty line found where empty expected."))) ;; empty line expected - -(defun skip-to-eol (s) - (loop for c = (%read-char s) - until (eq c #\Newline))) - -(defun expect-char (s expect &key skip-whitespace) - (let ((ch (%read-char s))) - (when (and skip-whitespace - (is-whitespace ch)) - (loop for c = (%read-char s) - while (is-whitespace c) - finally (setf ch c))) - (unless (eq ch expect) - (error 'parsing-error - :text (format nil "Character ~A expected, but ~A found instead." - expect ch))) ;; character expect expected, but ch found - ch)) - -(defun expect-one-of (s expect-bag &key skip-whitespace) - (let ((ch (%read-char s))) - (when (and skip-whitespace - (is-whitespace ch)) - (loop for c = (%read-char s) - while (is-whitespace c) - finally (setf ch c))) - (unless (member ch expect-bag) - ;; character ch found, but looking for EXPECT-BAG - (error 'parsing-error - :text (format nil "Character ~A found, but one of ~A expected." - ch expect-bag))) - ch)) - -(defun make-input-buffer (p) - (declare (ignore p)) - (make-array 20 :element-type 'cl:character :fill-pointer 0 - :adjustable t)) - -(declaim '(inline extend-input)) -(defun extend-input (p c) - (vector-push-extend c *current-input* 20)) - -(defun finalize-input (p) - (let ((cp *current-input*)) - (setf *current-input* - (make-input-buffer p)) - cp)) - -(defun read-section-name (p s) - (expect-char s #\[) - (loop for c = (%read-char s) - if (eq c #\Newline) - do (error 'parsing-error - :text "Premature end of line, or end of line in section name.") - ;; we can't have newlines in section names! - else if (eq c #\]) - do (progn - (skip-to-eol s) - (return (finalize-input p))) - else do (extend-input p c))) - -(defun read-option-name (p s) - (loop for c = (%read-char s) - if (or (eq c #\:) - (eq c #\=)) - do (let ((option-name (finalize-input p))) - (when (= 0 (length option-name)) - (error 'parsing-error - :text "No option name found.")) ;; No option name found - (return option-name)) - else if (is-whitespace c) - do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) - else do (extend-input p c))) - -(defun read-option-value (p s &key (leading-white :skip)) - (let ((leading-mode t) - (lead-detected nil)) - (loop for c = (%read-char s) - unless (or (eql c #\Return) - (eql c #\Newline)) - do (if (and leading-mode - (is-whitespace c)) - (setf lead-detected t) - (progn - (when (and (eq leading-white :fold) - leading-mode - lead-detected) - (extend-input p #\Space)) - (setf leading-mode nil) - (extend-input p c))) - - if (and (eql c #\Newline) - (let ((ch (peek-char nil s nil nil))) - (or (eql ch #\Space) - (eql ch #\Tab)))) - do (return (read-option-value p s :leading-white :fold)) - until (eql c #\Newline) - finally (return (finalize-input p))))) - -(defun reading-driver (p s) - (let ((*line-no* 0) - (*current-section* nil) - (*current-input* (make-input-buffer p))) - (loop for c = (peek-char nil s nil :eof) - until (eq c :eof) - if (eql c #\[) - do (setf *current-section* - (section-name (ensure-section p (read-section-name p s)))) - - else if (is-whitespace c) - do (skip-empty-line s) - - else if (is-comment-char c) - do (skip-to-eol s) - - else if (eql c #\Newline) - do (%read-char s) ;; skip over the newline character - - else do (if (null *current-section*) - (error 'missing-section-header-error - :text (format nil "Missing section header; found ~A instead." c)) - (set-option p - *current-section* - (read-option-name p s) - (read-option-value p s)))))) - -;; -;; The API -;; - -(defun read-files (config filenames) - "Parses the files given in the list `filenames', if they exist. -The list is processed first to last, overwriting any pre-existing -values with the last value read. - -The results are stored in `config' which is modified destructively. - -Returns as values the configuration and the list of files actually read." - (let (files-read) - (dolist (filename (mapcar #'probe-file filenames) - (values config files-read)) - (with-open-file (s filename - :direction :input - :if-does-not-exist :error) - (read-stream config s :stream-name filename)) - (push filename files-read)))) - -(defun read-stream (config stream &key (stream-name "an unknown stream")) - "Parses the content of `stream' as a configuration file, -storing any values in `config' which is modified destructively. - -This function maps from the python 'readfp()' function." - (let ((*file-name* stream-name)) - (reading-driver config stream) - config)) - -(defun %format-value (value) - (if (and (numberp value) - (not (integerp value))) - (format nil "~,,,,,,'eE" value) - value)) - -(defun write-stream (config stream) - "Writes the configuration file corresponding to the -in-memory config state. Reloading the file -with `read-stream' or `read-files' will restore config state." - (flet ((write-section (section) - (format stream "[~a]~%" (section-name section)) - (format stream "~:{~A = ~{~A~%~}~}~%" - (mapcar #'(lambda (option) - (list (car option) - (list (%format-value (cdr option))))) - (section-options section))))) - (let ((*print-radix* nil) - (*print-base* 10)) - ;; set the printer output as expected by python - (when (defaults config) - ;; write the defaults too!! - (write-section (config-defaults config))) - (mapcar #'write-section (config-sections config))))) - + +(cl:in-package #:py-configparser) + +(declaim (special *line-no* *current-section* *file-name* + *current-input*)) + +;; Errors for the parsing side + +(define-condition parsing-error (configparser-error) + ((line-no :initarg :line-no :initform *line-no* :reader line) + (file :initarg :file :initform *file-name* :reader file) + (section :initarg :section :initform *current-section* :reader section) + (message :initarg :text :reader message)) + (:report (lambda (c stream) + (format stream "~A at line ~A" (message c) (line c))))) +(define-condition missing-section-header-error (parsing-error) ()) + + + +;; The reader + +(declaim (inline %read-char %unread-char)) + +(defun %read-char (stream) + (let ((ch (read-char stream nil :eof))) + (when (eql ch #\Newline) + (incf *line-no*)) + (if (eq ch :eof) #\Newline ch))) + +(defun ensure-section (config section-name) + (handler-case + (%get-section config section-name) + (no-section-error () + (add-section config section-name))) + section-name) + +(defun is-whitespace (c) + (or (eq c #\Space) + (eq c #\Tab) + (eq c #\Return))) + +(defun is-comment-char (c) + (or (eq c #\;) + (eq c #\#))) + +(defun skip-whitespace (s) + (loop for c = (%read-char s) + while (is-whitespace c))) + +(defun skip-emtpy-line (s) + (loop for c = (%read-char s) + if (eq c #\Newline) do (return) + else unless (is-whitespace c) + do (error 'parsing-error + :text "Non-empty line found where empty expected."))) ;; empty line expected + +(defun skip-to-eol (s) + (loop for c = (%read-char s) + until (eq c #\Newline))) + +(defun expect-char (s expect &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (eq ch expect) + (error 'parsing-error + :text (format nil "Character ~A expected, but ~A found instead." + expect ch))) ;; character expect expected, but ch found + ch)) + +(defun expect-one-of (s expect-bag &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (member ch expect-bag) + ;; character ch found, but looking for EXPECT-BAG + (error 'parsing-error + :text (format nil "Character ~A found, but one of ~A expected." + ch expect-bag))) + ch)) + +(defun make-input-buffer (p) + (declare (ignore p)) + (make-array 20 :element-type 'cl:character :fill-pointer 0 + :adjustable t)) + +(declaim (inline extend-input)) +(defun extend-input (p c) + (vector-push-extend c *current-input* 20)) + +(defun finalize-input (p) + (let ((cp *current-input*)) + (setf *current-input* + (make-input-buffer p)) + cp)) + +(defun read-section-name (p s) + (expect-char s #\[) + (loop for c = (%read-char s) + if (eq c #\Newline) + do (error 'parsing-error + :text "Premature end of line, or end of line in section name.") + ;; we can't have newlines in section names! + else if (eq c #\]) + do (progn + (skip-to-eol s) + (return (finalize-input p))) + else do (extend-input p c))) + +(defun read-option-name (p s) + (loop for c = (%read-char s) + if (or (eq c #\:) + (eq c #\=)) + do (let ((option-name (finalize-input p))) + (when (= 0 (length option-name)) + (error 'parsing-error + :text "No option name found.")) ;; No option name found + (return option-name)) + else if (is-whitespace c) + do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) + else do (extend-input p c))) + +(defun read-option-value (p s &key (leading-white :skip)) + (let ((leading-mode t) + (lead-detected nil)) + (loop for c = (%read-char s) + unless (or (eql c #\Return) + (eql c #\Newline)) + do (if (and leading-mode + (is-whitespace c)) + (setf lead-detected t) + (progn + (when (and (eq leading-white :fold) + leading-mode + lead-detected) + (extend-input p #\Space)) + (setf leading-mode nil) + (extend-input p c))) + + if (and (eql c #\Newline) + (let ((ch (peek-char nil s nil nil))) + (or (eql ch #\Space) + (eql ch #\Tab)))) + do (return (read-option-value p s :leading-white :fold)) + until (eql c #\Newline) + finally (return (finalize-input p))))) + +(defun reading-driver (p s) + (let ((*line-no* 0) + (*current-section* nil) + (*current-input* (make-input-buffer p))) + (loop for c = (peek-char nil s nil :eof) + until (eq c :eof) + if (eql c #\[) + do (setf *current-section* + (section-name (ensure-section p (read-section-name p s)))) + + else if (is-whitespace c) + do (skip-empty-line s) + + else if (is-comment-char c) + do (skip-to-eol s) + + else if (eql c #\Newline) + do (%read-char s) ;; skip over the newline character + + else do (if (null *current-section*) + (error 'missing-section-header-error + :text (format nil "Missing section header; found ~A instead." c)) + (set-option p + *current-section* + (read-option-name p s) + (read-option-value p s)))))) + +;; +;; The API +;; + +(defun read-files (config filenames) + "Parses the files given in the list `filenames', if they exist. +The list is processed first to last, overwriting any pre-existing +values with the last value read. + +The results are stored in `config' which is modified destructively. + +Returns as values the configuration and the list of files actually read." + (let (files-read) + (dolist (filename (mapcar #'probe-file filenames) + (values config files-read)) + (with-open-file (s filename + :direction :input + :if-does-not-exist :error) + (read-stream config s :stream-name filename)) + (push filename files-read)))) + +(defun read-stream (config stream &key (stream-name "an unknown stream")) + "Parses the content of `stream' as a configuration file, +storing any values in `config' which is modified destructively. + +This function maps from the python 'readfp()' function." + (let ((*file-name* stream-name)) + (reading-driver config stream) + config)) + +(defun %format-value (value) + (if (and (numberp value) + (not (integerp value))) + (format nil "~,,,,,,'eE" value) + value)) + +(defun write-stream (config stream) + "Writes the configuration file corresponding to the +in-memory config state. Reloading the file +with `read-stream' or `read-files' will restore config state." + (flet ((write-section (section) + (format stream "[~a]~%" (section-name section)) + (format stream "~:{~A = ~{~A~%~}~}~%" + (mapcar #'(lambda (option) + (list (car option) + (list (%format-value (cdr option))))) + (section-options section))))) + (let ((*print-radix* nil) + (*print-base* 10)) + ;; set the printer output as expected by python + (when (defaults config) + ;; write the defaults too!! + (write-section (config-defaults config))) + (mapcar #'write-section (config-sections config))))) + Modified: branches/1.0.x/py-configparser.asd ============================================================================== --- branches/1.0.x/py-configparser.asd (original) +++ branches/1.0.x/py-configparser.asd Fri Mar 14 17:26:31 2008 @@ -1,20 +1,20 @@ - - -(in-package #:cl-user) - -(defpackage #:py-configparser-system - (:use #:cl #:asdf)) - -(in-package #:py-configparser-system) - -(defsystem py-configparser - :name "py-configparser" - :author "Erik Huelsmann" - :version "1.0.1-dev" - :license "MIT" - :description "Common Lisp implementation of the Python ConfigParser module" - :depends-on (#:parse-number) - :components ((:file "package") - (:file "config" :depends-on ("package")) - (:file "parser" :depends-on ("config")))) - + + +(in-package #:cl-user) + +(defpackage #:py-configparser-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-system) + +(defsystem py-configparser + :name "py-configparser" + :author "Erik Huelsmann" + :version "1.0.1-dev" + :license "MIT" + :description "Common Lisp implementation of the Python ConfigParser module" + :depends-on (#:parse-number) + :components ((:file "package") + (:file "config" :depends-on ("package")) + (:file "parser" :depends-on ("config")))) + Modified: branches/1.0.x/tests/py-configparser-tests.asd ============================================================================== --- branches/1.0.x/tests/py-configparser-tests.asd (original) +++ branches/1.0.x/tests/py-configparser-tests.asd Fri Mar 14 17:26:31 2008 @@ -1,17 +1,17 @@ - - -(in-package #:cl-user) - -(defpackage #:py-configparser-tests-system - (:use #:cl #:asdf)) - -(in-package #:py-configparser-tests-system) - -(defsystem py-configparser-tests - :name "py-configparser-tests" - :author "Erik Huelsmann" - :version "1.0.1-dev" - :license "MIT" - :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" - :depends-on (#:py-configparser) - :components ((:file "tests"))) + + +(in-package #:cl-user) + +(defpackage #:py-configparser-tests-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-tests-system) + +(defsystem py-configparser-tests + :name "py-configparser-tests" + :author "Erik Huelsmann" + :version "1.0.1-dev" + :license "MIT" + :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" + :depends-on (#:py-configparser) + :components ((:file "tests"))) Modified: branches/1.0.x/tests/tests.lisp ============================================================================== --- branches/1.0.x/tests/tests.lisp (original) +++ branches/1.0.x/tests/tests.lisp Fri Mar 14 17:26:31 2008 @@ -1,304 +1,304 @@ - -(defpackage #:py-configparser-tests - (:use (#:cl #:py-configparser #:rt))) - -(in-package :py-configparser-tests) - -;; test 1 -;; should succeed -(deftest basic.parser - (typep (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (read-stream (make-config) s)) 'config) - T) - -(deftest basic.get-option.1 - (with-input-from-string (s "[n] -p=q -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "z") - "q and some more")) - T) - -(deftest basic.get-option.2 - (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) - "the gamma value")) - T) - -(deftest basic.get-option.3 - (with-input-from-string (s "[n] -p=15 -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) - 15)) - T) - -(deftest basic.get-option.4 - (with-input-from-string (s "[n] -p=yes -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) - T)) - T) - -(deftest basic.get-option.5 - (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s - and some more - -[DEFAULT] -gamma=the gamma value -") - (equal (get-option (read-stream (make-config) s) "n" "delta") - "the gamma value")) - T) - - -(deftest basic.sections - (with-input-from-string (s "[n] post-section header gunk ignored -p=q -z=%(p)s -") - (equal (sections (read-stream (make-config) s)) - '("n"))) - T) - -(deftest basic.comments-only - (typep (with-input-from-string (s "#comments only -") - (read-stream (make-config) s)) 'config) - T) - -(deftest basic.no-newline - (typep (with-input-from-string (s "#comments without trailing \#Newline") - (read-stream (make-config) s)) - 'config) - T) - -(deftest basic.with-defaults - (equal (with-input-from-string (s "[DEFAULT] -def-option = options without trailing newline") - (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) - "options without trailing newline") - T) - -;; newlines only -(deftest basic.newlines-only - (with-input-from-string (s " - - -") - (typep (get-option read-stream (make-config) s) - 'config)) - T) - -;; options -(deftest basic.options - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (options (read-stream (make-config) s) "n")) '("z" "p")) - T) - -;; items -(deftest basic.items.1 - (equal (with-inputfrom-string (s "[n] -p=q -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q"))) - T) - -(deftest basic.items.2 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) - T) - -(deftest basic.items.3 - (equal (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand t - :defaults '(("gamma" . "the gamma")))) - '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) - T) - - -;; sections -(deftest basic.sections.1 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s - -[v] -[t] -") - (sections (read-stream (make-config) s))) '("t" "v" "n")) - T) - -(deftest basic.sections.2 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s - -[v] -[t] - -[DEFAULT] -p=t -") - (sections (read-stream (make-config) s))) '("t" "v" "n")) - T) - -;; add-section -(deftest basic.add-section - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (unless (has-section-p c "v") - (add-section c "v") - (not (null (has-section-p c "v")))))) - T) - -;; set-option -(deftest basic.set-option.1 - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (unless (has-option-p c "t" "b") - (set-option c "t" "b" "ok") - (equal (get-option c "t" "b") "ok")))) - T) - -(deftest basic.set-option.2 - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (set-option c "n" "p" "ok") - (equal (get-option c "n" "p") "ok"))) - T) - -;; remove-option -(deftest basic.remove-option - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (when (has-option-p c "n" "p") - (remove-option c "n" "p") - (null (has-option-p c "n" "p"))))) - T) - -;; remove-section -(deftest basic.remove-section - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (when (has-section-p c "t") - (remove-section c "t") - (null (has-section-p c "t"))))) - T) - - - -;; now the tests that fail -(deftest failures.no-header - (with-input-from-string (s "option-before = section -[header]") - (handler-case - (progn - (read-stream (make-config) s) - nil) - (missing-section-header-error () T))) - T) - -(deftest failures.no-spaced-option-names - (with-input-from-string (s "[n] -option with space = not allowed -") - (handler-case - (progn - (read-stream (make-config) s) - nil) - (parsing-error () T))) - T) - -(deftest failures.recursion - (with-input-from-string (s "[n] -p=%(z)s -z=%(p)s -") - (handler-case - (get-option (read-stream (make-config) s) - "n" ;; section - "p" ;; option - :expand t) - (interpolation-depth-error () T))) - T) - -;; non-erroring non-parsing tests -(deftest miscelaneous - (with-input-from-string (s "[n] -p=%(__name__)s -q=%(z)s -z=hello -") - (let ((p (read-stream (make-config) s))) - (unless (string= (get-option p "n" "p" :expand t) "n") - (error "Unexpected output")) - (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") - (error "Unexpected output")) - (unless (string= (get-option p "n" "q" :expand t) "hello") - (error "Unexpected output")) - (unless (string= (get-option p "n" "z") "hello") - (error "Unexpected output")) - NIL)) + +(defpackage #:py-configparser-tests + (:use (#:cl #:py-configparser #:rt))) + +(in-package :py-configparser-tests) + +;; test 1 +;; should succeed +(deftest basic.parser + (typep (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.get-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "z") + "q and some more")) + T) + +(deftest basic.get-option.2 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) + "the gamma value")) + T) + +(deftest basic.get-option.3 + (with-input-from-string (s "[n] +p=15 +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) + 15)) + T) + +(deftest basic.get-option.4 + (with-input-from-string (s "[n] +p=yes +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) + T)) + T) + +(deftest basic.get-option.5 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more + +[DEFAULT] +gamma=the gamma value +") + (equal (get-option (read-stream (make-config) s) "n" "delta") + "the gamma value")) + T) + + +(deftest basic.sections + (with-input-from-string (s "[n] post-section header gunk ignored +p=q +z=%(p)s +") + (equal (sections (read-stream (make-config) s)) + '("n"))) + T) + +(deftest basic.comments-only + (typep (with-input-from-string (s "#comments only +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.no-newline + (typep (with-input-from-string (s "#comments without trailing \#Newline") + (read-stream (make-config) s)) + 'config) + T) + +(deftest basic.with-defaults + (equal (with-input-from-string (s "[DEFAULT] +def-option = options without trailing newline") + (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) + "options without trailing newline") + T) + +;; newlines only +(deftest basic.newlines-only + (with-input-from-string (s " + + +") + (typep (get-option read-stream (make-config) s) + 'config)) + T) + +;; options +(deftest basic.options + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (options (read-stream (make-config) s) "n")) '("z" "p")) + T) + +;; items +(deftest basic.items.1 + (equal (with-inputfrom-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q"))) + T) + +(deftest basic.items.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) + T) + +(deftest basic.items.3 + (equal (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t + :defaults '(("gamma" . "the gamma")))) + '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) + T) + + +;; sections +(deftest basic.sections.1 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +(deftest basic.sections.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] + +[DEFAULT] +p=t +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +;; add-section +(deftest basic.add-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-section-p c "v") + (add-section c "v") + (not (null (has-section-p c "v")))))) + T) + +;; set-option +(deftest basic.set-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-option-p c "t" "b") + (set-option c "t" "b" "ok") + (equal (get-option c "t" "b") "ok")))) + T) + +(deftest basic.set-option.2 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (set-option c "n" "p" "ok") + (equal (get-option c "n" "p") "ok"))) + T) + +;; remove-option +(deftest basic.remove-option + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-option-p c "n" "p") + (remove-option c "n" "p") + (null (has-option-p c "n" "p"))))) + T) + +;; remove-section +(deftest basic.remove-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-section-p c "t") + (remove-section c "t") + (null (has-section-p c "t"))))) + T) + + + +;; now the tests that fail +(deftest failures.no-header + (with-input-from-string (s "option-before = section +[header]") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (missing-section-header-error () T))) + T) + +(deftest failures.no-spaced-option-names + (with-input-from-string (s "[n] +option with space = not allowed +") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (parsing-error () T))) + T) + +(deftest failures.recursion + (with-input-from-string (s "[n] +p=%(z)s +z=%(p)s +") + (handler-case + (get-option (read-stream (make-config) s) + "n" ;; section + "p" ;; option + :expand t) + (interpolation-depth-error () T))) + T) + +;; non-erroring non-parsing tests +(deftest miscelaneous + (with-input-from-string (s "[n] +p=%(__name__)s +q=%(z)s +z=hello +") + (let ((p (read-stream (make-config) s))) + (unless (string= (get-option p "n" "p" :expand t) "n") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand t) "hello") + (error "Unexpected output")) + (unless (string= (get-option p "n" "z") "hello") + (error "Unexpected output")) + NIL)) NIL) \ No newline at end of file

1 0

[py-configparser-cvs] r20 - branches/1.0.x
by ehuelsmann＠common-lisp.net 14 Mar '08

14 Mar '08

Author: ehuelsmann Date: Fri Mar 14 17:25:24 2008 New Revision: 20 Modified: branches/1.0.x/parser.lisp Log: Merge -r18 from trunk (better error messages). Modified: branches/1.0.x/parser.lisp ============================================================================== --- branches/1.0.x/parser.lisp (original) +++ branches/1.0.x/parser.lisp Fri Mar 14 17:25:24 2008 @@ -1,17 +1,24 @@ (cl:in-package #:py-configparser) +(declaim '(special *line-no* *current-section* *file-name* + *current-input*)) + ;; Errors for the parsing side -(define-condition parsing-error (configparser-error) ()) +(define-condition parsing-error (configparser-error) + ((line-no :initarg :line-no :initform *line-no* :reader line) + (file :initarg :file :initform *file-name* :reader file) + (section :initarg :section :initform *current-section* :reader section) + (message :initarg :text :reader message)) + (:report (lambda (c stream) + (format stream "~A at line ~A" (message c) (line c))))) (define-condition missing-section-header-error (parsing-error) ()) ;; The reader -(declaim '(special *line-no* *current-section* *file-name* - *current-input*)) (declaim '(inline %read-char %unread-char)) (defun %read-char (stream) @@ -44,7 +51,8 @@ (loop for c = (%read-char s) if (eq c #\Newline) do (return) else unless (is-whitespace c) - do (error 'parsing-error))) ;; empty line expected + do (error 'parsing-error + :text "Non-empty line found where empty expected."))) ;; empty line expected (defun skip-to-eol (s) (loop for c = (%read-char s) @@ -58,7 +66,9 @@ while (is-whitespace c) finally (setf ch c))) (unless (eq ch expect) - (error 'parsing-error)) ;; character expect expected, but ch found + (error 'parsing-error + :text (format nil "Character ~A expected, but ~A found instead." + expect ch))) ;; character expect expected, but ch found ch)) (defun expect-one-of (s expect-bag &key skip-whitespace) @@ -69,7 +79,10 @@ while (is-whitespace c) finally (setf ch c))) (unless (member ch expect-bag) - (error 'parsing-error)) ;; character ch found, but looking for EXPECT-BAG + ;; character ch found, but looking for EXPECT-BAG + (error 'parsing-error + :text (format nil "Character ~A found, but one of ~A expected." + ch expect-bag))) ch)) (defun make-input-buffer (p) @@ -91,7 +104,9 @@ (expect-char s #\[) (loop for c = (%read-char s) if (eq c #\Newline) - do (error 'parsing-error) ;; we can't have newlines in section names! + do (error 'parsing-error + :text "Premature end of line, or end of line in section name.") + ;; we can't have newlines in section names! else if (eq c #\]) do (progn (skip-to-eol s) @@ -104,7 +119,8 @@ (eq c #\=)) do (let ((option-name (finalize-input p))) (when (= 0 (length option-name)) - (error 'parsing-error)) ;; No option name found + (error 'parsing-error + :text "No option name found.")) ;; No option name found (return option-name)) else if (is-whitespace c) do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) @@ -155,7 +171,8 @@ do (%read-char s) ;; skip over the newline character else do (if (null *current-section*) - (error 'missing-section-header-error) + (error 'missing-section-header-error + :text (format nil "Missing section header; found ~A instead." c)) (set-option p *current-section* (read-option-name p s)

1 0

[py-configparser-cvs] r19 - in trunk: . tests
by ehuelsmann＠common-lisp.net 14 Mar '08

14 Mar '08

Author: ehuelsmann Date: Fri Mar 14 15:17:12 2008 New Revision: 19 Modified: trunk/LICENSE (contents, props changed) trunk/README (contents, props changed) trunk/config.lisp (contents, props changed) trunk/package.lisp (contents, props changed) trunk/parser.lisp (contents, props changed) trunk/py-configparser.asd (contents, props changed) trunk/tests/py-configparser-tests.asd (contents, props changed) trunk/tests/tests.lisp (contents, props changed) Log: Add 'native' eol-style. Fix 'declaim' bug reported by Maciek Pasternacki <maciej(a)pasternacki.net> through private mail. Modified: trunk/LICENSE ============================================================================== --- trunk/LICENSE (original) +++ trunk/LICENSE Fri Mar 14 15:17:12 2008 @@ -1,23 +1,23 @@ -(This is the MIT / X Consortium license as taken from - http://www.opensource.org/licenses/mit-license.html) - -Copyright (c) 2008 Erik Huelsmann - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE -LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION -OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2008 Erik Huelsmann + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Modified: trunk/README ============================================================================== --- trunk/README (original) +++ trunk/README Fri Mar 14 15:17:12 2008 @@ -1,52 +1,52 @@ -$URL$ -$Id$ - -py-configparser -=============== - -This package provides the same functionality as the Python configparser module, -implemented in pure Common Lisp. - - -Differences between the two -=========================== - -The CL version makes a strong distinction in the parser on one hand and the in-memory -storage management on the other hand. Because of it, the CL version doesn't call its -objects 'Parser', but 'config' instead. - -The parser/writer part of the package provides the three functions READ-STREAM, -READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' -and 'write'. - - -API mapping -=========== - -The functions provided in the Python module (which are all methods of the ConfigParser -class): - -ConfigParser() -> (make-config) -defaults() -> (defaults <config>) -sections() -> (sections <config>) -add_section(name) -> (add-section <config> name) -has_section(name) -> (has-section-p <config> name) -options(section_name) -> (options <config> section-name) -has_option(section_name, name) -> (has-option-p <config> section-name name) -read(filenames) -> (read-files <config> filenames) -readfd(fp) -> (read-stream <config> stream) -get(section, option[, raw[, vars]]) -> - (get-option <config> section option &key expand defaults type) -getint(section, option) -> [folded into get-option using 'type' key] -getfloat(section, option) -> [folded into get-option using 'type' key] -getboolean(section, option) -> [folded into get-option using 'type' key] -items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) -set(section, option, value) -> (set-option <config> section-name option-name value) -write(fp) -> (write-stream <config> stream) -remove_option(section, option) -> (remove-option <config> section-name option-name) -remove_section(section) -> (remove-section <config> section-name) - -Note that the above is just a simple mapping table, but is all you need to get -you started. Documentation from the ConfigParser module should sufficiently document -this package. However minor differences in parameter and method naming may occur. - +$URL$ +$Id$ + +py-configparser +=============== + +This package provides the same functionality as the Python configparser module, +implemented in pure Common Lisp. + + +Differences between the two +=========================== + +The CL version makes a strong distinction in the parser on one hand and the in-memory +storage management on the other hand. Because of it, the CL version doesn't call its +objects 'Parser', but 'config' instead. + +The parser/writer part of the package provides the three functions READ-STREAM, +READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' +and 'write'. + + +API mapping +=========== + +The functions provided in the Python module (which are all methods of the ConfigParser +class): + +ConfigParser() -> (make-config) +defaults() -> (defaults <config>) +sections() -> (sections <config>) +add_section(name) -> (add-section <config> name) +has_section(name) -> (has-section-p <config> name) +options(section_name) -> (options <config> section-name) +has_option(section_name, name) -> (has-option-p <config> section-name name) +read(filenames) -> (read-files <config> filenames) +readfd(fp) -> (read-stream <config> stream) +get(section, option[, raw[, vars]]) -> + (get-option <config> section option &key expand defaults type) +getint(section, option) -> [folded into get-option using 'type' key] +getfloat(section, option) -> [folded into get-option using 'type' key] +getboolean(section, option) -> [folded into get-option using 'type' key] +items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) +set(section, option, value) -> (set-option <config> section-name option-name value) +write(fp) -> (write-stream <config> stream) +remove_option(section, option) -> (remove-option <config> section-name option-name) +remove_section(section) -> (remove-section <config> section-name) + +Note that the above is just a simple mapping table, but is all you need to get +you started. Documentation from the ConfigParser module should sufficiently document +this package. However minor differences in parameter and method naming may occur. + Modified: trunk/config.lisp ============================================================================== --- trunk/config.lisp (original) +++ trunk/config.lisp Fri Mar 14 15:17:12 2008 @@ -1,297 +1,297 @@ - -(cl:in-package :py-configparser) - -;; The conditions (errors) - -(define-condition configparser-error (error) ()) - -;; Errors for the configuration management side -(define-condition config-error (configparser-error) ()) -(define-condition no-section-error (config-error) ()) -(define-condition duplicate-section-error (config-error) ()) -(define-condition no-option-error (config-error) ()) -(define-condition interpolation-error (config-error) ()) -(define-condition interpolation-depth-error (interpolation-error) ()) -(define-condition interpolation-missing-option-error (interpolation-error) ()) -(define-condition interpolation-syntax-error (interpolation-error) ()) - - -;; -;; Configuration storage and management routines -;; - - -;; The structures -;; Note: because ABCL has issues with its CLOS support -;; (as per 1-1-2008), we use structures below to -;; be maximally portable. - - -(defstruct section - name - options) - -(defstruct config - (defaults (make-section :name "DEFAULT")) - sections - (option-name-transform-fn #'string-downcase) - (section-name-transform-fn #'identity)) - -(defun norm-option-name (config option-name) - (funcall (config-option-name-transform-fn config) option-name)) - -(defun norm-section-name (config section-name) - (funcall (config-section-name-transform-fn config) section-name)) - -(defun %validate-section-name (name) - (when (or (= 0 (length name)) - (find #\] name) - (find #\Newline name) - (find #\Return name)) - (error 'no-section-error)) ;; Invalid section name, signal so. - name) - -(defun %validate-option-name (name) - (when (or (= 0 (length name)) - (eql (aref name 0) #\[) - (find #\Space name) - (find #\Tab name) - (find #\Return name) - (find #\Newline name)) - (error 'no-option-error));; No such option error - name) - -;; non-API -(defun %get-section (config section-name) - (if (string= "DEFAULT" section-name) - (config-defaults config) - (let* ((norm-section-name (norm-section-name config section-name)) - (section (find norm-section-name (config-sections config) - :key #'section-name - :test #'string=))) - (unless section - (error 'no-section-error)) ;; no-such-section error - section))) - -;; non-API -(defun %get-option (config section-name option-name if-does-not-exist) - (let* ((section (%get-section config section-name)) - (norm-option (norm-option-name config option-name)) - (option (assoc norm-option - (section-options section) - :test #'string=))) - (if (null option) - (if (eq if-does-not-exist :error) - (error 'no-option-error) ;; no such option error - (values (car (push (list (%validate-option-name option-name)) - (section-options section))) - section)) - (values option section)))) - -;; -;; The API -;; - -(defun defaults (config) - "Returns an alist containing instance wide defaults, where the -elements are 2-element dotted lists: the CDR is the value -associated with the key." - (section-options (config-defaults config))) - -(defun sections (config) - "Returns a list of names of defined sections." - (mapcar #'section-name (config-sections config))) - -(defun has-section-p (config section-name) - "Returns `NIL' when the section is not added to the config yet, -some other value if it is." - (handler-case - (%get-section config section-name) - (no-section-error () nil))) - -(defun add-section (config section-name) - "Adds a new section to the config. - -If the section exists, the `duplicate-section-error' is raised." - (%validate-section-name section-name) - (let ((norm-section-name (funcall (config-section-name-transform-fn config) - section-name))) - (when (has-section-p config section-name) - (error 'duplicate-section-error)) - (car (push (make-section :name norm-section-name) - (config-sections config))))) - -(defun options (config section-name) - "Returns a list of option names which are defined in the given section." - (let ((section (%get-section config section-name))) - (mapcar #'first (section-options section)))) - -(defun has-option-p (config section-name option-name) - "Returns a generalised boolean with a value of `NIL' when -the specified option does not exist in the specified section -and some other value otherwise." - (handler-case - (%get-option config section-name option-name :error) - (no-option-error () nil))) - -;; non-API -(defun %extract-replacement (option-value) - ;; Returns: (VALUES replacement-option start end) or NIL - (let ((%-pos (position #\% option-value))) - (when (and %-pos - (< (+ 3 %-pos) (length option-value)) - (eql (aref option-value (1+ %-pos)) #$ )) - (let ((paren-pos (position #$ option-value :start %-pos))) - (unless (and paren-pos - (< (1+ paren-pos) (length option-value)) - (eql (aref option-value (1+ paren-pos)) #\s)) - (error 'interpolation-syntax-error)) - ;; syntax error: %(..)s is minimally required - (when (<= 0 (- paren-pos %-pos 2)) - (let ((replacement-name - (make-array (- paren-pos %-pos 2) - :element-type (array-element-type option-value) - :displaced-to option-value - :displaced-index-offset (+ 2 %-pos)))) - (when (= 0 (length replacement-name)) - ;; some preconditions on replacement-name - (error 'interpolation-syntax-error)) - (values replacement-name %-pos (1+ paren-pos)))))))) - -;; non-API -(defun %option-value (config section option-name &key defaults) - (if (string= option-name "__name__") - (section-name section) - (let* ((norm-option-name (norm-option-name config option-name)) - (option (has-option-p config (section-name section) option-name))) - (if option - (cdr option) - (labels ((get-value (repositories) - (when (null repositories) - (error 'interpolation-missing-option-error)) - ;; no such option error - (let ((value (assoc norm-option-name (car repositories) - :test #'string=))) - (if value - (cdr value) - (get-value (cdr repositories)))))) - (get-value (list (section-options section) - defaults - (defaults config)))))))) - -;; non-API -(defun %expand-option-value (config section option-value defaults - &optional dependees) - (multiple-value-bind - (replacement-name start end) - (%extract-replacement option-value) - (unless replacement-name - ;; nothing to do here... - (return-from %expand-option-value option-value)) - - (let ((norm-replacement (norm-option-name config replacement-name)) - (replacement-value (%option-value config section - replacement-name - :defaults defaults))) - (when (member norm-replacement dependees :test #'string=) - (error 'interpolation-depth-error)) ;; recursive dependency... - (%expand-option-value - config - section - (concatenate 'string - (subseq option-value 0 start) - (%expand-option-value config - section - replacement-value - defaults - (cons norm-replacement dependees)) - (subseq option-value (1+ end) (length option-value))) - defaults - dependees)))) - -(defun get-option (config section-name option-name - &key (expand t) defaults type) - "Returns the value of the specified option in the specified section. - -If `expand' is `NIL', any options which depend on other options -won't be expanded and the raw configuration value is returned. - -When `defaults' is an alist of which the elements are dotted lists of -key/value pairs, these values are used in the expansion of option values. - -`type' may be one of `:boolean', `:number' or it may remain unspecified." - (multiple-value-bind - (option section) - (%get-option config section-name option-name :error) - (flet ((convert-boolean (v) - (cond - ((member v '("1" "yes" "true" "on") :test #'string=) - T) - ((member v '("0" "no" "false" "off") :test #'string=) - NIL) - (t - (error 'not-a-boolean)))) - (convert-number (v) - (parse-number:parse-number v))) - (let ((string-value - (if expand - (%expand-option-value config - section (cdr option) - defaults - (list option-name)) - (cdr option)))) - (cond - ((eq type :boolean) - (convert-boolean string-value)) - ((eq type :number) - (convert-number string-value)) - ((null type) - string-value) - (t - (error "Illegal `type' parameter value."))))))) - -(defun set-option (config section-name option-name value) - "Sets the value of the specified option in the specified section. - -If the section does not exist, a `no-section-error' is raised. If the -option does not exist, it is created." - (let ((option (%get-option config section-name option-name :create))) - (setf (cdr option) value))) - -(defun items (config section-name &key (expand t) defaults) - "Returns an alist of which the items are dotted lists of key/value -pairs being the option names and values specified in the given section. - -When `expand' is `NIL', options are returned in raw form. Otherwise -option values are expanded. - -The definition of `defaults' is the same as for `get-option'." - (let ((section (%get-section config section-name))) - (if expand - (mapcar #'(lambda (x) - (cons (car x) (get-option config section-name - (car x) ;; option-name - :expand t - :defaults defaults))) - (section-options section)) - (section-options section)))) - -(defun remove-option (config section-name option-name) - "Remove the specified option from the given section." - (multiple-value-bind - (option section) - (%get-option config section-name option-name :error) - (setf (section-options section) - (remove option (section-options section))))) - -(defun remove-section (config section-name) - "Remove the specified section. - -In case the section name equals the magic name `DEFAULT', -an error is raised, since this section can't be removed." - (when (string= section-name "DEFAULT") - (error 'no-section-error)) ;; no such section error - (let ((section (%get-section config section-name))) - (setf (config-sections config) - (remove section (config-sections config))))) - + +(cl:in-package :py-configparser) + +;; The conditions (errors) + +(define-condition configparser-error (error) ()) + +;; Errors for the configuration management side +(define-condition config-error (configparser-error) ()) +(define-condition no-section-error (config-error) ()) +(define-condition duplicate-section-error (config-error) ()) +(define-condition no-option-error (config-error) ()) +(define-condition interpolation-error (config-error) ()) +(define-condition interpolation-depth-error (interpolation-error) ()) +(define-condition interpolation-missing-option-error (interpolation-error) ()) +(define-condition interpolation-syntax-error (interpolation-error) ()) + + +;; +;; Configuration storage and management routines +;; + + +;; The structures +;; Note: because ABCL has issues with its CLOS support +;; (as per 1-1-2008), we use structures below to +;; be maximally portable. + + +(defstruct section + name + options) + +(defstruct config + (defaults (make-section :name "DEFAULT")) + sections + (option-name-transform-fn #'string-downcase) + (section-name-transform-fn #'identity)) + +(defun norm-option-name (config option-name) + (funcall (config-option-name-transform-fn config) option-name)) + +(defun norm-section-name (config section-name) + (funcall (config-section-name-transform-fn config) section-name)) + +(defun %validate-section-name (name) + (when (or (= 0 (length name)) + (find #\] name) + (find #\Newline name) + (find #\Return name)) + (error 'no-section-error)) ;; Invalid section name, signal so. + name) + +(defun %validate-option-name (name) + (when (or (= 0 (length name)) + (eql (aref name 0) #\[) + (find #\Space name) + (find #\Tab name) + (find #\Return name) + (find #\Newline name)) + (error 'no-option-error));; No such option error + name) + +;; non-API +(defun %get-section (config section-name) + (if (string= "DEFAULT" section-name) + (config-defaults config) + (let* ((norm-section-name (norm-section-name config section-name)) + (section (find norm-section-name (config-sections config) + :key #'section-name + :test #'string=))) + (unless section + (error 'no-section-error)) ;; no-such-section error + section))) + +;; non-API +(defun %get-option (config section-name option-name if-does-not-exist) + (let* ((section (%get-section config section-name)) + (norm-option (norm-option-name config option-name)) + (option (assoc norm-option + (section-options section) + :test #'string=))) + (if (null option) + (if (eq if-does-not-exist :error) + (error 'no-option-error) ;; no such option error + (values (car (push (list (%validate-option-name option-name)) + (section-options section))) + section)) + (values option section)))) + +;; +;; The API +;; + +(defun defaults (config) + "Returns an alist containing instance wide defaults, where the +elements are 2-element dotted lists: the CDR is the value +associated with the key." + (section-options (config-defaults config))) + +(defun sections (config) + "Returns a list of names of defined sections." + (mapcar #'section-name (config-sections config))) + +(defun has-section-p (config section-name) + "Returns `NIL' when the section is not added to the config yet, +some other value if it is." + (handler-case + (%get-section config section-name) + (no-section-error () nil))) + +(defun add-section (config section-name) + "Adds a new section to the config. + +If the section exists, the `duplicate-section-error' is raised." + (%validate-section-name section-name) + (let ((norm-section-name (funcall (config-section-name-transform-fn config) + section-name))) + (when (has-section-p config section-name) + (error 'duplicate-section-error)) + (car (push (make-section :name norm-section-name) + (config-sections config))))) + +(defun options (config section-name) + "Returns a list of option names which are defined in the given section." + (let ((section (%get-section config section-name))) + (mapcar #'first (section-options section)))) + +(defun has-option-p (config section-name option-name) + "Returns a generalised boolean with a value of `NIL' when +the specified option does not exist in the specified section +and some other value otherwise." + (handler-case + (%get-option config section-name option-name :error) + (no-option-error () nil))) + +;; non-API +(defun %extract-replacement (option-value) + ;; Returns: (VALUES replacement-option start end) or NIL + (let ((%-pos (position #\% option-value))) + (when (and %-pos + (< (+ 3 %-pos) (length option-value)) + (eql (aref option-value (1+ %-pos)) #$ )) + (let ((paren-pos (position #$ option-value :start %-pos))) + (unless (and paren-pos + (< (1+ paren-pos) (length option-value)) + (eql (aref option-value (1+ paren-pos)) #\s)) + (error 'interpolation-syntax-error)) + ;; syntax error: %(..)s is minimally required + (when (<= 0 (- paren-pos %-pos 2)) + (let ((replacement-name + (make-array (- paren-pos %-pos 2) + :element-type (array-element-type option-value) + :displaced-to option-value + :displaced-index-offset (+ 2 %-pos)))) + (when (= 0 (length replacement-name)) + ;; some preconditions on replacement-name + (error 'interpolation-syntax-error)) + (values replacement-name %-pos (1+ paren-pos)))))))) + +;; non-API +(defun %option-value (config section option-name &key defaults) + (if (string= option-name "__name__") + (section-name section) + (let* ((norm-option-name (norm-option-name config option-name)) + (option (has-option-p config (section-name section) option-name))) + (if option + (cdr option) + (labels ((get-value (repositories) + (when (null repositories) + (error 'interpolation-missing-option-error)) + ;; no such option error + (let ((value (assoc norm-option-name (car repositories) + :test #'string=))) + (if value + (cdr value) + (get-value (cdr repositories)))))) + (get-value (list (section-options section) + defaults + (defaults config)))))))) + +;; non-API +(defun %expand-option-value (config section option-value defaults + &optional dependees) + (multiple-value-bind + (replacement-name start end) + (%extract-replacement option-value) + (unless replacement-name + ;; nothing to do here... + (return-from %expand-option-value option-value)) + + (let ((norm-replacement (norm-option-name config replacement-name)) + (replacement-value (%option-value config section + replacement-name + :defaults defaults))) + (when (member norm-replacement dependees :test #'string=) + (error 'interpolation-depth-error)) ;; recursive dependency... + (%expand-option-value + config + section + (concatenate 'string + (subseq option-value 0 start) + (%expand-option-value config + section + replacement-value + defaults + (cons norm-replacement dependees)) + (subseq option-value (1+ end) (length option-value))) + defaults + dependees)))) + +(defun get-option (config section-name option-name + &key (expand t) defaults type) + "Returns the value of the specified option in the specified section. + +If `expand' is `NIL', any options which depend on other options +won't be expanded and the raw configuration value is returned. + +When `defaults' is an alist of which the elements are dotted lists of +key/value pairs, these values are used in the expansion of option values. + +`type' may be one of `:boolean', `:number' or it may remain unspecified." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (flet ((convert-boolean (v) + (cond + ((member v '("1" "yes" "true" "on") :test #'string=) + T) + ((member v '("0" "no" "false" "off") :test #'string=) + NIL) + (t + (error 'not-a-boolean)))) + (convert-number (v) + (parse-number:parse-number v))) + (let ((string-value + (if expand + (%expand-option-value config + section (cdr option) + defaults + (list option-name)) + (cdr option)))) + (cond + ((eq type :boolean) + (convert-boolean string-value)) + ((eq type :number) + (convert-number string-value)) + ((null type) + string-value) + (t + (error "Illegal `type' parameter value."))))))) + +(defun set-option (config section-name option-name value) + "Sets the value of the specified option in the specified section. + +If the section does not exist, a `no-section-error' is raised. If the +option does not exist, it is created." + (let ((option (%get-option config section-name option-name :create))) + (setf (cdr option) value))) + +(defun items (config section-name &key (expand t) defaults) + "Returns an alist of which the items are dotted lists of key/value +pairs being the option names and values specified in the given section. + +When `expand' is `NIL', options are returned in raw form. Otherwise +option values are expanded. + +The definition of `defaults' is the same as for `get-option'." + (let ((section (%get-section config section-name))) + (if expand + (mapcar #'(lambda (x) + (cons (car x) (get-option config section-name + (car x) ;; option-name + :expand t + :defaults defaults))) + (section-options section)) + (section-options section)))) + +(defun remove-option (config section-name option-name) + "Remove the specified option from the given section." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (setf (section-options section) + (remove option (section-options section))))) + +(defun remove-section (config section-name) + "Remove the specified section. + +In case the section name equals the magic name `DEFAULT', +an error is raised, since this section can't be removed." + (when (string= section-name "DEFAULT") + (error 'no-section-error)) ;; no such section error + (let ((section (%get-section config section-name))) + (setf (config-sections config) + (remove section (config-sections config))))) + Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Fri Mar 14 15:17:12 2008 @@ -1,57 +1,57 @@ - -;; This package is actuall two things: -;; 1) a configuration management utility -;; 2) a configuration file parser/writer in the .INI format -;; -;; But in the Python module this distinction hasn't been implemented -;; this stringently, meaning we're stuck to the current naming scheme. - -;; There's no reason however that you can't create your own format -;; and parse that, storing it in the config object as defined in this -;; package. (However, if you already use this module, you might as well -;; use the INI format as persistent format.) - - -(cl:defpackage #:py-configparser - (:use #:cl) - (:export - ;; common condition class - #:configparser-error - - ;; configuration storage type - #:config - - ;; Configuration management - ;; Error classes - #:no-section-erorr - #:duplicate-section-error - #:no-option-error - #:interpolation-error - #:interpolation-depth-error - #:interpolation-missing-option-error - #:interpolation-syntax-error - - ;; Functions - #:make-config - #:defaults - #:sections - #:has-section-p - #:add-section - #:options - #:has-option-p - #:get-option - #:set-option - #:items - #:remove-option - #:remove-section - - ;; Configuration file parsing - ;; Error classes - #:parsing-error - #:missing-section-header-error - - ;; Functions - #:read-stream - #:read-files - #:write-stream)) - + +;; This package is actuall two things: +;; 1) a configuration management utility +;; 2) a configuration file parser/writer in the .INI format +;; +;; But in the Python module this distinction hasn't been implemented +;; this stringently, meaning we're stuck to the current naming scheme. + +;; There's no reason however that you can't create your own format +;; and parse that, storing it in the config object as defined in this +;; package. (However, if you already use this module, you might as well +;; use the INI format as persistent format.) + + +(cl:defpackage #:py-configparser + (:use #:cl) + (:export + ;; common condition class + #:configparser-error + + ;; configuration storage type + #:config + + ;; Configuration management + ;; Error classes + #:no-section-erorr + #:duplicate-section-error + #:no-option-error + #:interpolation-error + #:interpolation-depth-error + #:interpolation-missing-option-error + #:interpolation-syntax-error + + ;; Functions + #:make-config + #:defaults + #:sections + #:has-section-p + #:add-section + #:options + #:has-option-p + #:get-option + #:set-option + #:items + #:remove-option + #:remove-section + + ;; Configuration file parsing + ;; Error classes + #:parsing-error + #:missing-section-header-error + + ;; Functions + #:read-stream + #:read-files + #:write-stream)) + Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Fri Mar 14 15:17:12 2008 @@ -1,235 +1,235 @@ - -(cl:in-package #:py-configparser) - -(declaim '(special *line-no* *current-section* *file-name* - *current-input*)) - -;; Errors for the parsing side - -(define-condition parsing-error (configparser-error) - ((line-no :initarg :line-no :initform *line-no* :reader line) - (file :initarg :file :initform *file-name* :reader file) - (section :initarg :section :initform *current-section* :reader section) - (message :initarg :text :reader message)) - (:report (lambda (c stream) - (format stream "~A at line ~A" (message c) (line c))))) -(define-condition missing-section-header-error (parsing-error) ()) - - - -;; The reader - -(declaim '(inline %read-char %unread-char)) - -(defun %read-char (stream) - (let ((ch (read-char stream nil :eof))) - (when (eql ch #\Newline) - (incf *line-no*)) - (if (eq ch :eof) #\Newline ch))) - -(defun ensure-section (config section-name) - (handler-case - (%get-section config section-name) - (no-section-error () - (add-section config section-name))) - section-name) - -(defun is-whitespace (c) - (or (eq c #\Space) - (eq c #\Tab) - (eq c #\Return))) - -(defun is-comment-char (c) - (or (eq c #\;) - (eq c #\#))) - -(defun skip-whitespace (s) - (loop for c = (%read-char s) - while (is-whitespace c))) - -(defun skip-emtpy-line (s) - (loop for c = (%read-char s) - if (eq c #\Newline) do (return) - else unless (is-whitespace c) - do (error 'parsing-error - :text "Non-empty line found where empty expected."))) ;; empty line expected - -(defun skip-to-eol (s) - (loop for c = (%read-char s) - until (eq c #\Newline))) - -(defun expect-char (s expect &key skip-whitespace) - (let ((ch (%read-char s))) - (when (and skip-whitespace - (is-whitespace ch)) - (loop for c = (%read-char s) - while (is-whitespace c) - finally (setf ch c))) - (unless (eq ch expect) - (error 'parsing-error - :text (format nil "Character ~A expected, but ~A found instead." - expect ch))) ;; character expect expected, but ch found - ch)) - -(defun expect-one-of (s expect-bag &key skip-whitespace) - (let ((ch (%read-char s))) - (when (and skip-whitespace - (is-whitespace ch)) - (loop for c = (%read-char s) - while (is-whitespace c) - finally (setf ch c))) - (unless (member ch expect-bag) - ;; character ch found, but looking for EXPECT-BAG - (error 'parsing-error - :text (format nil "Character ~A found, but one of ~A expected." - ch expect-bag))) - ch)) - -(defun make-input-buffer (p) - (declare (ignore p)) - (make-array 20 :element-type 'cl:character :fill-pointer 0 - :adjustable t)) - -(declaim '(inline extend-input)) -(defun extend-input (p c) - (vector-push-extend c *current-input* 20)) - -(defun finalize-input (p) - (let ((cp *current-input*)) - (setf *current-input* - (make-input-buffer p)) - cp)) - -(defun read-section-name (p s) - (expect-char s #\[) - (loop for c = (%read-char s) - if (eq c #\Newline) - do (error 'parsing-error - :text "Premature end of line, or end of line in section name.") - ;; we can't have newlines in section names! - else if (eq c #\]) - do (progn - (skip-to-eol s) - (return (finalize-input p))) - else do (extend-input p c))) - -(defun read-option-name (p s) - (loop for c = (%read-char s) - if (or (eq c #\:) - (eq c #\=)) - do (let ((option-name (finalize-input p))) - (when (= 0 (length option-name)) - (error 'parsing-error - :text "No option name found.")) ;; No option name found - (return option-name)) - else if (is-whitespace c) - do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) - else do (extend-input p c))) - -(defun read-option-value (p s &key (leading-white :skip)) - (let ((leading-mode t) - (lead-detected nil)) - (loop for c = (%read-char s) - unless (or (eql c #\Return) - (eql c #\Newline)) - do (if (and leading-mode - (is-whitespace c)) - (setf lead-detected t) - (progn - (when (and (eq leading-white :fold) - leading-mode - lead-detected) - (extend-input p #\Space)) - (setf leading-mode nil) - (extend-input p c))) - - if (and (eql c #\Newline) - (let ((ch (peek-char nil s nil nil))) - (or (eql ch #\Space) - (eql ch #\Tab)))) - do (return (read-option-value p s :leading-white :fold)) - until (eql c #\Newline) - finally (return (finalize-input p))))) - -(defun reading-driver (p s) - (let ((*line-no* 0) - (*current-section* nil) - (*current-input* (make-input-buffer p))) - (loop for c = (peek-char nil s nil :eof) - until (eq c :eof) - if (eql c #\[) - do (setf *current-section* - (section-name (ensure-section p (read-section-name p s)))) - - else if (is-whitespace c) - do (skip-empty-line s) - - else if (is-comment-char c) - do (skip-to-eol s) - - else if (eql c #\Newline) - do (%read-char s) ;; skip over the newline character - - else do (if (null *current-section*) - (error 'missing-section-header-error - :text (format nil "Missing section header; found ~A instead." c)) - (set-option p - *current-section* - (read-option-name p s) - (read-option-value p s)))))) - -;; -;; The API -;; - -(defun read-files (config filenames) - "Parses the files given in the list `filenames', if they exist. -The list is processed first to last, overwriting any pre-existing -values with the last value read. - -The results are stored in `config' which is modified destructively. - -Returns as values the configuration and the list of files actually read." - (let (files-read) - (dolist (filename (mapcar #'probe-file filenames) - (values config files-read)) - (with-open-file (s filename - :direction :input - :if-does-not-exist :error) - (read-stream config s :stream-name filename)) - (push filename files-read)))) - -(defun read-stream (config stream &key (stream-name "an unknown stream")) - "Parses the content of `stream' as a configuration file, -storing any values in `config' which is modified destructively. - -This function maps from the python 'readfp()' function." - (let ((*file-name* stream-name)) - (reading-driver config stream) - config)) - -(defun %format-value (value) - (if (and (numberp value) - (not (integerp value))) - (format nil "~,,,,,,'eE" value) - value)) - -(defun write-stream (config stream) - "Writes the configuration file corresponding to the -in-memory config state. Reloading the file -with `read-stream' or `read-files' will restore config state." - (flet ((write-section (section) - (format stream "[~a]~%" (section-name section)) - (format stream "~:{~A = ~{~A~%~}~}~%" - (mapcar #'(lambda (option) - (list (car option) - (list (%format-value (cdr option))))) - (section-options section))))) - (let ((*print-radix* nil) - (*print-base* 10)) - ;; set the printer output as expected by python - (when (defaults config) - ;; write the defaults too!! - (write-section (config-defaults config))) - (mapcar #'write-section (config-sections config))))) - + +(cl:in-package #:py-configparser) + +(declaim (special *line-no* *current-section* *file-name* + *current-input*)) + +;; Errors for the parsing side + +(define-condition parsing-error (configparser-error) + ((line-no :initarg :line-no :initform *line-no* :reader line) + (file :initarg :file :initform *file-name* :reader file) + (section :initarg :section :initform *current-section* :reader section) + (message :initarg :text :reader message)) + (:report (lambda (c stream) + (format stream "~A at line ~A" (message c) (line c))))) +(define-condition missing-section-header-error (parsing-error) ()) + + + +;; The reader + +(declaim (inline %read-char %unread-char)) + +(defun %read-char (stream) + (let ((ch (read-char stream nil :eof))) + (when (eql ch #\Newline) + (incf *line-no*)) + (if (eq ch :eof) #\Newline ch))) + +(defun ensure-section (config section-name) + (handler-case + (%get-section config section-name) + (no-section-error () + (add-section config section-name))) + section-name) + +(defun is-whitespace (c) + (or (eq c #\Space) + (eq c #\Tab) + (eq c #\Return))) + +(defun is-comment-char (c) + (or (eq c #\;) + (eq c #\#))) + +(defun skip-whitespace (s) + (loop for c = (%read-char s) + while (is-whitespace c))) + +(defun skip-emtpy-line (s) + (loop for c = (%read-char s) + if (eq c #\Newline) do (return) + else unless (is-whitespace c) + do (error 'parsing-error + :text "Non-empty line found where empty expected."))) ;; empty line expected + +(defun skip-to-eol (s) + (loop for c = (%read-char s) + until (eq c #\Newline))) + +(defun expect-char (s expect &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (eq ch expect) + (error 'parsing-error + :text (format nil "Character ~A expected, but ~A found instead." + expect ch))) ;; character expect expected, but ch found + ch)) + +(defun expect-one-of (s expect-bag &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (member ch expect-bag) + ;; character ch found, but looking for EXPECT-BAG + (error 'parsing-error + :text (format nil "Character ~A found, but one of ~A expected." + ch expect-bag))) + ch)) + +(defun make-input-buffer (p) + (declare (ignore p)) + (make-array 20 :element-type 'cl:character :fill-pointer 0 + :adjustable t)) + +(declaim (inline extend-input)) +(defun extend-input (p c) + (vector-push-extend c *current-input* 20)) + +(defun finalize-input (p) + (let ((cp *current-input*)) + (setf *current-input* + (make-input-buffer p)) + cp)) + +(defun read-section-name (p s) + (expect-char s #\[) + (loop for c = (%read-char s) + if (eq c #\Newline) + do (error 'parsing-error + :text "Premature end of line, or end of line in section name.") + ;; we can't have newlines in section names! + else if (eq c #\]) + do (progn + (skip-to-eol s) + (return (finalize-input p))) + else do (extend-input p c))) + +(defun read-option-name (p s) + (loop for c = (%read-char s) + if (or (eq c #\:) + (eq c #\=)) + do (let ((option-name (finalize-input p))) + (when (= 0 (length option-name)) + (error 'parsing-error + :text "No option name found.")) ;; No option name found + (return option-name)) + else if (is-whitespace c) + do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) + else do (extend-input p c))) + +(defun read-option-value (p s &key (leading-white :skip)) + (let ((leading-mode t) + (lead-detected nil)) + (loop for c = (%read-char s) + unless (or (eql c #\Return) + (eql c #\Newline)) + do (if (and leading-mode + (is-whitespace c)) + (setf lead-detected t) + (progn + (when (and (eq leading-white :fold) + leading-mode + lead-detected) + (extend-input p #\Space)) + (setf leading-mode nil) + (extend-input p c))) + + if (and (eql c #\Newline) + (let ((ch (peek-char nil s nil nil))) + (or (eql ch #\Space) + (eql ch #\Tab)))) + do (return (read-option-value p s :leading-white :fold)) + until (eql c #\Newline) + finally (return (finalize-input p))))) + +(defun reading-driver (p s) + (let ((*line-no* 0) + (*current-section* nil) + (*current-input* (make-input-buffer p))) + (loop for c = (peek-char nil s nil :eof) + until (eq c :eof) + if (eql c #\[) + do (setf *current-section* + (section-name (ensure-section p (read-section-name p s)))) + + else if (is-whitespace c) + do (skip-empty-line s) + + else if (is-comment-char c) + do (skip-to-eol s) + + else if (eql c #\Newline) + do (%read-char s) ;; skip over the newline character + + else do (if (null *current-section*) + (error 'missing-section-header-error + :text (format nil "Missing section header; found ~A instead." c)) + (set-option p + *current-section* + (read-option-name p s) + (read-option-value p s)))))) + +;; +;; The API +;; + +(defun read-files (config filenames) + "Parses the files given in the list `filenames', if they exist. +The list is processed first to last, overwriting any pre-existing +values with the last value read. + +The results are stored in `config' which is modified destructively. + +Returns as values the configuration and the list of files actually read." + (let (files-read) + (dolist (filename (mapcar #'probe-file filenames) + (values config files-read)) + (with-open-file (s filename + :direction :input + :if-does-not-exist :error) + (read-stream config s :stream-name filename)) + (push filename files-read)))) + +(defun read-stream (config stream &key (stream-name "an unknown stream")) + "Parses the content of `stream' as a configuration file, +storing any values in `config' which is modified destructively. + +This function maps from the python 'readfp()' function." + (let ((*file-name* stream-name)) + (reading-driver config stream) + config)) + +(defun %format-value (value) + (if (and (numberp value) + (not (integerp value))) + (format nil "~,,,,,,'eE" value) + value)) + +(defun write-stream (config stream) + "Writes the configuration file corresponding to the +in-memory config state. Reloading the file +with `read-stream' or `read-files' will restore config state." + (flet ((write-section (section) + (format stream "[~a]~%" (section-name section)) + (format stream "~:{~A = ~{~A~%~}~}~%" + (mapcar #'(lambda (option) + (list (car option) + (list (%format-value (cdr option))))) + (section-options section))))) + (let ((*print-radix* nil) + (*print-base* 10)) + ;; set the printer output as expected by python + (when (defaults config) + ;; write the defaults too!! + (write-section (config-defaults config))) + (mapcar #'write-section (config-sections config))))) + Modified: trunk/py-configparser.asd ============================================================================== --- trunk/py-configparser.asd (original) +++ trunk/py-configparser.asd Fri Mar 14 15:17:12 2008 @@ -1,20 +1,20 @@ - - -(in-package #:cl-user) - -(defpackage #:py-configparser-system - (:use #:cl #:asdf)) - -(in-package #:py-configparser-system) - -(defsystem py-configparser - :name "py-configparser" - :author "Erik Huelsmann" - :version "1.1-dev" - :license "MIT" - :description "Common Lisp implementation of the Python ConfigParser module" - :depends-on (#:parse-number) - :components ((:file "package") - (:file "config" :depends-on ("package")) - (:file "parser" :depends-on ("config")))) - + + +(in-package #:cl-user) + +(defpackage #:py-configparser-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-system) + +(defsystem py-configparser + :name "py-configparser" + :author "Erik Huelsmann" + :version "1.1-dev" + :license "MIT" + :description "Common Lisp implementation of the Python ConfigParser module" + :depends-on (#:parse-number) + :components ((:file "package") + (:file "config" :depends-on ("package")) + (:file "parser" :depends-on ("config")))) + Modified: trunk/tests/py-configparser-tests.asd ============================================================================== --- trunk/tests/py-configparser-tests.asd (original) +++ trunk/tests/py-configparser-tests.asd Fri Mar 14 15:17:12 2008 @@ -1,17 +1,17 @@ - - -(in-package #:cl-user) - -(defpackage #:py-configparser-tests-system - (:use #:cl #:asdf)) - -(in-package #:py-configparser-tests-system) - -(defsystem py-configparser-tests - :name "py-configparser-tests" - :author "Erik Huelsmann" - :version "1.0-dev" - :license "MIT" - :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" - :depends-on (#:py-configparser) - :components ((:file "tests"))) + + +(in-package #:cl-user) + +(defpackage #:py-configparser-tests-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-tests-system) + +(defsystem py-configparser-tests + :name "py-configparser-tests" + :author "Erik Huelsmann" + :version "1.0-dev" + :license "MIT" + :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" + :depends-on (#:py-configparser) + :components ((:file "tests"))) Modified: trunk/tests/tests.lisp ============================================================================== --- trunk/tests/tests.lisp (original) +++ trunk/tests/tests.lisp Fri Mar 14 15:17:12 2008 @@ -1,304 +1,304 @@ - -(defpackage #:py-configparser-tests - (:use (#:cl #:py-configparser #:rt))) - -(in-package :py-configparser-tests) - -;; test 1 -;; should succeed -(deftest basic.parser - (typep (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (read-stream (make-config) s)) 'config) - T) - -(deftest basic.get-option.1 - (with-input-from-string (s "[n] -p=q -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "z") - "q and some more")) - T) - -(deftest basic.get-option.2 - (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) - "the gamma value")) - T) - -(deftest basic.get-option.3 - (with-input-from-string (s "[n] -p=15 -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) - 15)) - T) - -(deftest basic.get-option.4 - (with-input-from-string (s "[n] -p=yes -delta=%(gamma)s -z=%(p)s - and some more -") - (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) - T)) - T) - -(deftest basic.get-option.5 - (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s - and some more - -[DEFAULT] -gamma=the gamma value -") - (equal (get-option (read-stream (make-config) s) "n" "delta") - "the gamma value")) - T) - - -(deftest basic.sections - (with-input-from-string (s "[n] post-section header gunk ignored -p=q -z=%(p)s -") - (equal (sections (read-stream (make-config) s)) - '("n"))) - T) - -(deftest basic.comments-only - (typep (with-input-from-string (s "#comments only -") - (read-stream (make-config) s)) 'config) - T) - -(deftest basic.no-newline - (typep (with-input-from-string (s "#comments without trailing \#Newline") - (read-stream (make-config) s)) - 'config) - T) - -(deftest basic.with-defaults - (equal (with-input-from-string (s "[DEFAULT] -def-option = options without trailing newline") - (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) - "options without trailing newline") - T) - -;; newlines only -(deftest basic.newlines-only - (with-input-from-string (s " - - -") - (typep (get-option read-stream (make-config) s) - 'config)) - T) - -;; options -(deftest basic.options - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (options (read-stream (make-config) s) "n")) '("z" "p")) - T) - -;; items -(deftest basic.items.1 - (equal (with-inputfrom-string (s "[n] -p=q -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q"))) - T) - -(deftest basic.items.2 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) - T) - -(deftest basic.items.3 - (equal (with-input-from-string (s "[n] -p=q -delta=%(gamma)s -z=%(p)s -") - (items (read-stream (make-config) s) "n" :expand t - :defaults '(("gamma" . "the gamma")))) - '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) - T) - - -;; sections -(deftest basic.sections.1 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s - -[v] -[t] -") - (sections (read-stream (make-config) s))) '("t" "v" "n")) - T) - -(deftest basic.sections.2 - (equal (with-input-from-string (s "[n] -p=q -z=%(p)s - -[v] -[t] - -[DEFAULT] -p=t -") - (sections (read-stream (make-config) s))) '("t" "v" "n")) - T) - -;; add-section -(deftest basic.add-section - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (unless (has-section-p c "v") - (add-section c "v") - (not (null (has-section-p c "v")))))) - T) - -;; set-option -(deftest basic.set-option.1 - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (unless (has-option-p c "t" "b") - (set-option c "t" "b" "ok") - (equal (get-option c "t" "b") "ok")))) - T) - -(deftest basic.set-option.2 - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (set-option c "n" "p" "ok") - (equal (get-option c "n" "p") "ok"))) - T) - -;; remove-option -(deftest basic.remove-option - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (when (has-option-p c "n" "p") - (remove-option c "n" "p") - (null (has-option-p c "n" "p"))))) - T) - -;; remove-section -(deftest basic.remove-section - (with-input-from-string (s "[n] -p=q -z=%(p)s - -[t] - -") - (let ((c (read-stream (make-config) s))) - (when (has-section-p c "t") - (remove-section c "t") - (null (has-section-p c "t"))))) - T) - - - -;; now the tests that fail -(deftest failures.no-header - (with-input-from-string (s "option-before = section -[header]") - (handler-case - (progn - (read-stream (make-config) s) - nil) - (missing-section-header-error () T))) - T) - -(deftest failures.no-spaced-option-names - (with-input-from-string (s "[n] -option with space = not allowed -") - (handler-case - (progn - (read-stream (make-config) s) - nil) - (parsing-error () T))) - T) - -(deftest failures.recursion - (with-input-from-string (s "[n] -p=%(z)s -z=%(p)s -") - (handler-case - (get-option (read-stream (make-config) s) - "n" ;; section - "p" ;; option - :expand t) - (interpolation-depth-error () T))) - T) - -;; non-erroring non-parsing tests -(deftest miscelaneous - (with-input-from-string (s "[n] -p=%(__name__)s -q=%(z)s -z=hello -") - (let ((p (read-stream (make-config) s))) - (unless (string= (get-option p "n" "p" :expand t) "n") - (error "Unexpected output")) - (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") - (error "Unexpected output")) - (unless (string= (get-option p "n" "q" :expand t) "hello") - (error "Unexpected output")) - (unless (string= (get-option p "n" "z") "hello") - (error "Unexpected output")) - NIL)) + +(defpackage #:py-configparser-tests + (:use (#:cl #:py-configparser #:rt))) + +(in-package :py-configparser-tests) + +;; test 1 +;; should succeed +(deftest basic.parser + (typep (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.get-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "z") + "q and some more")) + T) + +(deftest basic.get-option.2 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) + "the gamma value")) + T) + +(deftest basic.get-option.3 + (with-input-from-string (s "[n] +p=15 +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) + 15)) + T) + +(deftest basic.get-option.4 + (with-input-from-string (s "[n] +p=yes +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) + T)) + T) + +(deftest basic.get-option.5 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more + +[DEFAULT] +gamma=the gamma value +") + (equal (get-option (read-stream (make-config) s) "n" "delta") + "the gamma value")) + T) + + +(deftest basic.sections + (with-input-from-string (s "[n] post-section header gunk ignored +p=q +z=%(p)s +") + (equal (sections (read-stream (make-config) s)) + '("n"))) + T) + +(deftest basic.comments-only + (typep (with-input-from-string (s "#comments only +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.no-newline + (typep (with-input-from-string (s "#comments without trailing \#Newline") + (read-stream (make-config) s)) + 'config) + T) + +(deftest basic.with-defaults + (equal (with-input-from-string (s "[DEFAULT] +def-option = options without trailing newline") + (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) + "options without trailing newline") + T) + +;; newlines only +(deftest basic.newlines-only + (with-input-from-string (s " + + +") + (typep (get-option read-stream (make-config) s) + 'config)) + T) + +;; options +(deftest basic.options + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (options (read-stream (make-config) s) "n")) '("z" "p")) + T) + +;; items +(deftest basic.items.1 + (equal (with-inputfrom-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q"))) + T) + +(deftest basic.items.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) + T) + +(deftest basic.items.3 + (equal (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t + :defaults '(("gamma" . "the gamma")))) + '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) + T) + + +;; sections +(deftest basic.sections.1 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +(deftest basic.sections.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] + +[DEFAULT] +p=t +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +;; add-section +(deftest basic.add-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-section-p c "v") + (add-section c "v") + (not (null (has-section-p c "v")))))) + T) + +;; set-option +(deftest basic.set-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-option-p c "t" "b") + (set-option c "t" "b" "ok") + (equal (get-option c "t" "b") "ok")))) + T) + +(deftest basic.set-option.2 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (set-option c "n" "p" "ok") + (equal (get-option c "n" "p") "ok"))) + T) + +;; remove-option +(deftest basic.remove-option + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-option-p c "n" "p") + (remove-option c "n" "p") + (null (has-option-p c "n" "p"))))) + T) + +;; remove-section +(deftest basic.remove-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-section-p c "t") + (remove-section c "t") + (null (has-section-p c "t"))))) + T) + + + +;; now the tests that fail +(deftest failures.no-header + (with-input-from-string (s "option-before = section +[header]") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (missing-section-header-error () T))) + T) + +(deftest failures.no-spaced-option-names + (with-input-from-string (s "[n] +option with space = not allowed +") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (parsing-error () T))) + T) + +(deftest failures.recursion + (with-input-from-string (s "[n] +p=%(z)s +z=%(p)s +") + (handler-case + (get-option (read-stream (make-config) s) + "n" ;; section + "p" ;; option + :expand t) + (interpolation-depth-error () T))) + T) + +;; non-erroring non-parsing tests +(deftest miscelaneous + (with-input-from-string (s "[n] +p=%(__name__)s +q=%(z)s +z=hello +") + (let ((p (read-stream (make-config) s))) + (unless (string= (get-option p "n" "p" :expand t) "n") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand t) "hello") + (error "Unexpected output")) + (unless (string= (get-option p "n" "z") "hello") + (error "Unexpected output")) + NIL)) NIL) \ No newline at end of file

1 0

[py-configparser-cvs] r18 - trunk
by ehuelsmann＠common-lisp.net 11 Feb '08

11 Feb '08

Author: ehuelsmann Date: Mon Feb 11 17:24:34 2008 New Revision: 18 Modified: trunk/parser.lisp Log: Add error text messages as made possible per the last trunk commit. Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Mon Feb 11 17:24:34 2008 @@ -51,7 +51,8 @@ (loop for c = (%read-char s) if (eq c #\Newline) do (return) else unless (is-whitespace c) - do (error 'parsing-error))) ;; empty line expected + do (error 'parsing-error + :text "Non-empty line found where empty expected."))) ;; empty line expected (defun skip-to-eol (s) (loop for c = (%read-char s) @@ -65,7 +66,9 @@ while (is-whitespace c) finally (setf ch c))) (unless (eq ch expect) - (error 'parsing-error)) ;; character expect expected, but ch found + (error 'parsing-error + :text (format nil "Character ~A expected, but ~A found instead." + expect ch))) ;; character expect expected, but ch found ch)) (defun expect-one-of (s expect-bag &key skip-whitespace) @@ -77,7 +80,9 @@ finally (setf ch c))) (unless (member ch expect-bag) ;; character ch found, but looking for EXPECT-BAG - (error 'parsing-error)) + (error 'parsing-error + :text (format nil "Character ~A found, but one of ~A expected." + ch expect-bag))) ch)) (defun make-input-buffer (p) @@ -99,7 +104,9 @@ (expect-char s #\[) (loop for c = (%read-char s) if (eq c #\Newline) - do (error 'parsing-error) ;; we can't have newlines in section names! + do (error 'parsing-error + :text "Premature end of line, or end of line in section name.") + ;; we can't have newlines in section names! else if (eq c #\]) do (progn (skip-to-eol s) @@ -112,7 +119,8 @@ (eq c #\=)) do (let ((option-name (finalize-input p))) (when (= 0 (length option-name)) - (error 'parsing-error)) ;; No option name found + (error 'parsing-error + :text "No option name found.")) ;; No option name found (return option-name)) else if (is-whitespace c) do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) @@ -163,7 +171,8 @@ do (%read-char s) ;; skip over the newline character else do (if (null *current-section*) - (error 'missing-section-header-error) + (error 'missing-section-header-error + :text (format nil "Missing section header; found ~A instead." c)) (set-option p *current-section* (read-option-name p s)

1 0

[py-configparser-cvs] r17 - branches/1.0.x
by ehuelsmann＠common-lisp.net 11 Feb '08

11 Feb '08

Author: ehuelsmann Date: Mon Feb 11 17:07:41 2008 New Revision: 17 Modified: branches/1.0.x/parser.lisp Log: Port r16 fix to 1.0.x branch. Modified: branches/1.0.x/parser.lisp ============================================================================== --- branches/1.0.x/parser.lisp (original) +++ branches/1.0.x/parser.lisp Mon Feb 11 17:07:41 2008 @@ -143,7 +143,7 @@ until (eq c :eof) if (eql c #\[) do (setf *current-section* - (ensure-section p (read-section-name p s))) + (section-name (ensure-section p (read-section-name p s)))) else if (is-whitespace c) do (skip-empty-line s)

1 0

[py-configparser-cvs] r16 - trunk
by ehuelsmann＠common-lisp.net 11 Feb '08

11 Feb '08

Author: ehuelsmann Date: Mon Feb 11 17:05:57 2008 New Revision: 16 Modified: trunk/parser.lisp Log: Fix issue where *current-section* would be set to the section instance instead of the section name string. Also start implementing extended error information. Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Mon Feb 11 17:05:57 2008 @@ -1,17 +1,24 @@ (cl:in-package #:py-configparser) +(declaim '(special *line-no* *current-section* *file-name* + *current-input*)) + ;; Errors for the parsing side -(define-condition parsing-error (configparser-error) ()) +(define-condition parsing-error (configparser-error) + ((line-no :initarg :line-no :initform *line-no* :reader line) + (file :initarg :file :initform *file-name* :reader file) + (section :initarg :section :initform *current-section* :reader section) + (message :initarg :text :reader message)) + (:report (lambda (c stream) + (format stream "~A at line ~A" (message c) (line c))))) (define-condition missing-section-header-error (parsing-error) ()) ;; The reader -(declaim '(special *line-no* *current-section* *file-name* - *current-input*)) (declaim '(inline %read-char %unread-char)) (defun %read-char (stream) @@ -69,7 +76,8 @@ while (is-whitespace c) finally (setf ch c))) (unless (member ch expect-bag) - (error 'parsing-error)) ;; character ch found, but looking for EXPECT-BAG + ;; character ch found, but looking for EXPECT-BAG + (error 'parsing-error)) ch)) (defun make-input-buffer (p) @@ -143,7 +151,7 @@ until (eq c :eof) if (eql c #\[) do (setf *current-section* - (ensure-section p (read-section-name p s))) + (section-name (ensure-section p (read-section-name p s)))) else if (is-whitespace c) do (skip-empty-line s)

1 0

[py-configparser-cvs] r15 - in public_html: . releases
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Sat Jan 19 16:25:23 2008 New Revision: 15 Added: public_html/releases/ public_html/releases/py-configparser-1.0.tar.gz (contents, props changed) Modified: public_html/index.shtml Log: Add 1.0 release. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sat Jan 19 16:25:23 2008 @@ -1,63 +1,60 @@ -<?xml version="1.0"?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> -<head> - <title></title> - <link rel="stylesheet" type="text/css" href="style.css"/> - <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> -</head> - -<body> - <div class="header"> - <h1></h1> - </div> - -<h1>Project description</h1> - <p>The <b>py-configparser</b> package implements the - <a href="http://docs.python.org/lib/module-ConfigParser.html"> - ConfigParser Python module</a> functionality in Common Lisp.</p> - - <p>In short, it implements <b>reading and writing of .INI-file style - configuration files</b> with sections containing key/value pairs of - configuration options. In line with the functionalities in the python - module, does this package implement basic interpolation of option values - in other options. - </p> - - <p>The main reason for starting the project is to be able to share - configuration files between Python and Common Lisp. Other projects - may be using the python/INI file style files too and the project is - by no means limited to the ConfigParser functionality. So, if you - have any wishes and/or nice extentions based on this format, please - send your contributions or extention requests.</p> - - <h1>Examples:</h1> - <pre style="border: 1px solid black; background-color: #ccf"> - -[my-section] -option1 = value1 -option2: value2 - -[interpolated-section] -option1 = value -option2 = value2 and %(option1)s -# this is a comment; the above line evaluates to "value2 and value" - -# empty lines and comments are skipped - </pre> - - -<h1>Releases</h1> -<p>Having recently started (Christmas hacking, 2007), the project doesn't -have any official releases yet. The code however should be useable and -the only reason there's no release is because there are no unit tests yet. -(Yea, working on it....) </p> - -<hr> - - <div class="check"> - <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> - </div> -</body> -</html> +<?xml version="1.0"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<head> + <title></title> + <link rel="stylesheet" type="text/css" href="style.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> +</head> + +<body> + <div class="header"> + <h1></h1> + </div> + +<h1>Project description</h1> + <p>The <b>py-configparser</b> package implements the + <a href="http://docs.python.org/lib/module-ConfigParser.html"> + ConfigParser Python module</a> functionality in Common Lisp.</p> + + <p>In short, it implements <b>reading and writing of .INI-file style + configuration files</b> with sections containing key/value pairs of + configuration options. In line with the functionalities in the python + module, does this package implement basic interpolation of option values + in other options. + </p> + + <p>The main reason for starting the project is to be able to share + configuration files between Python and Common Lisp. Other projects + may be using the python/INI file style files too and the project is + by no means limited to the ConfigParser functionality. So, if you + have any wishes and/or nice extentions based on this format, please + send your contributions or extention requests.</p> + + <h1>Examples:</h1> + <pre style="border: 1px solid black; background-color: #ccf"> + +[my-section] +option1 = value1 +option2: value2 + +[interpolated-section] +option1 = value +option2 = value2 and %(option1)s +# this is a comment; the above line evaluates to "value2 and value" + +# empty lines and comments are skipped + </pre> + + +<h1>Releases</h1> +<p>The 1.0 release can be downloaded from <a href="http://common-lisp.net/project/py-configparser/releases/py-configparser-1.0…">http://common-lisp.net/project/py-configparser/releases/py-configparser-1.0…</a></p> + +<hr> + + <div class="check"> + <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> + </div> +</body> +</html> Added: public_html/releases/py-configparser-1.0.tar.gz ============================================================================== Binary file. No diff available.

1 0

[py-configparser-cvs] r14 - in tags/1.0.0: . tests
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Sat Jan 19 16:17:40 2008 New Revision: 14 Added: tags/1.0.0/ - copied from r13, branches/1.0.x/ Modified: tags/1.0.0/py-configparser.asd tags/1.0.0/tests/py-configparser-tests.asd Log: Tag 1.0.0. Modified: tags/1.0.0/py-configparser.asd ============================================================================== --- branches/1.0.x/py-configparser.asd (original) +++ tags/1.0.0/py-configparser.asd Sat Jan 19 16:17:40 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser :name "py-configparser" :author "Erik Huelsmann" - :version "1.0.1-dev" + :version "1.0.0" :license "MIT" :description "Common Lisp implementation of the Python ConfigParser module" :depends-on (#:parse-number) Modified: tags/1.0.0/tests/py-configparser-tests.asd ============================================================================== --- branches/1.0.x/tests/py-configparser-tests.asd (original) +++ tags/1.0.0/tests/py-configparser-tests.asd Sat Jan 19 16:17:40 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser-tests :name "py-configparser-tests" :author "Erik Huelsmann" - :version "1.0.1-dev" + :version "1.0.0" :license "MIT" :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" :depends-on (#:py-configparser)

1 0

[py-configparser-cvs] r13 - branches/1.0.x branches/1.0.x/tests trunk
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Sat Jan 19 16:14:36 2008 New Revision: 13 Added: branches/1.0.x/ - copied from r12, trunk/ Modified: branches/1.0.x/README branches/1.0.x/py-configparser.asd branches/1.0.x/tests/py-configparser-tests.asd trunk/README trunk/py-configparser.asd Log: Branch for 1.0. Modified: branches/1.0.x/README ============================================================================== --- trunk/README (original) +++ branches/1.0.x/README Sat Jan 19 16:14:36 2008 @@ -1,3 +1,52 @@ +$URL$ +$Id$ -<This file is *not* intentionally left empty! > +py-configparser +=============== + +This package provides the same functionality as the Python configparser module, +implemented in pure Common Lisp. + + +Differences between the two +=========================== + +The CL version makes a strong distinction in the parser on one hand and the in-memory +storage management on the other hand. Because of it, the CL version doesn't call its +objects 'Parser', but 'config' instead. + +The parser/writer part of the package provides the three functions READ-STREAM, +READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' +and 'write'. + + +API mapping +=========== + +The functions provided in the Python module (which are all methods of the ConfigParser +class): + +ConfigParser() -> (make-config) +defaults() -> (defaults <config>) +sections() -> (sections <config>) +add_section(name) -> (add-section <config> name) +has_section(name) -> (has-section-p <config> name) +options(section_name) -> (options <config> section-name) +has_option(section_name, name) -> (has-option-p <config> section-name name) +read(filenames) -> (read-files <config> filenames) +readfd(fp) -> (read-stream <config> stream) +get(section, option[, raw[, vars]]) -> + (get-option <config> section option &key expand defaults type) +getint(section, option) -> [folded into get-option using 'type' key] +getfloat(section, option) -> [folded into get-option using 'type' key] +getboolean(section, option) -> [folded into get-option using 'type' key] +items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) +set(section, option, value) -> (set-option <config> section-name option-name value) +write(fp) -> (write-stream <config> stream) +remove_option(section, option) -> (remove-option <config> section-name option-name) +remove_section(section) -> (remove-section <config> section-name) + +Note that the above is just a simple mapping table, but is all you need to get +you started. Documentation from the ConfigParser module should sufficiently document +this package. However minor differences in parameter and method naming may occur. Modified: branches/1.0.x/py-configparser.asd ============================================================================== --- trunk/py-configparser.asd (original) +++ branches/1.0.x/py-configparser.asd Sat Jan 19 16:14:36 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser :name "py-configparser" :author "Erik Huelsmann" - :version "1.0-dev" + :version "1.0.1-dev" :license "MIT" :description "Common Lisp implementation of the Python ConfigParser module" :depends-on (#:parse-number) Modified: branches/1.0.x/tests/py-configparser-tests.asd ============================================================================== --- trunk/tests/py-configparser-tests.asd (original) +++ branches/1.0.x/tests/py-configparser-tests.asd Sat Jan 19 16:14:36 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser-tests :name "py-configparser-tests" :author "Erik Huelsmann" - :version "1.0-dev" + :version "1.0.1-dev" :license "MIT" :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" :depends-on (#:py-configparser) Modified: trunk/README ============================================================================== --- trunk/README (original) +++ trunk/README Sat Jan 19 16:14:36 2008 @@ -1,3 +1,52 @@ +$URL$ +$Id$ -<This file is *not* intentionally left empty! > +py-configparser +=============== + +This package provides the same functionality as the Python configparser module, +implemented in pure Common Lisp. + + +Differences between the two +=========================== + +The CL version makes a strong distinction in the parser on one hand and the in-memory +storage management on the other hand. Because of it, the CL version doesn't call its +objects 'Parser', but 'config' instead. + +The parser/writer part of the package provides the three functions READ-STREAM, +READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' +and 'write'. + + +API mapping +=========== + +The functions provided in the Python module (which are all methods of the ConfigParser +class): + +ConfigParser() -> (make-config) +defaults() -> (defaults <config>) +sections() -> (sections <config>) +add_section(name) -> (add-section <config> name) +has_section(name) -> (has-section-p <config> name) +options(section_name) -> (options <config> section-name) +has_option(section_name, name) -> (has-option-p <config> section-name name) +read(filenames) -> (read-files <config> filenames) +readfd(fp) -> (read-stream <config> stream) +get(section, option[, raw[, vars]]) -> + (get-option <config> section option &key expand defaults type) +getint(section, option) -> [folded into get-option using 'type' key] +getfloat(section, option) -> [folded into get-option using 'type' key] +getboolean(section, option) -> [folded into get-option using 'type' key] +items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults) +set(section, option, value) -> (set-option <config> section-name option-name value) +write(fp) -> (write-stream <config> stream) +remove_option(section, option) -> (remove-option <config> section-name option-name) +remove_section(section) -> (remove-section <config> section-name) + +Note that the above is just a simple mapping table, but is all you need to get +you started. Documentation from the ConfigParser module should sufficiently document +this package. However minor differences in parameter and method naming may occur. Modified: trunk/py-configparser.asd ============================================================================== --- trunk/py-configparser.asd (original) +++ trunk/py-configparser.asd Sat Jan 19 16:14:36 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser :name "py-configparser" :author "Erik Huelsmann" - :version "1.0-dev" + :version "1.1-dev" :license "MIT" :description "Common Lisp implementation of the Python ConfigParser module" :depends-on (#:parse-number)

1 0

[py-configparser-cvs] r12 - trunk
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Sat Jan 19 14:26:08 2008 New Revision: 12 Modified: trunk/parser.lisp Log: PROCLAIM -> DECLAIM. Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Sat Jan 19 14:26:08 2008 @@ -10,9 +10,9 @@ ;; The reader -(proclaim '(special *line-no* *current-section* *file-name* +(declaim '(special *line-no* *current-section* *file-name* *current-input*)) -(proclaim '(inline %read-char %unread-char)) +(declaim '(inline %read-char %unread-char)) (defun %read-char (stream) (let ((ch (read-char stream nil :eof))) @@ -77,7 +77,7 @@ (make-array 20 :element-type 'cl:character :fill-pointer 0 :adjustable t)) -(proclaim '(inline extend-input)) +(declaim '(inline extend-input)) (defun extend-input (p c) (vector-push-extend c *current-input* 20))

1 0

[py-configparser-cvs] r11 - trunk/tests
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Sat Jan 19 08:57:30 2008 New Revision: 11 Added: trunk/tests/ trunk/tests/py-configparser-tests.asd trunk/tests/tests.lisp Log: Add tests. Added: trunk/tests/py-configparser-tests.asd ============================================================================== --- (empty file) +++ trunk/tests/py-configparser-tests.asd Sat Jan 19 08:57:30 2008 @@ -0,0 +1,17 @@ + + +(in-package #:cl-user) + +(defpackage #:py-configparser-tests-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-tests-system) + +(defsystem py-configparser-tests + :name "py-configparser-tests" + :author "Erik Huelsmann" + :version "1.0-dev" + :license "MIT" + :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" + :depends-on (#:py-configparser) + :components ((:file "tests"))) Added: trunk/tests/tests.lisp ============================================================================== --- (empty file) +++ trunk/tests/tests.lisp Sat Jan 19 08:57:30 2008 @@ -0,0 +1,304 @@ + +(defpackage #:py-configparser-tests + (:use (#:cl #:py-configparser #:rt))) + +(in-package :py-configparser-tests) + +;; test 1 +;; should succeed +(deftest basic.parser + (typep (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.get-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "z") + "q and some more")) + T) + +(deftest basic.get-option.2 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) + "the gamma value")) + T) + +(deftest basic.get-option.3 + (with-input-from-string (s "[n] +p=15 +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) + 15)) + T) + +(deftest basic.get-option.4 + (with-input-from-string (s "[n] +p=yes +delta=%(gamma)s +z=%(p)s + and some more +") + (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) + T)) + T) + +(deftest basic.get-option.5 + (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s + and some more + +[DEFAULT] +gamma=the gamma value +") + (equal (get-option (read-stream (make-config) s) "n" "delta") + "the gamma value")) + T) + + +(deftest basic.sections + (with-input-from-string (s "[n] post-section header gunk ignored +p=q +z=%(p)s +") + (equal (sections (read-stream (make-config) s)) + '("n"))) + T) + +(deftest basic.comments-only + (typep (with-input-from-string (s "#comments only +") + (read-stream (make-config) s)) 'config) + T) + +(deftest basic.no-newline + (typep (with-input-from-string (s "#comments without trailing \#Newline") + (read-stream (make-config) s)) + 'config) + T) + +(deftest basic.with-defaults + (equal (with-input-from-string (s "[DEFAULT] +def-option = options without trailing newline") + (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) + "options without trailing newline") + T) + +;; newlines only +(deftest basic.newlines-only + (with-input-from-string (s " + + +") + (typep (get-option read-stream (make-config) s) + 'config)) + T) + +;; options +(deftest basic.options + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (options (read-stream (make-config) s) "n")) '("z" "p")) + T) + +;; items +(deftest basic.items.1 + (equal (with-inputfrom-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q"))) + T) + +(deftest basic.items.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) + T) + +(deftest basic.items.3 + (equal (with-input-from-string (s "[n] +p=q +delta=%(gamma)s +z=%(p)s +") + (items (read-stream (make-config) s) "n" :expand t + :defaults '(("gamma" . "the gamma")))) + '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) + T) + + +;; sections +(deftest basic.sections.1 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +(deftest basic.sections.2 + (equal (with-input-from-string (s "[n] +p=q +z=%(p)s + +[v] +[t] + +[DEFAULT] +p=t +") + (sections (read-stream (make-config) s))) '("t" "v" "n")) + T) + +;; add-section +(deftest basic.add-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-section-p c "v") + (add-section c "v") + (not (null (has-section-p c "v")))))) + T) + +;; set-option +(deftest basic.set-option.1 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (unless (has-option-p c "t" "b") + (set-option c "t" "b" "ok") + (equal (get-option c "t" "b") "ok")))) + T) + +(deftest basic.set-option.2 + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (set-option c "n" "p" "ok") + (equal (get-option c "n" "p") "ok"))) + T) + +;; remove-option +(deftest basic.remove-option + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-option-p c "n" "p") + (remove-option c "n" "p") + (null (has-option-p c "n" "p"))))) + T) + +;; remove-section +(deftest basic.remove-section + (with-input-from-string (s "[n] +p=q +z=%(p)s + +[t] + +") + (let ((c (read-stream (make-config) s))) + (when (has-section-p c "t") + (remove-section c "t") + (null (has-section-p c "t"))))) + T) + + + +;; now the tests that fail +(deftest failures.no-header + (with-input-from-string (s "option-before = section +[header]") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (missing-section-header-error () T))) + T) + +(deftest failures.no-spaced-option-names + (with-input-from-string (s "[n] +option with space = not allowed +") + (handler-case + (progn + (read-stream (make-config) s) + nil) + (parsing-error () T))) + T) + +(deftest failures.recursion + (with-input-from-string (s "[n] +p=%(z)s +z=%(p)s +") + (handler-case + (get-option (read-stream (make-config) s) + "n" ;; section + "p" ;; option + :expand t) + (interpolation-depth-error () T))) + T) + +;; non-erroring non-parsing tests +(deftest miscelaneous + (with-input-from-string (s "[n] +p=%(__name__)s +q=%(z)s +z=hello +") + (let ((p (read-stream (make-config) s))) + (unless (string= (get-option p "n" "p" :expand t) "n") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") + (error "Unexpected output")) + (unless (string= (get-option p "n" "q" :expand t) "hello") + (error "Unexpected output")) + (unless (string= (get-option p "n" "z") "hello") + (error "Unexpected output")) + NIL)) + NIL) \ No newline at end of file

1 0

[py-configparser-cvs] r10 - public_html
by ehuelsmann＠common-lisp.net 19 Jan '08

19 Jan '08

Author: ehuelsmann Date: Fri Jan 18 18:06:21 2008 New Revision: 10 Modified: public_html/index.shtml (props changed) Log: Set svn:keywords.

1 0

[py-configparser-cvs] r9 - trunk
by ehuelsmann＠common-lisp.net 18 Jan '08

18 Jan '08

Author: ehuelsmann Date: Fri Jan 18 17:59:09 2008 New Revision: 9 Modified: trunk/config.lisp Log: Fix issues found while writing tests: * GET-OPTION: don't forget to pass on DEFAULTS * %OPTION-VALUE: start doing something sensible Modified: trunk/config.lisp ============================================================================== --- trunk/config.lisp (original) +++ trunk/config.lisp Fri Jan 18 17:59:09 2008 @@ -162,19 +162,22 @@ (defun %option-value (config section option-name &key defaults) (if (string= option-name "__name__") (section-name section) - (let* ((norm-option-name (norm-option-name config option-name))) - (labels ((get-value (repositories) - (when (null repositories) - (error 'interpolation-missing-option-error)) - ;; no such option error - (let ((option (has-option-p config (section-name section) - option-name))) - (if option - (cdr option) + (let* ((norm-option-name (norm-option-name config option-name)) + (option (has-option-p config (section-name section) option-name))) + (if option + (cdr option) + (labels ((get-value (repositories) + (when (null repositories) + (error 'interpolation-missing-option-error)) + ;; no such option error + (let ((value (assoc norm-option-name (car repositories) + :test #'string=))) + (if value + (cdr value) (get-value (cdr repositories)))))) (get-value (list (section-options section) defaults - (defaults config))))))) + (defaults config)))))))) ;; non-API (defun %expand-option-value (config section option-value defaults @@ -234,6 +237,7 @@ (if expand (%expand-option-value config section (cdr option) + defaults (list option-name)) (cdr option)))) (cond

1 0

[py-configparser-cvs] r8 - trunk
by ehuelsmann＠common-lisp.net 17 Jan '08

17 Jan '08

Author: ehuelsmann Date: Thu Jan 17 17:39:27 2008 New Revision: 8 Modified: trunk/config.lisp Log: Fix ITEMS; found while writing tests. Modified: trunk/config.lisp ============================================================================== --- trunk/config.lisp (original) +++ trunk/config.lisp Thu Jan 17 17:39:27 2008 @@ -262,11 +262,11 @@ option values are expanded. The definition of `defaults' is the same as for `get-option'." - (let ((section (get-section config section-name))) + (let ((section (%get-section config section-name))) (if expand (mapcar #'(lambda (x) - (cons (car x) (get-option p section-name - (cdr x) ;; option-name + (cons (car x) (get-option config section-name + (car x) ;; option-name :expand t :defaults defaults))) (section-options section))

1 0

[py-configparser-cvs] r7 - trunk
by ehuelsmann＠common-lisp.net 16 Jan '08

16 Jan '08

Author: ehuelsmann Date: Wed Jan 16 16:16:32 2008 New Revision: 7 Modified: trunk/package.lisp trunk/parser.lisp Log: package.lisp: Export 'CONFIG as it is the type of the created configuration. parser.lisp: Create adjustable strings. Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Wed Jan 16 16:16:32 2008 @@ -18,6 +18,9 @@ ;; common condition class #:configparser-error + ;; configuration storage type + #:config + ;; Configuration management ;; Error classes #:no-section-erorr Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Wed Jan 16 16:16:32 2008 @@ -73,7 +73,9 @@ ch)) (defun make-input-buffer (p) - (make-array 20 :element-type 'cl:character :fill-pointer 0)) + (declare (ignore p)) + (make-array 20 :element-type 'cl:character :fill-pointer 0 + :adjustable t)) (proclaim '(inline extend-input)) (defun extend-input (p c)

1 0

[py-configparser-cvs] r6 - trunk
by ehuelsmann＠common-lisp.net 15 Jan '08

15 Jan '08

Author: ehuelsmann Date: Tue Jan 15 17:24:58 2008 New Revision: 6 Modified: trunk/parser.lisp Log: Add missing paren. Modified: trunk/parser.lisp ============================================================================== --- trunk/parser.lisp (original) +++ trunk/parser.lisp Tue Jan 15 17:24:58 2008 @@ -187,7 +187,7 @@ This function maps from the python 'readfp()' function." (let ((*file-name* stream-name)) (reading-driver config stream) - config ) + config)) (defun %format-value (value) (if (and (numberp value)

1 0

[py-configparser-cvs] r5 - trunk
by ehuelsmann＠common-lisp.net 15 Jan '08

15 Jan '08

Author: ehuelsmann Date: Tue Jan 15 15:50:38 2008 New Revision: 5 Added: trunk/LICENSE (contents, props changed) trunk/README (contents, props changed) Log: Commit LICENSE and preliminary README files. Added: trunk/LICENSE ============================================================================== --- (empty file) +++ trunk/LICENSE Tue Jan 15 15:50:38 2008 @@ -0,0 +1,23 @@ +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2008 Erik Huelsmann + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Added: trunk/README ============================================================================== --- (empty file) +++ trunk/README Tue Jan 15 15:50:38 2008 @@ -0,0 +1,3 @@ + +<This file is *not* intentionally left empty! > +

1 0

[py-configparser-cvs] r4 - trunk
by ehuelsmann＠common-lisp.net 15 Jan '08

15 Jan '08

Author: ehuelsmann Date: Tue Jan 15 15:04:27 2008 New Revision: 4 Modified: trunk/config.lisp (props changed) trunk/package.lisp (props changed) trunk/parser.lisp (props changed) trunk/py-configparser.asd (props changed) Log: Add keyword properties.

1 0

[py-configparser-cvs] r3 - public_html
by ehuelsmann＠common-lisp.net 06 Jan '08

06 Jan '08

Author: ehuelsmann Date: Sun Jan 6 16:31:28 2008 New Revision: 3 Modified: public_html/index.shtml Log: Update the website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Jan 6 16:31:28 2008 @@ -13,10 +13,48 @@ <h1></h1> </div> - <p><em>This is an automatically generated placeholder page: this project - has not yet created a website.</em></p> +<h1>Project description</h1> + <p>The <b>py-configparser</b> package implements the + <a href="http://docs.python.org/lib/module-ConfigParser.html"> + ConfigParser Python module</a> functionality in Common Lisp.</p> - <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p> + <p>In short, it implements <b>reading and writing of .INI-file style + configuration files</b> with sections containing key/value pairs of + configuration options. In line with the functionalities in the python + module, does this package implement basic interpolation of option values + in other options. + </p> + + <p>The main reason for starting the project is to be able to share + configuration files between Python and Common Lisp. Other projects + may be using the python/INI file style files too and the project is + by no means limited to the ConfigParser functionality. So, if you + have any wishes and/or nice extentions based on this format, please + send your contributions or extention requests.</p> + + <h1>Examples:</h1> + <pre style="border: 1px solid black; background-color: #ccf"> + +[my-section] +option1 = value1 +option2: value2 + +[interpolated-section] +option1 = value +option2 = value2 and %(option1)s +# this is a comment; the above line evaluates to "value2 and value" + +# empty lines and comments are skipped + </pre> + + +<h1>Releases</h1> +<p>Having recently started (Christmas hacking, 2007), the project doesn't +have any official releases yet. The code however should be useable and +the only reason there's no release is because there are no unit tests yet. +(Yea, working on it....) </p> + +<hr> <div class="check"> <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a>

1 0

[py-configparser-cvs] r2 - public_html
by ehuelsmann＠common-lisp.net 06 Jan '08

06 Jan '08

Author: ehuelsmann Date: Sun Jan 6 16:01:23 2008 New Revision: 2 Added: public_html/index.shtml public_html/project-name public_html/style.css Log: Add current website. Added: public_html/index.shtml ============================================================================== --- (empty file) +++ public_html/index.shtml Sun Jan 6 16:01:23 2008 @@ -0,0 +1,25 @@ +<?xml version="1.0"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<head> + <title></title> + <link rel="stylesheet" type="text/css" href="style.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> +</head> + +<body> + <div class="header"> + <h1></h1> + </div> + + <p><em>This is an automatically generated placeholder page: this project + has not yet created a website.</em></p> + + <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p> + + <div class="check"> + <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> + </div> +</body> +</html> Added: public_html/project-name ============================================================================== --- (empty file) +++ public_html/project-name Sun Jan 6 16:01:23 2008 @@ -0,0 +1 @@ +py-configparser Added: public_html/style.css ============================================================================== --- (empty file) +++ public_html/style.css Sun Jan 6 16:01:23 2008 @@ -0,0 +1,54 @@ + +.header { + font-size: medium; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 5px; + border-color:#002244; + padding: 1mm 1mm 1mm 5mm; +} + +.footer { + font-size: small; + font-style: italic; + text-align: right; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 2px; + border-color:#002244; + padding: 1mm 1mm 1mm 1mm; +} + +.footer a:link { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:visited { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:hover { + font-weight:bold; + color:#002244; + text-decoration:underline; } + +.check {font-size: x-small; + text-align:right;} + +.check a:link { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:visited { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:hover { font-weight:bold; + color:#000000; + text-decoration:underline; }

1 0

[py-configparser-cvs] r1 - branches developer-resources public_html tags trunk
by ehuelsmann＠common-lisp.net 06 Jan '08

06 Jan '08

Author: ehuelsmann Date: Sun Jan 6 15:59:07 2008 New Revision: 1 Added: branches/ developer-resources/ public_html/ tags/ trunk/ trunk/config.lisp trunk/package.lisp trunk/parser.lisp trunk/py-configparser.asd Log: Added: trunk/config.lisp ============================================================================== --- (empty file) +++ trunk/config.lisp Sun Jan 6 15:59:07 2008 @@ -0,0 +1,293 @@ + +(cl:in-package :py-configparser) + +;; The conditions (errors) + +(define-condition configparser-error (error) ()) + +;; Errors for the configuration management side +(define-condition config-error (configparser-error) ()) +(define-condition no-section-error (config-error) ()) +(define-condition duplicate-section-error (config-error) ()) +(define-condition no-option-error (config-error) ()) +(define-condition interpolation-error (config-error) ()) +(define-condition interpolation-depth-error (interpolation-error) ()) +(define-condition interpolation-missing-option-error (interpolation-error) ()) +(define-condition interpolation-syntax-error (interpolation-error) ()) + + +;; +;; Configuration storage and management routines +;; + + +;; The structures +;; Note: because ABCL has issues with its CLOS support +;; (as per 1-1-2008), we use structures below to +;; be maximally portable. + + +(defstruct section + name + options) + +(defstruct config + (defaults (make-section :name "DEFAULT")) + sections + (option-name-transform-fn #'string-downcase) + (section-name-transform-fn #'identity)) + +(defun norm-option-name (config option-name) + (funcall (config-option-name-transform-fn config) option-name)) + +(defun norm-section-name (config section-name) + (funcall (config-section-name-transform-fn config) section-name)) + +(defun %validate-section-name (name) + (when (or (= 0 (length name)) + (find #\] name) + (find #\Newline name) + (find #\Return name)) + (error 'no-section-error)) ;; Invalid section name, signal so. + name) + +(defun %validate-option-name (name) + (when (or (= 0 (length name)) + (eql (aref name 0) #\[) + (find #\Space name) + (find #\Tab name) + (find #\Return name) + (find #\Newline name)) + (error 'no-option-error));; No such option error + name) + +;; non-API +(defun %get-section (config section-name) + (if (string= "DEFAULT" section-name) + (config-defaults config) + (let* ((norm-section-name (norm-section-name config section-name)) + (section (find norm-section-name (config-sections config) + :key #'section-name + :test #'string=))) + (unless section + (error 'no-section-error)) ;; no-such-section error + section))) + +;; non-API +(defun %get-option (config section-name option-name if-does-not-exist) + (let* ((section (%get-section config section-name)) + (norm-option (norm-option-name config option-name)) + (option (assoc norm-option + (section-options section) + :test #'string=))) + (if (null option) + (if (eq if-does-not-exist :error) + (error 'no-option-error) ;; no such option error + (values (car (push (list (%validate-option-name option-name)) + (section-options section))) + section)) + (values option section)))) + +;; +;; The API +;; + +(defun defaults (config) + "Returns an alist containing instance wide defaults, where the +elements are 2-element dotted lists: the CDR is the value +associated with the key." + (section-options (config-defaults config))) + +(defun sections (config) + "Returns a list of names of defined sections." + (mapcar #'section-name (config-sections config))) + +(defun has-section-p (config section-name) + "Returns `NIL' when the section is not added to the config yet, +some other value if it is." + (handler-case + (%get-section config section-name) + (no-section-error () nil))) + +(defun add-section (config section-name) + "Adds a new section to the config. + +If the section exists, the `duplicate-section-error' is raised." + (%validate-section-name section-name) + (let ((norm-section-name (funcall (config-section-name-transform-fn config) + section-name))) + (when (has-section-p config section-name) + (error 'duplicate-section-error)) + (car (push (make-section :name norm-section-name) + (config-sections config))))) + +(defun options (config section-name) + "Returns a list of option names which are defined in the given section." + (let ((section (%get-section config section-name))) + (mapcar #'first (section-options section)))) + +(defun has-option-p (config section-name option-name) + "Returns a generalised boolean with a value of `NIL' when +the specified option does not exist in the specified section +and some other value otherwise." + (handler-case + (%get-option config section-name option-name :error) + (no-option-error () nil))) + +;; non-API +(defun %extract-replacement (option-value) + ;; Returns: (VALUES replacement-option start end) or NIL + (let ((%-pos (position #\% option-value))) + (when (and %-pos + (< (+ 3 %-pos) (length option-value)) + (eql (aref option-value (1+ %-pos)) #$ )) + (let ((paren-pos (position #$ option-value :start %-pos))) + (unless (and paren-pos + (< (1+ paren-pos) (length option-value)) + (eql (aref option-value (1+ paren-pos)) #\s)) + (error 'interpolation-syntax-error)) + ;; syntax error: %(..)s is minimally required + (when (<= 0 (- paren-pos %-pos 2)) + (let ((replacement-name + (make-array (- paren-pos %-pos 2) + :element-type (array-element-type option-value) + :displaced-to option-value + :displaced-index-offset (+ 2 %-pos)))) + (when (= 0 (length replacement-name)) + ;; some preconditions on replacement-name + (error 'interpolation-syntax-error)) + (values replacement-name %-pos (1+ paren-pos)))))))) + +;; non-API +(defun %option-value (config section option-name &key defaults) + (if (string= option-name "__name__") + (section-name section) + (let* ((norm-option-name (norm-option-name config option-name))) + (labels ((get-value (repositories) + (when (null repositories) + (error 'interpolation-missing-option-error)) + ;; no such option error + (let ((option (has-option-p config (section-name section) + option-name))) + (if option + (cdr option) + (get-value (cdr repositories)))))) + (get-value (list (section-options section) + defaults + (defaults config))))))) + +;; non-API +(defun %expand-option-value (config section option-value defaults + &optional dependees) + (multiple-value-bind + (replacement-name start end) + (%extract-replacement option-value) + (unless replacement-name + ;; nothing to do here... + (return-from %expand-option-value option-value)) + + (let ((norm-replacement (norm-option-name config replacement-name)) + (replacement-value (%option-value config section + replacement-name + :defaults defaults))) + (when (member norm-replacement dependees :test #'string=) + (error 'interpolation-depth-error)) ;; recursive dependency... + (%expand-option-value + config + section + (concatenate 'string + (subseq option-value 0 start) + (%expand-option-value config + section + replacement-value + defaults + (cons norm-replacement dependees)) + (subseq option-value (1+ end) (length option-value))) + defaults + dependees)))) + +(defun get-option (config section-name option-name + &key (expand t) defaults type) + "Returns the value of the specified option in the specified section. + +If `expand' is `NIL', any options which depend on other options +won't be expanded and the raw configuration value is returned. + +When `defaults' is an alist of which the elements are dotted lists of +key/value pairs, these values are used in the expansion of option values. + +`type' may be one of `:boolean', `:number' or it may remain unspecified." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (flet ((convert-boolean (v) + (cond + ((member v '("1" "yes" "true" "on") :test #'string=) + T) + ((member v '("0" "no" "false" "off") :test #'string=) + NIL) + (t + (error 'not-a-boolean)))) + (convert-number (v) + (parse-number:parse-number v))) + (let ((string-value + (if expand + (%expand-option-value config + section (cdr option) + (list option-name)) + (cdr option)))) + (cond + ((eq type :boolean) + (convert-boolean string-value)) + ((eq type :number) + (convert-number string-value)) + ((null type) + string-value) + (t + (error "Illegal `type' parameter value."))))))) + +(defun set-option (config section-name option-name value) + "Sets the value of the specified option in the specified section. + +If the section does not exist, a `no-section-error' is raised. If the +option does not exist, it is created." + (let ((option (%get-option config section-name option-name :create))) + (setf (cdr option) value))) + +(defun items (config section-name &key (expand t) defaults) + "Returns an alist of which the items are dotted lists of key/value +pairs being the option names and values specified in the given section. + +When `expand' is `NIL', options are returned in raw form. Otherwise +option values are expanded. + +The definition of `defaults' is the same as for `get-option'." + (let ((section (get-section config section-name))) + (if expand + (mapcar #'(lambda (x) + (cons (car x) (get-option p section-name + (cdr x) ;; option-name + :expand t + :defaults defaults))) + (section-options section)) + (section-options section)))) + +(defun remove-option (config section-name option-name) + "Remove the specified option from the given section." + (multiple-value-bind + (option section) + (%get-option config section-name option-name :error) + (setf (section-options section) + (remove option (section-options section))))) + +(defun remove-section (config section-name) + "Remove the specified section. + +In case the section name equals the magic name `DEFAULT', +an error is raised, since this section can't be removed." + (when (string= section-name "DEFAULT") + (error 'no-section-error)) ;; no such section error + (let ((section (%get-section config section-name))) + (setf (config-sections config) + (remove section (config-sections config))))) + Added: trunk/package.lisp ============================================================================== --- (empty file) +++ trunk/package.lisp Sun Jan 6 15:59:07 2008 @@ -0,0 +1,54 @@ + +;; This package is actuall two things: +;; 1) a configuration management utility +;; 2) a configuration file parser/writer in the .INI format +;; +;; But in the Python module this distinction hasn't been implemented +;; this stringently, meaning we're stuck to the current naming scheme. + +;; There's no reason however that you can't create your own format +;; and parse that, storing it in the config object as defined in this +;; package. (However, if you already use this module, you might as well +;; use the INI format as persistent format.) + + +(cl:defpackage #:py-configparser + (:use #:cl) + (:export + ;; common condition class + #:configparser-error + + ;; Configuration management + ;; Error classes + #:no-section-erorr + #:duplicate-section-error + #:no-option-error + #:interpolation-error + #:interpolation-depth-error + #:interpolation-missing-option-error + #:interpolation-syntax-error + + ;; Functions + #:make-config + #:defaults + #:sections + #:has-section-p + #:add-section + #:options + #:has-option-p + #:get-option + #:set-option + #:items + #:remove-option + #:remove-section + + ;; Configuration file parsing + ;; Error classes + #:parsing-error + #:missing-section-header-error + + ;; Functions + #:read-stream + #:read-files + #:write-stream)) + Added: trunk/parser.lisp ============================================================================== --- (empty file) +++ trunk/parser.lisp Sun Jan 6 15:59:07 2008 @@ -0,0 +1,216 @@ + +(cl:in-package #:py-configparser) + +;; Errors for the parsing side + +(define-condition parsing-error (configparser-error) ()) +(define-condition missing-section-header-error (parsing-error) ()) + + + +;; The reader + +(proclaim '(special *line-no* *current-section* *file-name* + *current-input*)) +(proclaim '(inline %read-char %unread-char)) + +(defun %read-char (stream) + (let ((ch (read-char stream nil :eof))) + (when (eql ch #\Newline) + (incf *line-no*)) + (if (eq ch :eof) #\Newline ch))) + +(defun ensure-section (config section-name) + (handler-case + (%get-section config section-name) + (no-section-error () + (add-section config section-name))) + section-name) + +(defun is-whitespace (c) + (or (eq c #\Space) + (eq c #\Tab) + (eq c #\Return))) + +(defun is-comment-char (c) + (or (eq c #\;) + (eq c #\#))) + +(defun skip-whitespace (s) + (loop for c = (%read-char s) + while (is-whitespace c))) + +(defun skip-emtpy-line (s) + (loop for c = (%read-char s) + if (eq c #\Newline) do (return) + else unless (is-whitespace c) + do (error 'parsing-error))) ;; empty line expected + +(defun skip-to-eol (s) + (loop for c = (%read-char s) + until (eq c #\Newline))) + +(defun expect-char (s expect &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (eq ch expect) + (error 'parsing-error)) ;; character expect expected, but ch found + ch)) + +(defun expect-one-of (s expect-bag &key skip-whitespace) + (let ((ch (%read-char s))) + (when (and skip-whitespace + (is-whitespace ch)) + (loop for c = (%read-char s) + while (is-whitespace c) + finally (setf ch c))) + (unless (member ch expect-bag) + (error 'parsing-error)) ;; character ch found, but looking for EXPECT-BAG + ch)) + +(defun make-input-buffer (p) + (make-array 20 :element-type 'cl:character :fill-pointer 0)) + +(proclaim '(inline extend-input)) +(defun extend-input (p c) + (vector-push-extend c *current-input* 20)) + +(defun finalize-input (p) + (let ((cp *current-input*)) + (setf *current-input* + (make-input-buffer p)) + cp)) + +(defun read-section-name (p s) + (expect-char s #\[) + (loop for c = (%read-char s) + if (eq c #\Newline) + do (error 'parsing-error) ;; we can't have newlines in section names! + else if (eq c #\]) + do (progn + (skip-to-eol s) + (return (finalize-input p))) + else do (extend-input p c))) + +(defun read-option-name (p s) + (loop for c = (%read-char s) + if (or (eq c #\:) + (eq c #\=)) + do (let ((option-name (finalize-input p))) + (when (= 0 (length option-name)) + (error 'parsing-error)) ;; No option name found + (return option-name)) + else if (is-whitespace c) + do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) + else do (extend-input p c))) + +(defun read-option-value (p s &key (leading-white :skip)) + (let ((leading-mode t) + (lead-detected nil)) + (loop for c = (%read-char s) + unless (or (eql c #\Return) + (eql c #\Newline)) + do (if (and leading-mode + (is-whitespace c)) + (setf lead-detected t) + (progn + (when (and (eq leading-white :fold) + leading-mode + lead-detected) + (extend-input p #\Space)) + (setf leading-mode nil) + (extend-input p c))) + + if (and (eql c #\Newline) + (let ((ch (peek-char nil s nil nil))) + (or (eql ch #\Space) + (eql ch #\Tab)))) + do (return (read-option-value p s :leading-white :fold)) + until (eql c #\Newline) + finally (return (finalize-input p))))) + +(defun reading-driver (p s) + (let ((*line-no* 0) + (*current-section* nil) + (*current-input* (make-input-buffer p))) + (loop for c = (peek-char nil s nil :eof) + until (eq c :eof) + if (eql c #\[) + do (setf *current-section* + (ensure-section p (read-section-name p s))) + + else if (is-whitespace c) + do (skip-empty-line s) + + else if (is-comment-char c) + do (skip-to-eol s) + + else if (eql c #\Newline) + do (%read-char s) ;; skip over the newline character + + else do (if (null *current-section*) + (error 'missing-section-header-error) + (set-option p + *current-section* + (read-option-name p s) + (read-option-value p s)))))) + +;; +;; The API +;; + +(defun read-files (config filenames) + "Parses the files given in the list `filenames', if they exist. +The list is processed first to last, overwriting any pre-existing +values with the last value read. + +The results are stored in `config' which is modified destructively. + +Returns as values the configuration and the list of files actually read." + (let (files-read) + (dolist (filename (mapcar #'probe-file filenames) + (values config files-read)) + (with-open-file (s filename + :direction :input + :if-does-not-exist :error) + (read-stream config s :stream-name filename)) + (push filename files-read)))) + +(defun read-stream (config stream &key (stream-name "an unknown stream")) + "Parses the content of `stream' as a configuration file, +storing any values in `config' which is modified destructively. + +This function maps from the python 'readfp()' function." + (let ((*file-name* stream-name)) + (reading-driver config stream) + config ) + +(defun %format-value (value) + (if (and (numberp value) + (not (integerp value))) + (format nil "~,,,,,,'eE" value) + value)) + +(defun write-stream (config stream) + "Writes the configuration file corresponding to the +in-memory config state. Reloading the file +with `read-stream' or `read-files' will restore config state." + (flet ((write-section (section) + (format stream "[~a]~%" (section-name section)) + (format stream "~:{~A = ~{~A~%~}~}~%" + (mapcar #'(lambda (option) + (list (car option) + (list (%format-value (cdr option))))) + (section-options section))))) + (let ((*print-radix* nil) + (*print-base* 10)) + ;; set the printer output as expected by python + (when (defaults config) + ;; write the defaults too!! + (write-section (config-defaults config))) + (mapcar #'write-section (config-sections config))))) + Added: trunk/py-configparser.asd ============================================================================== --- (empty file) +++ trunk/py-configparser.asd Sun Jan 6 15:59:07 2008 @@ -0,0 +1,20 @@ + + +(in-package #:cl-user) + +(defpackage #:py-configparser-system + (:use #:cl #:asdf)) + +(in-package #:py-configparser-system) + +(defsystem py-configparser + :name "py-configparser" + :author "Erik Huelsmann" + :version "1.0-dev" + :license "MIT" + :description "Common Lisp implementation of the Python ConfigParser module" + :depends-on (#:parse-number) + :components ((:file "package") + (:file "config" :depends-on ("package")) + (:file "parser" :depends-on ("config")))) +

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

py-configparser-cvs