Overview
Comment: | Added wildcards to config processing. Made ini the default for dumping runconfigs |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63 |
Files: | files | file ages | folders |
SHA1: |
4f34e9ebdb3741bed7e4ac9201c0eaed |
User & Date: | mrwellan on 2017-02-10 15:01:47 |
Other Links: | branch diff | manifest | tags |
Context
2017-02-10
| ||
15:16 | Added some brief info on wildcards in runconfigs to the user manual check-in: 39f84a3f86 user: mrwellan tags: v1.63 | |
15:01 | Added wildcards to config processing. Made ini the default for dumping runconfigs check-in: 4f34e9ebdb user: mrwellan tags: v1.63 | |
2017-02-08
| ||
17:06 | added ducttape-lib installation check-in: 5972048eaa user: bjbarcla tags: v1.63 | |
Changes
Modified common.scm from [fb7f04018e] to [ef963426c3].
︙ | ︙ | |||
748 749 750 751 752 753 754 | (string-split patts ",")) res) #t)) ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t)))) (define (common:get-runconfig-targets #!key (configf #f)) (let ((targs (sort (map car (hash-table->alist | | | 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 | (string-split patts ",")) res) #t)) ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t)))) (define (common:get-runconfig-targets #!key (configf #f)) (let ((targs (sort (map car (hash-table->alist (or configf ;; NOTE: There is no value in using runconfig:read here. (read-config (conc *toppath* "/runconfigs.config") #f #t) (make-hash-table)))) string<?)) (target-patt (args:get-arg "-target"))) (if target-patt (filter (lambda (x) |
︙ | ︙ |
Modified configf.scm from [ddff2b4e5d] to [7cf9abed09].
︙ | ︙ | |||
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | (define (calc-allow-system allow-system section sections) (if sections (and (or (equal? "default" section) (member section sections)) allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings allow-system)) ;; read a config file, returns hash table of alists ;; 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 ;; sections: #f => get all, else list of sections to gather ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; | > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | (define (calc-allow-system allow-system section sections) (if sections (and (or (equal? "default" section) (member section sections)) allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings allow-system)) ;; given a config hash and a section name, apply that section to all matching sections (using wildcard % or regex if /..../) ;; remove the section when done so that there is no downstream clobbering ;; (define (configf:apply-wildcards ht section-name) (if (hash-table-exists? ht section-name) (let ((vars (hash-table-ref ht section-name)) (rx (regexp (if (string-contains section-name "%") (string-substitute section-name "%" ".*") section-name)))) (for-each (lambda (section) (if (and section-name section (not (string=? section-name section)) (string-match rx section)) (for-each (lambda (bundle) (let ((key (car bundle)) (val (cadr bundle)) (meta (if (> (length bundle) 2)(caddr bundle) #f))) (hash-table-set! ht section (config:assoc-safe-add (hash-table-ref ht section) key val metadata: meta)))) vars))) (hash-table-keys ht)))) ht) ;; read a config file, returns hash table of alists ;; 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 ;; sections: #f => get all, else list of sections to gather ;; 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-info 5 *default-log-port* "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory)) (debug:print 9 *default-log-port* "START: " path) (if (and (not (port? path)) (not (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) (open-input-file path) path)) ;; we can be handed a port (res (if (not ht)(make-hash-table) ht)) (metapath (if (or (debug:debug-mode 9) keep-filenames) path #f)) (process-wildcards (lambda (res curr-section-name) (if (and apply-wildcards (or (string-contains curr-section-name "%") ;; wildcard (string-match "/.*/" curr-section-name))) ;; regex (begin (configf:apply-wildcards res curr-section-name) (hash-table-delete! res curr-section-name)))))) ;; NOTE: if the section is a wild card it will be REMOVED from res (let loop ((inl (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)) ;; (read-line inp)) (curr-section-name (if curr-section curr-section "default")) (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (debug:print-info 8 *default-log-port* "curr-section-name: " curr-section-name " var-flag: " var-flag "\n inl: \"" inl "\"") (if (eof-object? inl) (begin ;; process last section for wildcards (process-wildcards res curr-section-name) (if (string? path) ;; we received a path, not a port, thus we are responsible for closing it. (close-input-port inp)) (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht (debug:print 9 *default-log-port* "END: " path) res) (regex-case inl |
︙ | ︙ | |||
263 264 265 266 267 268 269 270 271 272 273 274 275 276 | (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name res path)))) post-section-procs) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f))) (configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section-name sections) | > > > | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name res path)))) post-section-procs) ;; after gathering the vars for a section and if apply-wildcards is true and if there is a wildcard in the section name process wildcards ;; NOTE: we are processing the curr-section-name, NOT section-name. (process-wildcards res curr-section-name) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f))) (configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section-name sections) |
︙ | ︙ |
Modified dashboard-tests.scm from [07aba72013] to [0388c35774].
︙ | ︙ | |||
461 462 463 464 465 466 467 | ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) keydat) "/")) (item-path (db:test-get-item-path testdat)) ;; this next block was added to fix a bug where variables were ;; needed. Revisit this. | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) keydat) "/")) (item-path (db:test-get-item-path testdat)) ;; this next block was added to fix a bug where variables were ;; needed. Revisit this. (runconfig (let ((runconfigf (conc *toppath* "/runconfigs.config"))) ;; no rush but it would be good to convert this call to use runconfig:read (if (file-exists? runconfigf) (handle-exceptions exn #f ;; do nothing, just keep on trucking .... (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring)) (make-hash-table)))) (testconfig (begin |
︙ | ︙ |
Modified launch.scm from [13e6c119c2] to [fb952635f4].
︙ | ︙ | |||
771 772 773 774 775 776 777 | mtconfig environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (first-rundat (let ((toppath (if toppath toppath (car first-pass)))) | | | 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 | mtconfig environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (first-rundat (let ((toppath (if toppath toppath (car first-pass)))) (read-config ;; (conc toppath "/runconfigs.config") ;; this should be converted to runconfig:read but it is non-trivial, leaving it for now. (conc (if (string? toppath) toppath (get-environment-variable "MT_RUN_AREA_HOME")) "/runconfigs.config") *runconfigdat* #t sections: sections)))) (set! *runconfigdat* first-rundat) |
︙ | ︙ | |||
804 805 806 807 808 809 810 | environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals) | | | | 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals) (read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ... sections: sections)))) (if cancreate (configf:write-alist runconfigdat rccachef)) (set! *runconfigdat* runconfigdat) (if cancreate (configf:write-alist *configdat* mtcachef)) (if cancreate (set! *configstatus* 'fulldata)))) ;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table (set! *configdat* (make-hash-table)) ))) ;; else read what you can and set the flag accordingly (else (let* ((cfgdat (find-and-read-config (or (args:get-arg "-config") "megatest.config") environ-patt: "env-override" given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") pathenvvar: "MT_RUN_AREA_HOME"))) (if cfgdat (let* ((toppath (or (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat))) (rdat (read-config (conc toppath ;; convert this to use runconfig:read! "/runconfigs.config") *runconfigdat* #t sections: sections))) (set! *configinfo* cfgdat) (set! *configdat* (car cfgdat)) (set! *runconfigdat* rdat) (set! *toppath* toppath) (set! *configstatus* 'partial)) (begin |
︙ | ︙ |
Modified megatest.scm from [a5939c080a] to [14c2234bc7].
︙ | ︙ | |||
838 839 840 841 842 843 844 | (sections (if target (list "default" target) #f)) (data (begin (setenv "MT_RUN_AREA_HOME" *toppath*) (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) | | > | 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 | (sections (if target (list "default" target) #f)) (data (begin (setenv "MT_RUN_AREA_HOME" *toppath*) (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections)))) (runconfig:read (conc *toppath* "/runconfigs.config") target #f)))) (if (and rundir ;; have all needed variabless (directory-exists? rundir) (file-write-access? rundir)) (begin (configf:write-alist data cfgf) ;; force re-read of megatest.config - this resolves circular references between megatest.config (launch:setup force: #t) |
︙ | ︙ | |||
860 861 862 863 864 865 866 | ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")) (configf:lookup data "default" (args:get-arg "-var"))))) (if val (print val)))) | | > > > < < | 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")) (configf:lookup data "default" (args:get-arg "-var"))))) (if val (print val)))) ((or (not (args:get-arg "-dumpmode")) (string=? (args:get-arg "-dumpmode") "ini")) (configf:config->ini data)) ((string=? (args:get-arg "-dumpmode") "sexp") (pp (hash-table->alist data))) ((string=? (args:get-arg "-dumpmode") "json") (json-write data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t)) (pop-directory))) (if (args:get-arg "-show-config") (let ((tl (launch:setup)) |
︙ | ︙ |
Modified runconfig.scm from [42efb3636c] to [6cd6ed4572].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") ;; NB// to process a runconfig ensure to use environ-patt with target! ;; (define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t)) (let* ((keys (map car keyvals)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/") (or (common:args-get-target) (get-environment-variable "MT_TARGET") (begin (debug:print-error 0 *default-log-port* "setup-env-defaults called with no run-id or -target or -reqtarg") "nothing matches this I hope")))) ;; Why was system disallowed in the reading of the runconfigs file? ;; NOTE: Should be setting env vars based on (target|default) | > > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") (define (runconfig:read fname target environ-patt) (let ((ht (make-hash-table))) (hash-table-set! ht target '()) (read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f)))) ;; NB// to process a runconfig ensure to use environ-patt with target! ;; (define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t)) (let* ((keys (map car keyvals)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/") (or (common:args-get-target) (get-environment-variable "MT_TARGET") (begin (debug:print-error 0 *default-log-port* "setup-env-defaults called with no run-id or -target or -reqtarg") "nothing matches this I hope")))) ;; Why was system disallowed in the reading of the runconfigs file? ;; NOTE: Should be setting env vars based on (target|default) (confdat (runconfig:read fname thekey environ-patt)) (whatfound (make-hash-table)) (finaldat (make-hash-table)) (sections (list "default" thekey))) (if (not *target*)(set! *target* thekey)) ;; may save a db access or two but repeats db:get-target code (debug:print 4 *default-log-port* "Using key=\"" thekey "\"") (if change-env |
︙ | ︙ |