py-configparser-cvs

py-configparser-cvs@common-lisp.net

46 discussions

[py-configparser-cvs] r26 - public_html
by ehuelsmann＠common-lisp.net 15 Mar '08

15 Mar '08

Author: ehuelsmann Date: Fri Mar 14 18:16:06 2008 New Revision: 26 Modified: public_html/index.shtml Log: xhtml conformance. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Fri Mar 14 18:16:06 2008 @@ -58,7 +58,7 @@ <p><b><a href="releases/">The download area</a></b></p> -<hr> +<hr /> <div class="check"> <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a>

1 0

[py-configparser-cvs] r25 - public_html
by ehuelsmann＠common-lisp.net 15 Mar '08

15 Mar '08

Author: ehuelsmann Date: Fri Mar 14 18:13:28 2008 New Revision: 25 Modified: public_html/index.shtml Log: Update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Fri Mar 14 18:13:28 2008 @@ -32,6 +32,10 @@ have any wishes and/or nice extentions based on this format, please send your contributions or extention requests.</p> + <h2>Contact</h2> + <p>You can reach the developer(s) at the development list: + <b>py-configparser-devel(a)common-lisp.net</b></p> + <h1>Examples:</h1> <pre style="border: 1px solid black; background-color: #ccf"> @@ -49,8 +53,11 @@ <h1>Releases</h1> +<p>The 1.0.1 release fixes compilation problems with at least SBCL and a packaging problem. Next to that, it adds better error messages.</p> <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> +<p><b><a href="releases/">The download area</a></b></p> + <hr> <div class="check">

1 0

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

14 Mar '08

Author: ehuelsmann Date: Fri Mar 14 17:43:58 2008 New Revision: 24 Modified: branches/1.0.x/py-configparser.asd branches/1.0.x/tests/py-configparser-tests.asd Log: Update branch version. 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:43:58 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser :name "py-configparser" :author "Erik Huelsmann" - :version "1.0.1-dev" + :version "1.0.2-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 ============================================================================== --- branches/1.0.x/tests/py-configparser-tests.asd (original) +++ branches/1.0.x/tests/py-configparser-tests.asd Fri Mar 14 17:43:58 2008 @@ -10,7 +10,7 @@ (defsystem py-configparser-tests :name "py-configparser-tests" :author "Erik Huelsmann" - :version "1.0.1-dev" + :version "1.0.22-dev" :license "MIT" :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" :depends-on (#:py-configparser)

1 0

[py-configparser-cvs] r23 - public_html/releases
by ehuelsmann＠common-lisp.net 14 Mar '08

14 Mar '08

Author: ehuelsmann Date: Fri Mar 14 17:37:46 2008 New Revision: 23 Added: public_html/releases/py-configparser-1.0.1.tar.gz (contents, props changed) Log: Publish 1.0.1. Added: public_html/releases/py-configparser-1.0.1.tar.gz ============================================================================== Binary file. No diff available.

1 0

[py-configparser-cvs] r22 - in tags/1.0.1: . tests
by ehuelsmann＠common-lisp.net 14 Mar '08

14 Mar '08

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

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

py-configparser-cvs