Artifact d7b27c058fc617312d416234b869572a35e0befe:
- File runconfig.scm — part of check-in [3469edbbf7] at 2011-10-08 20:23:24 on branch trunk — 90% converted to using units (user: matt size: 1696)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 61 64 ========.;; read 0050: 20 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 a config file, 0060: 6c 6f 61 64 69 6e 67 20 6f 6e 6c 79 20 74 68 65 loading only the 0070: 20 73 65 63 74 69 6f 6e 20 70 65 72 74 69 6e 65 section pertine 0080: 6e 74 0a 3b 3b 20 74 6f 20 74 68 69 73 20 72 75 nt.;; to this ru 0090: 6e 20 66 69 65 6c 64 31 76 61 6c 2f 66 69 65 6c n field1val/fiel 00a0: 64 32 76 61 6c 2f 66 69 65 6c 64 33 76 61 6c 20 d2val/field3val 00b0: 2e 2e 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ....;;========== 00c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 ============..(u 0100: 73 65 20 66 6f 72 6d 61 74 29 0a 0a 28 64 65 63 se format)..(dec 0110: 6c 61 72 65 20 28 75 6e 69 74 20 72 75 6e 63 6f lare (unit runco 0120: 6e 66 69 67 29 29 0a 28 64 65 63 6c 61 72 65 20 nfig)).(declare 0130: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 0a (uses common)).. 0140: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common 0150: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm").. 0160: 28 64 65 66 69 6e 65 20 28 73 65 74 75 70 2d 65 (define (setup-e 0170: 6e 76 2d 64 65 66 61 75 6c 74 73 20 64 62 20 66 nv-defaults db f 0180: 6e 61 6d 65 20 72 75 6e 2d 69 64 20 2e 20 61 6c name run-id . al 0190: 72 65 61 64 79 2d 73 65 65 6e 29 0a 20 20 28 6c ready-seen). (l 01a0: 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 28 67 et* ((keys (g 01b0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 et-keys db)).. ( 01c0: 6b 65 79 76 61 6c 73 20 28 67 65 74 2d 6b 65 79 keyvals (get-key 01d0: 2d 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 -vals db run-id) 01e0: 29 0a 09 20 28 74 68 65 6b 65 79 20 20 28 73 74 ).. (thekey (st 01f0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse 0200: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 (map (lambda (x 0210: 29 28 69 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 )(if x x "-na-") 0220: 29 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 ) keyvals) "/")) 0230: 0a 09 20 28 63 6f 6e 66 64 61 74 20 28 72 65 61 .. (confdat (rea 0240: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 d-config fname # 0250: 66 20 23 66 29 29 0a 09 20 28 77 68 61 74 66 6f f #f)).. (whatfo 0260: 75 6e 64 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 und (make-hash-t 0270: 61 62 6c 65 29 29 0a 09 20 28 73 65 63 74 69 6f able)).. (sectio 0280: 6e 73 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c ns (list "defaul 0290: 74 22 20 74 68 65 6b 65 79 29 29 29 0a 20 20 20 t" thekey))). 02a0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4 02b0: 22 55 73 69 6e 67 20 6b 65 79 3d 5c 22 22 20 74 "Using key=\"" t 02c0: 68 65 6b 65 79 20 22 5c 22 22 29 0a 20 20 20 20 hekey "\""). 02d0: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each . 02e0: 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e (lambda (section 02f0: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ). (let (( 0300: 73 65 63 74 69 6f 6e 2d 64 61 74 20 28 68 61 73 section-dat (has 0310: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 0320: 75 6c 74 20 63 6f 6e 66 64 61 74 20 73 65 63 74 ult confdat sect 0330: 69 6f 6e 20 23 66 29 29 29 0a 09 20 28 69 66 20 ion #f))).. (if 0340: 73 65 63 74 69 6f 6e 2d 64 61 74 0a 09 20 20 20 section-dat.. 0350: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 (for-each .. 0360: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 65 6e 76 (lambda (env 0370: 76 61 72 29 0a 09 09 28 68 61 73 68 2d 74 61 62 var)...(hash-tab 0380: 6c 65 2d 73 65 74 21 20 77 68 61 74 66 6f 75 6e le-set! whatfoun 0390: 64 20 73 65 63 74 69 6f 6e 20 28 2b 20 28 68 61 d section (+ (ha 03a0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 03b0: 61 75 6c 74 20 77 68 61 74 66 6f 75 6e 64 20 73 ault whatfound s 03c0: 65 63 74 69 6f 6e 20 30 29 20 31 29 29 0a 09 09 ection 0) 1))... 03d0: 28 73 65 74 65 6e 76 20 65 6e 76 76 61 72 20 28 (setenv envvar ( 03e0: 63 61 64 72 20 28 61 73 73 6f 63 20 65 6e 76 76 cadr (assoc envv 03f0: 61 72 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 ar section-dat)) 0400: 29 29 0a 09 20 20 20 20 20 20 28 6d 61 70 20 63 )).. (map c 0410: 61 72 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 ar section-dat)) 0420: 29 29 29 0a 20 20 20 20 20 73 65 63 74 69 6f 6e ))). section 0430: 73 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 s). (if (and 0440: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 61 6c 72 65 (not (null? alre 0450: 61 64 79 2d 73 65 65 6e 29 29 0a 09 20 20 20 20 ady-seen)).. 0460: 20 28 6e 6f 74 20 28 63 61 72 20 61 6c 72 65 61 (not (car alrea 0470: 64 79 2d 73 65 65 6e 29 29 29 0a 09 28 62 65 67 dy-seen)))..(beg 0480: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri 0490: 6e 74 20 32 20 22 4b 65 79 20 73 65 74 74 69 6e nt 2 "Key settin 04a0: 67 73 20 66 6f 75 6e 64 20 69 6e 20 72 75 6e 63 gs found in runc 04b0: 6f 6e 66 69 67 2e 63 6f 6e 66 69 67 3a 22 29 0a onfig.config:"). 04c0: 09 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 . (for-each (la 04d0: 6d 62 64 61 20 28 66 75 6c 6c 6b 65 79 29 0a 09 mbda (fullkey).. 04e0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr 04f0: 69 6e 74 20 32 20 28 66 6f 72 6d 61 74 20 23 66 int 2 (format #f 0500: 20 22 7e 32 30 61 20 7e 61 5c 6e 22 20 66 75 6c "~20a ~a\n" ful 0510: 6c 6b 65 79 20 28 68 61 73 68 2d 74 61 62 6c 65 lkey (hash-table 0520: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 77 68 61 -ref/default wha 0530: 74 66 6f 75 6e 64 20 66 75 6c 6c 6b 65 79 20 30 tfound fullkey 0 0540: 29 29 29 29 0a 09 09 20 20 20 20 73 65 63 74 69 ))))... secti 0550: 6f 6e 73 29 0a 09 20 20 28 64 65 62 75 67 3a 70 ons).. (debug:p 0560: 72 69 6e 74 20 32 20 22 2d 2d 2d 22 29 0a 09 20 rint 2 "---").. 0570: 20 28 73 65 74 21 20 2a 61 6c 72 65 61 64 79 2d (set! *already- 0580: 73 65 65 6e 2d 72 75 6e 63 6f 6e 66 69 67 2d 69 seen-runconfig-i 0590: 6e 66 6f 2a 20 23 74 29 29 29 29 29 0a 0a 28 64 nfo* #t)))))..(d 05a0: 65 66 69 6e 65 20 28 73 65 74 2d 72 75 6e 2d 63 efine (set-run-c 05b0: 6f 6e 66 69 67 2d 76 61 72 73 20 64 62 20 72 75 onfig-vars db ru 05c0: 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72 n-id). (let ((r 05d0: 75 6e 63 6f 6e 66 69 67 66 20 28 63 6f 6e 63 20 unconfigf (conc 05e0: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e *toppath* "/run 05f0: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 configs.config") 0600: 29 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c 65 )). (if (file 0610: 2d 65 78 69 73 74 73 3f 20 72 75 6e 63 6f 6e 66 -exists? runconf 0620: 69 67 66 29 0a 09 28 73 65 74 75 70 2d 65 6e 76 igf)..(setup-env 0630: 2d 64 65 66 61 75 6c 74 73 20 64 62 20 72 75 6e -defaults db run 0640: 63 6f 6e 66 69 67 66 20 72 75 6e 2d 69 64 29 0a configf run-id). 0650: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0 0660: 22 57 41 52 4e 49 4e 47 3a 20 59 6f 75 20 64 6f "WARNING: You do 0670: 20 6e 6f 74 20 68 61 76 65 20 61 20 72 75 6e 20 not have a run 0680: 63 6f 6e 66 69 67 20 66 69 6c 65 3a 20 22 20 72 config file: " r 0690: 75 6e 63 6f 6e 66 69 67 66 29 29 29 29 0a 20 20 unconfigf)))).