Overview
Comment: | First pass at processing sections on the fly |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
22daf8e2825d6bb3b3fe8c0c72b4c905 |
User & Date: | mrwellan on 2015-11-16 13:00:00 |
Other Links: | branch diff | manifest | tags |
Context
2015-12-03
| ||
22:46 | Initial version of spublish check-in: 5f3d099673 user: matt tags: v1.60 | |
2015-11-26
| ||
21:59 | db refactor Closed-Leaf check-in: 7102506f8d user: matt tags: v1.60-db-refactor | |
2015-11-16
| ||
13:00 | First pass at processing sections on the fly check-in: 22daf8e282 user: mrwellan tags: v1.60 | |
2015-11-12
| ||
14:11 | Be more lazy on running sync to megatest.db check-in: 27552d9089 user: mrwellan tags: v1.60 | |
Changes
Modified configf.scm from [39454623be] to [e9f35be8ad].
︙ | ︙ | |||
174 175 176 177 178 179 180 | ;; 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 | > > | | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | ;; 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) ;; (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 '())) (debug:print-info 5 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory)) (debug:print 9 "START: " path) (if (not (file-exists? path)) (begin (debug:print-info 1 "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)) |
︙ | ︙ | |||
224 225 226 227 228 229 230 | (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) ;; (pop-directory) (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) (begin (debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 " " full-conf) (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))))) | | > > > > > > > > > | | | | | | 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 | (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) ;; (pop-directory) (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) (begin (debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 " " full-conf) (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))))) (configf:section-rx ( x section-name ) (begin ;; call post-section-procs (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name ht path)))) post-section-procs) (loop (configf:read-line inp res allow-system 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 allow-system (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((start-time (current-seconds)) (cmdres (cmd-run->list cmd)) (delta (- (current-seconds) start-time)) (status (cadr cmdres)) |
︙ | ︙ | |||
299 300 301 302 303 304 305 | (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))))))) ;; pathenvvar will set the named var to the path of the config (define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname toppath: given-toppath)) (toppath (car configinfo)) | | > > > > | > | 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 | (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))))))) ;; pathenvvar will set the named var to the path of the config (define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname toppath: given-toppath)) (toppath (car configinfo)) (configfile (cadr configinfo)) (set-fields (lambda (curr-section next-section ht path) (let ((field-names (keys:config-get-fields confdat)) (target (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target")))) (keys:target-set-args keys target #f))))) (if toppath (change-directory toppath)) (if (and toppath pathenvvar)(setenv pathenvvar toppath)) (let ((configdat (if configfile (read-config configfile #f #t environ-patt: environ-patt (list (cons "^fields$" set-fields)) #f)))) (if toppath (change-directory curr-dir)) (list configdat toppath configfile fname)))) (define (config-lookup cfgdat section var) (if (hash-table? cfgdat) (let ((sectdat (hash-table-ref/default cfgdat section '()))) (if (null? sectdat) |
︙ | ︙ |
Modified megatest.scm from [246bdb6838] to [38d9e3f6ba].
︙ | ︙ | |||
314 315 316 317 318 319 320 321 322 323 324 325 326 327 | (if (and (not (null? remargs)) (not (or (args:get-arg "-runstep")) ;; add more args that use remargs here )) (debug:print 0 "ERROR: Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " "))) ;; The watchdog is to keep an eye on things like db sync etc. ;; (define *time-zero* (current-seconds)) (define *watchdog* (make-thread (lambda () | > > > > > | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 | (if (and (not (null? remargs)) (not (or (args:get-arg "-runstep")) ;; add more args that use remargs here )) (debug:print 0 "ERROR: Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " "))) ;; immediately set MT_TARGET if -reqtarg or -target are available ;; (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. ;; (define *time-zero* (current-seconds)) (define *watchdog* (make-thread (lambda () |
︙ | ︙ |