Artifact 6f5e8ec90111f967d5a01a511a3493be2edb7969:
- File runconfig.scm — part of check-in [de3a20e5ec] at 2013-05-01 12:04:49 on branch refactor — Refactored more open-run-close calls (user: mrwellan size: 2937) [more...]
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 20 64 69 72 65 63 74 se format direct 0110: 6f 72 79 2d 75 74 69 6c 73 29 0a 0a 28 64 65 63 ory-utils)..(dec 0120: 6c 61 72 65 20 28 75 6e 69 74 20 72 75 6e 63 6f lare (unit runco 0130: 6e 66 69 67 29 29 0a 28 64 65 63 6c 61 72 65 20 nfig)).(declare 0140: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 0a (uses common)).. 0150: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common 0160: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm").. 0170: 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 73 65 ..;; (define (se 0180: 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 tup-env-defaults 0190: 20 64 62 20 66 6e 61 6d 65 20 72 75 6e 2d 69 64 db fname run-id 01a0: 20 61 6c 72 65 61 64 79 2d 73 65 65 6e 20 23 21 already-seen #! 01b0: 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 key (environ-pat 01c0: 74 20 23 66 29 28 63 68 61 6e 67 65 2d 65 6e 76 t #f)(change-env 01d0: 20 23 74 29 29 0a 28 64 65 66 69 6e 65 20 28 73 #t)).(define (s 01e0: 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 etup-env-default 01f0: 73 20 66 6e 61 6d 65 20 72 75 6e 2d 69 64 20 61 s fname run-id a 0200: 6c 72 65 61 64 79 2d 73 65 65 6e 20 6b 65 79 73 lready-seen keys 0210: 20 6b 65 79 76 61 6c 73 20 23 21 6b 65 79 20 28 keyvals #!key ( 0220: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 environ-patt #f) 0230: 28 63 68 61 6e 67 65 2d 65 6e 76 20 23 74 29 29 (change-env #t)) 0240: 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 28 6b 65 . (let* (;; (ke 0250: 79 73 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 ys (db:get-ke 0260: 79 73 20 64 62 29 29 0a 09 20 3b 3b 20 28 6b 65 ys db)).. ;; (ke 0270: 79 76 61 6c 73 20 28 69 66 20 72 75 6e 2d 69 64 yvals (if run-id 0280: 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c (db:get-key-val 0290: 73 20 64 62 20 72 75 6e 2d 69 64 29 20 23 66 29 s db run-id) #f) 02a0: 29 0a 09 20 28 74 68 65 6b 65 79 20 20 28 69 66 ).. (thekey (if 02b0: 20 6b 65 79 76 61 6c 73 20 28 73 74 72 69 6e 67 keyvals (string 02c0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma 02d0: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69 66 p (lambda (x)(if 02e0: 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b 65 x x "-na-")) ke 02f0: 79 76 61 6c 73 29 20 22 2f 22 29 0a 09 09 20 20 yvals) "/")... 0300: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge 0310: 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 t-arg "-reqtarg" 0320: 29 20 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 ) .... (args:ge 0330: 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 t-arg "-reqtarg" 0340: 29 0a 09 09 09 20 20 28 69 66 20 28 61 72 67 73 ).... (if (args 0350: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe 0360: 74 22 29 0a 09 09 09 20 20 20 20 20 20 28 61 72 t").... (ar 0370: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar 0380: 67 65 74 22 29 0a 09 09 09 20 20 20 20 20 20 28 get").... ( 0390: 62 65 67 69 6e 0a 09 09 09 09 28 64 65 62 75 67 begin.....(debug 03a0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR: 03b0: 20 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 setup-env-defau 03c0: 6c 74 73 20 63 61 6c 6c 65 64 20 77 69 74 68 20 lts called with 03d0: 6e 6f 20 72 75 6e 2d 69 64 20 6f 72 20 2d 74 61 no run-id or -ta 03e0: 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 rget or -reqtarg 03f0: 22 29 0a 09 09 09 09 22 6e 6f 74 68 69 6e 67 20 ")....."nothing 0400: 6d 61 74 63 68 65 73 20 74 68 69 73 20 49 20 68 matches this I h 0410: 6f 70 65 22 29 29 29 29 29 0a 09 20 3b 3b 20 57 ope"))))).. ;; W 0420: 68 79 20 77 61 73 20 73 79 73 74 65 6d 20 64 69 hy was system di 0430: 73 61 6c 6c 6f 77 65 64 20 69 6e 20 74 68 65 20 sallowed in the 0440: 72 65 61 64 69 6e 67 20 6f 66 20 74 68 65 20 72 reading of the r 0450: 75 6e 63 6f 6e 66 69 67 73 20 66 69 6c 65 3f 0a unconfigs file?. 0460: 09 20 3b 3b 20 4e 4f 54 45 3a 20 53 68 6f 75 6c . ;; NOTE: Shoul 0470: 64 20 62 65 20 73 65 74 74 69 6e 67 20 65 6e 76 d be setting env 0480: 20 76 61 72 73 20 62 61 73 65 64 20 6f 6e 20 28 vars based on ( 0490: 74 61 72 67 65 74 7c 64 65 66 61 75 6c 74 29 0a target|default). 04a0: 09 20 28 63 6f 6e 66 64 61 74 20 28 72 65 61 64 . (confdat (read 04b0: 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 66 -config fname #f 04c0: 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 #t environ-patt 04d0: 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 73 : environ-patt s 04e0: 65 63 74 69 6f 6e 73 3a 20 28 6c 69 73 74 20 22 ections: (list " 04f0: 64 65 66 61 75 6c 74 22 20 74 68 65 6b 65 79 29 default" thekey) 0500: 29 29 0a 09 20 28 77 68 61 74 66 6f 75 6e 64 20 )).. (whatfound 0510: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 0520: 29 29 0a 09 20 28 66 69 6e 61 6c 64 61 74 20 20 )).. (finaldat 0530: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 0540: 29 29 0a 09 20 28 73 65 63 74 69 6f 6e 73 20 28 )).. (sections ( 0550: 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 list "default" t 0560: 68 65 6b 65 79 29 29 29 0a 20 20 20 20 28 69 66 hekey))). (if 0570: 20 28 6e 6f 74 20 2a 74 61 72 67 65 74 2a 29 28 (not *target*)( 0580: 73 65 74 21 20 2a 74 61 72 67 65 74 2a 20 74 68 set! *target* th 0590: 65 6b 65 79 29 29 20 3b 3b 20 6d 61 79 20 73 61 ekey)) ;; may sa 05a0: 76 65 20 61 20 64 62 20 61 63 63 65 73 73 20 6f ve a db access o 05b0: 72 20 74 77 6f 20 62 75 74 20 72 65 70 65 61 74 r two but repeat 05c0: 73 20 64 62 3a 67 65 74 2d 74 61 72 67 65 74 20 s db:get-target 05d0: 63 6f 64 65 0a 20 20 20 20 28 64 65 62 75 67 3a code. (debug: 05e0: 70 72 69 6e 74 20 34 20 22 55 73 69 6e 67 20 6b print 4 "Using k 05f0: 65 79 3d 5c 22 22 20 74 68 65 6b 65 79 20 22 5c ey=\"" thekey "\ 0600: 22 22 29 0a 0a 20 20 20 20 28 69 66 20 63 68 61 "").. (if cha 0610: 6e 67 65 2d 65 6e 76 0a 09 28 66 6f 72 2d 65 61 nge-env..(for-ea 0620: 63 68 0a 09 20 28 6c 61 6d 62 64 61 20 28 6b 65 ch.. (lambda (ke 0630: 79 20 76 61 6c 29 0a 09 20 20 20 28 73 65 74 65 y val).. (sete 0640: 6e 76 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b nv (vector-ref k 0650: 65 79 20 30 29 20 76 61 6c 29 29 0a 09 20 6b 65 ey 0) val)).. ke 0660: 79 73 20 6b 65 79 76 61 6c 73 29 29 0a 09 0a 20 ys keyvals))... 0670: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 (for-each . 0680: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect 0690: 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 6c 65 74 ion). (let 06a0: 20 28 28 73 65 63 74 69 6f 6e 2d 64 61 74 20 28 ((section-dat ( 06b0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d 06c0: 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 20 73 efault confdat s 06d0: 65 63 74 69 6f 6e 20 23 66 29 29 29 0a 09 20 28 ection #f))).. ( 06e0: 69 66 20 73 65 63 74 69 6f 6e 2d 64 61 74 0a 09 if section-dat.. 06f0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each . 0700: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda ( 0710: 65 6e 76 76 61 72 29 0a 09 09 28 6c 65 74 20 28 envvar)...(let ( 0720: 28 76 61 6c 20 28 63 61 64 72 20 28 61 73 73 6f (val (cadr (asso 0730: 63 20 65 6e 76 76 61 72 20 73 65 63 74 69 6f 6e c envvar section 0740: 2d 64 61 74 29 29 29 29 0a 09 09 28 68 61 73 68 -dat))))...(hash 0750: 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 68 61 74 -table-set! what 0760: 66 6f 75 6e 64 20 73 65 63 74 69 6f 6e 20 28 2b found section (+ 0770: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 0780: 2f 64 65 66 61 75 6c 74 20 77 68 61 74 66 6f 75 /default whatfou 0790: 6e 64 20 73 65 63 74 69 6f 6e 20 30 29 20 31 29 nd section 0) 1) 07a0: 29 0a 09 09 28 69 66 20 63 68 61 6e 67 65 2d 65 )...(if change-e 07b0: 6e 76 20 28 73 65 74 65 6e 76 20 65 6e 76 76 61 nv (setenv envva 07c0: 72 20 76 61 6c 29 29 0a 09 09 28 68 61 73 68 2d r val))...(hash- 07d0: 74 61 62 6c 65 2d 73 65 74 21 20 66 69 6e 61 6c table-set! final 07e0: 64 61 74 20 65 6e 76 76 61 72 20 76 61 6c 29 29 dat envvar val)) 07f0: 29 0a 09 20 20 20 20 20 20 28 6d 61 70 20 63 61 ).. (map ca 0800: 72 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 29 r section-dat))) 0810: 29 29 0a 20 20 20 20 20 73 65 63 74 69 6f 6e 73 )). sections 0820: 29 0a 20 20 20 20 28 69 66 20 61 6c 72 65 61 64 ). (if alread 0830: 79 2d 73 65 65 6e 0a 09 28 62 65 67 69 6e 0a 09 y-seen..(begin.. 0840: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2 0850: 20 22 4b 65 79 20 73 65 74 74 69 6e 67 73 20 66 "Key settings f 0860: 6f 75 6e 64 20 69 6e 20 72 75 6e 63 6f 6e 66 69 ound in runconfi 0870: 67 2e 63 6f 6e 66 69 67 3a 22 29 0a 09 20 20 28 g.config:").. ( 0880: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda 0890: 20 28 66 75 6c 6c 6b 65 79 29 0a 09 09 20 20 20 (fullkey)... 08a0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print 08b0: 32 20 28 66 6f 72 6d 61 74 20 23 66 20 22 7e 32 2 (format #f "~2 08c0: 30 61 20 7e 61 5c 6e 22 20 66 75 6c 6c 6b 65 79 0a ~a\n" fullkey 08d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 08e0: 2f 64 65 66 61 75 6c 74 20 77 68 61 74 66 6f 75 /default whatfou 08f0: 6e 64 20 66 75 6c 6c 6b 65 79 20 30 29 29 29 29 nd fullkey 0)))) 0900: 0a 09 09 20 20 20 20 73 65 63 74 69 6f 6e 73 29 ... sections) 0910: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print 0920: 20 32 20 22 2d 2d 2d 22 29 0a 09 20 20 28 73 65 2 "---").. (se 0930: 74 21 20 2a 61 6c 72 65 61 64 79 2d 73 65 65 6e t! *already-seen 0940: 2d 72 75 6e 63 6f 6e 66 69 67 2d 69 6e 66 6f 2a -runconfig-info* 0950: 20 23 74 29 29 29 0a 20 20 20 20 66 69 6e 61 6c #t))). final 0960: 64 61 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 dat))..(define ( 0970: 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 set-run-config-v 0980: 61 72 73 20 72 75 6e 2d 69 64 20 6b 65 79 73 20 ars run-id keys 0990: 6b 65 79 76 61 6c 73 20 74 61 72 67 2d 66 72 6f keyvals targ-fro 09a0: 6d 2d 64 62 29 0a 20 20 28 70 75 73 68 2d 64 69 m-db). (push-di 09b0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath 09c0: 2a 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 63 *). (let ((runc 09d0: 6f 6e 66 69 67 66 20 28 63 6f 6e 63 20 20 2a 74 onfigf (conc *t 09e0: 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e oppath* "/runcon 09f0: 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 29 0a 09 figs.config")).. 0a00: 28 74 61 72 67 20 20 20 20 20 20 20 28 6f 72 20 (targ (or 0a10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "- 0a20: 74 61 72 67 65 74 22 29 0a 09 09 09 28 61 72 67 target")....(arg 0a30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 74 s:get-arg "-reqt 0a40: 61 72 67 22 29 0a 09 09 09 74 61 72 67 2d 66 72 arg")....targ-fr 0a50: 6f 6d 2d 64 62 29 29 29 0a 20 20 20 20 28 70 6f om-db))). (po 0a60: 70 2d 64 69 72 65 63 74 6f 72 79 29 0a 20 20 20 p-directory). 0a70: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist 0a80: 73 3f 20 72 75 6e 63 6f 6e 66 69 67 66 29 0a 09 s? runconfigf).. 0a90: 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 (setup-env-defau 0aa0: 6c 74 73 20 72 75 6e 63 6f 6e 66 69 67 66 20 72 lts runconfigf r 0ab0: 75 6e 2d 69 64 20 23 74 20 6b 65 79 73 20 6b 65 un-id #t keys ke 0ac0: 79 76 61 6c 73 0a 09 09 09 20 20 20 20 65 6e 76 yvals.... env 0ad0: 69 72 6f 6e 2d 70 61 74 74 3a 20 28 63 6f 6e 63 iron-patt: (conc 0ae0: 20 22 28 64 65 66 61 75 6c 74 22 0a 09 09 09 09 "(default"..... 0af0: 09 09 28 69 66 20 74 61 72 67 0a 09 09 09 09 09 ..(if targ...... 0b00: 09 20 20 20 20 28 63 6f 6e 63 20 22 7c 22 20 74 . (conc "|" t 0b10: 61 72 67 20 22 29 22 29 0a 09 09 09 09 09 09 20 arg ")")....... 0b20: 20 20 20 22 29 22 29 29 29 0a 09 28 64 65 62 75 ")")))..(debu 0b30: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI 0b40: 4e 47 3a 20 59 6f 75 20 64 6f 20 6e 6f 74 20 68 NG: You do not h 0b50: 61 76 65 20 61 20 72 75 6e 20 63 6f 6e 66 69 67 ave a run config 0b60: 20 66 69 6c 65 3a 20 22 20 72 75 6e 63 6f 6e 66 file: " runconf 0b70: 69 67 66 29 29 29 29 0a 20 igf)))).