Differences From Artifact [15f0835800]:
- File attic/configf.scm — part of check-in [101ee7c52b] at 2021-03-06 04:39:46 on branch v1.65-real-chicken-5 — Try a grounds-up switch to chicken-5 (user: matt, size: 42682) [annotate] [blame] [check-ins using]
- File configf.scm — part of check-in [f8657e116c] at 2021-02-14 22:33:19 on branch v1.65-real — Synced minor changes from modularized v1.6569-mult-db-wip branch (user: matt, size: 42682) [annotate] [blame] [check-ins using]
To Artifact [d67198199a]:
- File
configf.scm
(unpublished)— part of check-in
[87669bb7f8]
at
2021-02-25 23:25:16
on branch v1.65-real-reenable-eval-if
— Merged diet branch
From: 84be6d275afcef4ec123f4afd946b77ff0440ce3 User: matt (user: matt, size: 42287) [annotate] [blame] [check-ins using]
︙ | ︙ | |||
56 57 58 59 60 61 62 | (define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f)) (hash-table-set! cfgdat section-name (configf:assoc-safe-add (hash-table-ref/default cfgdat section-name '()) var value metadata: metadata))) | | | | | | | | | | | | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | (define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f)) (hash-table-set! cfgdat section-name (configf:assoc-safe-add (hash-table-ref/default cfgdat section-name '()) var value metadata: metadata))) ;; The if was disabled, but why? (if (or (string-null? str) (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment str (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment, exn=" exn) #f) (let ((cmdres (process: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:script-rx (regexp "^\\[scriptinc\\s+(\\S+)([^\\]]*)\\]\\s*$")) ;; include output from a script |
︙ | ︙ | |||
124 125 126 127 128 129 130 | ((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))")) (else (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.") "(lambda (ht) #f)"))) ((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) ;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))) | < < | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | ((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))")) (else (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.") "(lambda (ht) #f)"))) ((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) ;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\", exn=" exn) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd))) (if (or allow-system (not (member cmdtype '("system" "shell" "sh")))) (with-input-from-string fullcmd (lambda () (set! result ((eval (read)) ht)))) (set! result (conc "#{(" cmdtype ") " cmd "}")))) |
︙ | ︙ | |||
263 264 265 266 267 268 269 | ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections ;; (define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f) (sections #f) (settings (make-hash-table)) (keep-filenames #f) (post-section-procs '()) (apply-wildcards #t) ) (debug:print 9 *default-log-port* "START: " path) | < < < < < < < | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections ;; (define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f) (sections #f) (settings (make-hash-table)) (keep-filenames #f) (post-section-procs '()) (apply-wildcards #t) ) (debug:print 9 *default-log-port* "START: " path) (if (and (not (port? path)) (not (common:file-exists? path))) ;; for case where we are handed a port (begin (debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory)) ;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read? #f) ;; (if (not ht)(make-hash-table) ht)) (let ((inp (if (string? path) |
︙ | ︙ |