Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -40,10 +40,22 @@ (define (config:eval-string-in-environment str) (let ((cmdres (cmd-run->list (conc "echo " str)))) (if (null? cmdres) "" (caar cmdres)))) +;;====================================================================== +;; Make the regexp's needed globally available +;;====================================================================== + +(define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) +(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$")) +(define configf:blank-l-rx (regexp "^\\s*$")) +(define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) +(define configf:key-val-pr (regexp "^(\\S+)\\s+(.*)$")) +(define configf:comment-rx (regexp "^\\s*#.*")) +(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) + ;; read a config file, returns hash table of alists ;; adds to ht if given (must be #f otherwise) ;; envion-patt is a regex spec that identifies sections that will be eval'd ;; in the environment on the fly @@ -50,18 +62,11 @@ (define (read-config path ht allow-system #!key (environ-patt #f)) (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt) (if (not (file-exists? path)) (if (not ht)(make-hash-table) ht) (let ((inp (open-input-file path)) - (res (if (not ht)(make-hash-table) ht)) - (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) - (section-rx (regexp "^\\[(.*)\\]\\s*$")) - (blank-l-rx (regexp "^\\s*$")) - (key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) - (key-val-pr (regexp "^(\\S+)\\s+(.*)$")) - (comment-rx (regexp "^\\s*#.*")) - (cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))) + (res (if (not ht)(make-hash-table) ht))) (let loop ((inl (read-line inp)) (curr-section-name "default") (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (if (eof-object? inl) @@ -68,17 +73,17 @@ (begin (close-input-port inp) res) (regex-case inl - (comment-rx _ (loop (read-line inp) curr-section-name #f #f)) - (blank-l-rx _ (loop (read-line inp) curr-section-name #f #f)) - (include-rx ( x include-file ) (begin + (configf:comment-rx _ (loop (read-line inp) curr-section-name #f #f)) + (configf:blank-l-rx _ (loop (read-line inp) curr-section-name #f #f)) + (configf:include-rx ( x include-file ) (begin (read-config include-file res allow-system environ-patt: environ-patt) (loop (read-line inp) curr-section-name #f #f))) - (section-rx ( x section-name ) (loop (read-line inp) section-name #f #f)) - (key-sys-pr ( x key cmd ) (if allow-system + (configf:section-rx ( x section-name ) (loop (read-line inp) section-name #f #f)) + (configf:key-sys-pr ( x key cmd ) (if allow-system (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((cmdres (cmd-run->list cmd)) (status (cadr cmdres)) (res (car cmdres))) @@ -95,11 +100,11 @@ (if (eq? allow-system 'return-procs) val-proc (val-proc)))) (loop (read-line inp) curr-section-name #f #f)) (loop (read-line inp) curr-section-name #f #f))) - (key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) + (configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) (envar (and environ-patt (string-match (regexp environ-patt) curr-section-name))) (realval (if envar (config:eval-string-in-environment val) val))) (if envar @@ -108,11 +113,11 @@ (setenv key realval))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key realval)) (loop (read-line inp) curr-section-name key #f))) ;; if a continued line - (cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) + (configf:cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) (if var-flag ;; if set to a string then we have a continued var (let ((newval (conc (config-lookup res curr-section-name var-flag) "\n" ;; trim lead from the incoming whsp to support some indenting. (if lead @@ -174,11 +179,11 @@ (led #f) (res '())) ;; ALL WHITESPACE LEADING LINES ARE TACKED ON!! ;; 1. remove led whitespace ;; 2. tack on to hed with "\n" - (let ((match (string-match cont-ln-rx hed))) + (let ((match (string-match configf:cont-ln-rx hed))) (if match ;; blast! have to deal with a multiline (let* ((lead (cadr match)) (lval (caddr match)) (newl (conc cur "\n" lval))) (if (not led)(set! led lead)) @@ -191,37 +196,21 @@ ;; prev was a multiline (if (null? tal) newres (loop (car tal)(cdr tal) "" #f newres)))))))) +;; note: I'm cheating a little here. I merely replace "\n" with "\n " (define (configf:expand-multi-lines fdat) ;; step 1.5 - compress any continued lines (if (null? fdat) fdat - (let loop ((hed (car fdat)) - (tal (cdr fdat)) - (cur "") - (led #f) - (res '())) - ;; ALL WHITESPACE LEADING LINES ARE TACKED ON!! - ;; 1. remove led whitespace - ;; 2. tack on to hed with "\n" - (let ((match (string-match cont-ln-rx hed))) - (if match ;; blast! have to deal with a multiline - (let* ((lead (cadr match)) - (lval (caddr match)) - (newl (conc cur "\n" lval))) - (if (not led)(set! led lead)) - (if (null? tal) - (set! fdat (append fdat (list newl))) - (loop (car tal)(cdr tal) newl led res))) ;; NB// not tacking newl onto res - (let ((newres (if led - (append res (list cur hed)) - (append res (list hed))))) - ;; prev was a multiline - (if (null? tal) - newres - (loop (car tal)(cdr tal) "" #f newres)))))))) + (let loop ((hed (car fdat)) + (tal (cdr fdat)) + (res '())) + (let ((newres (append res (list (string-substitute (regexp "\n") "\n " hed #t))))) + (if (null? tal) + newres + (loop (car tal)(cdr tal) newres)))))) (define (configf:file->list fname) (if (file-exists? fname) (let ((inp (open-input-file fname))) (let loop ((inl (read-line inp)) @@ -242,48 +231,41 @@ ;; 4. Append new values to the section (immediately after last legit entry) ;; 5. Write out the new list ;;====================================================================== (define (configf:write-config indat fname #!key (required-sections '())) - (let* ((include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) - (section-rx (regexp "^\\[(.*)\\]\\s*$")) - (blank-l-rx (regexp "^\\s*$")) - (key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) - (key-val-pr (regexp "^(\\S+)\\s+(.*)$")) - (comment-rx (regexp "^\\s*#.*")) - (cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) - ;; step 1: Open the output file and read it into a list + (let* (;; step 1: Open the output file and read it into a list (fdat (configf:file->list fname)) (refdat (make-hash-table)) (sechash (make-hash-table)) ;; current section hash, init with hash for "default" section - (new #f)) ;; put the line to be used in new, if it is to be deleted the set new to #f + (new #f) ;; put the line to be used in new, if it is to be deleted the set new to #f + (secname #f)) ;; step 2: Flatten multiline entries (if (not (null? fdat))(set! fdat (configf:compress-multi-line fdat))) ;; step 3: Modify values per contents of "indat" and remove absent values (if (not (null? fdat)) (let loop ((hed (car fdat)) (tal (cadr fdat)) (res '()) - (sec #f) ;; section (lnum 0)) (regex-case hed - (comment-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) - (blank-l-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) - (section-rx ( x section-name ) (let ((section-hash (hash-table-ref/default refdat section-name #f))) + (configf:comment-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) + (configf:blank-l-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) + (configf:section-rx ( x section-name ) (let ((section-hash (hash-table-ref/default refdat section-name #f))) (if (not section-hash) (let ((newhash (make-hash-table))) (hash-table-set! refhash section-name newhash) (set! sechash newhash)) (set! sechash section-hash)) (set! new hed) ;; will append this at the bottom of the loop - (set! sec section-name) + (set! secname section-name) )) ;; No need to process key cmd, let it fall though to key val - (key-val-pr ( x key val ) + (configf:key-val-pr ( x key val ) (let ((newval (config-lookup indat sec key))) ;; can handle newval == #f here => that means key is removed (cond ((equal? newval val) (set! res (append res (list hed))))