Megatest

Hex Artifact Content
Login

Artifact c41d686cb1a59650689b18e48de1fec04d711c49:


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: 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 70  ..(define (setup
0170: 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 20 64 62  -env-defaults db
0180: 20 66 6e 61 6d 65 20 72 75 6e 2d 69 64 20 61 6c   fname run-id al
0190: 72 65 61 64 79 2d 73 65 65 6e 20 23 21 6b 65 79  ready-seen #!key
01a0: 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23   (environ-patt #
01b0: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65  f)).  (let* ((ke
01c0: 79 73 20 20 20 20 28 72 64 62 3a 67 65 74 2d 6b  ys    (rdb:get-k
01d0: 65 79 73 20 64 62 29 29 0a 09 20 28 6b 65 79 76  eys db)).. (keyv
01e0: 61 6c 73 20 28 72 64 62 3a 67 65 74 2d 6b 65 79  als (rdb:get-key
01f0: 2d 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29  -vals db run-id)
0200: 29 0a 09 20 28 74 68 65 6b 65 79 20 20 28 73 74  ).. (thekey  (st
0210: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65  ring-intersperse
0220: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78   (map (lambda (x
0230: 29 28 69 66 20 78 20 78 20 22 2d 6e 61 2d 22 29  )(if x x "-na-")
0240: 29 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29  ) keyvals) "/"))
0250: 0a 09 20 3b 3b 20 57 68 79 20 77 61 73 20 73 79  .. ;; Why was sy
0260: 73 74 65 6d 20 64 69 73 61 6c 6c 6f 77 65 64 20  stem disallowed 
0270: 69 6e 20 74 68 65 20 72 65 61 64 69 6e 67 20 6f  in the reading o
0280: 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73  f the runconfigs
0290: 20 66 69 6c 65 3f 0a 09 20 3b 3b 20 4e 4f 54 45   file?.. ;; NOTE
02a0: 3a 20 53 68 6f 75 6c 64 20 62 65 20 73 65 74 74  : Should be sett
02b0: 69 6e 67 20 65 6e 76 20 76 61 72 73 20 62 61 73  ing env vars bas
02c0: 65 64 20 6f 6e 20 28 74 61 72 67 65 74 7c 64 65  ed on (target|de
02d0: 66 61 75 6c 74 29 0a 09 20 28 63 6f 6e 66 64 61  fault).. (confda
02e0: 74 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 66  t (read-config f
02f0: 6e 61 6d 65 20 23 66 20 23 74 20 65 6e 76 69 72  name #f #t envir
0300: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e  on-patt: environ
0310: 2d 70 61 74 74 20 73 65 63 74 69 6f 6e 73 3a 20  -patt sections: 
0320: 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20  (list "default" 
0330: 74 68 65 6b 65 79 29 29 29 0a 09 20 28 77 68 61  thekey))).. (wha
0340: 74 66 6f 75 6e 64 20 28 6d 61 6b 65 2d 68 61 73  tfound (make-has
0350: 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 73 65 63  h-table)).. (sec
0360: 74 69 6f 6e 73 20 28 6c 69 73 74 20 22 64 65 66  tions (list "def
0370: 61 75 6c 74 22 20 74 68 65 6b 65 79 29 29 29 0a  ault" thekey))).
0380: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 2a 74 61      (if (not *ta
0390: 72 67 65 74 2a 29 28 73 65 74 21 20 2a 74 61 72  rget*)(set! *tar
03a0: 67 65 74 2a 20 74 68 65 6b 65 79 29 29 20 3b 3b  get* thekey)) ;;
03b0: 20 6d 61 79 20 73 61 76 65 20 61 20 64 62 20 61   may save a db a
03c0: 63 63 65 73 73 20 6f 72 20 74 77 6f 20 62 75 74  ccess or two but
03d0: 20 72 65 70 65 61 74 73 20 64 62 3a 67 65 74 2d   repeats db:get-
03e0: 74 61 72 67 65 74 20 63 6f 64 65 0a 20 20 20 20  target code.    
03f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22  (debug:print 4 "
0400: 55 73 69 6e 67 20 6b 65 79 3d 5c 22 22 20 74 68  Using key=\"" th
0410: 65 6b 65 79 20 22 5c 22 22 29 0a 0a 20 20 20 20  ekey "\"")..    
0420: 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28  (for-each.     (
0430: 6c 61 6d 62 64 61 20 28 6b 65 79 20 76 61 6c 29  lambda (key val)
0440: 0a 20 20 20 20 20 20 20 28 73 65 74 65 6e 76 20  .       (setenv 
0450: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 20  (vector-ref key 
0460: 30 29 20 76 61 6c 29 29 0a 20 20 20 20 20 6b 65  0) val)).     ke
0470: 79 73 20 6b 65 79 76 61 6c 73 29 0a 0a 20 20 20  ys keyvals)..   
0480: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20   (for-each .    
0490: 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f   (lambda (sectio
04a0: 6e 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28  n).       (let (
04b0: 28 73 65 63 74 69 6f 6e 2d 64 61 74 20 28 68 61  (section-dat (ha
04c0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66  sh-table-ref/def
04d0: 61 75 6c 74 20 63 6f 6e 66 64 61 74 20 73 65 63  ault confdat sec
04e0: 74 69 6f 6e 20 23 66 29 29 29 0a 09 20 28 69 66  tion #f))).. (if
04f0: 20 73 65 63 74 69 6f 6e 2d 64 61 74 0a 09 20 20   section-dat..  
0500: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20     (for-each .. 
0510: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 65 6e       (lambda (en
0520: 76 76 61 72 29 0a 09 09 28 68 61 73 68 2d 74 61  vvar)...(hash-ta
0530: 62 6c 65 2d 73 65 74 21 20 77 68 61 74 66 6f 75  ble-set! whatfou
0540: 6e 64 20 73 65 63 74 69 6f 6e 20 28 2b 20 28 68  nd section (+ (h
0550: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65  ash-table-ref/de
0560: 66 61 75 6c 74 20 77 68 61 74 66 6f 75 6e 64 20  fault whatfound 
0570: 73 65 63 74 69 6f 6e 20 30 29 20 31 29 29 0a 09  section 0) 1))..
0580: 09 28 73 65 74 65 6e 76 20 65 6e 76 76 61 72 20  .(setenv envvar 
0590: 28 63 61 64 72 20 28 61 73 73 6f 63 20 65 6e 76  (cadr (assoc env
05a0: 76 61 72 20 73 65 63 74 69 6f 6e 2d 64 61 74 29  var section-dat)
05b0: 29 29 29 0a 09 20 20 20 20 20 20 28 6d 61 70 20  )))..      (map 
05c0: 63 61 72 20 73 65 63 74 69 6f 6e 2d 64 61 74 29  car section-dat)
05d0: 29 29 29 29 0a 20 20 20 20 20 73 65 63 74 69 6f  )))).     sectio
05e0: 6e 73 29 0a 20 20 20 20 28 69 66 20 61 6c 72 65  ns).    (if alre
05f0: 61 64 79 2d 73 65 65 6e 0a 09 28 62 65 67 69 6e  ady-seen..(begin
0600: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74  ..  (debug:print
0610: 20 32 20 22 4b 65 79 20 73 65 74 74 69 6e 67 73   2 "Key settings
0620: 20 66 6f 75 6e 64 20 69 6e 20 72 75 6e 63 6f 6e   found in runcon
0630: 66 69 67 2e 63 6f 6e 66 69 67 3a 22 29 0a 09 20  fig.config:").. 
0640: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62   (for-each (lamb
0650: 64 61 20 28 66 75 6c 6c 6b 65 79 29 0a 09 09 20  da (fullkey)... 
0660: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e       (debug:prin
0670: 74 20 32 20 28 66 6f 72 6d 61 74 20 23 66 20 22  t 2 (format #f "
0680: 7e 32 30 61 20 7e 61 5c 6e 22 20 66 75 6c 6c 6b  ~20a ~a\n" fullk
0690: 65 79 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72  ey (hash-table-r
06a0: 65 66 2f 64 65 66 61 75 6c 74 20 77 68 61 74 66  ef/default whatf
06b0: 6f 75 6e 64 20 66 75 6c 6c 6b 65 79 20 30 29 29  ound fullkey 0))
06c0: 29 29 0a 09 09 20 20 20 20 73 65 63 74 69 6f 6e  ))...    section
06d0: 73 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69  s)..  (debug:pri
06e0: 6e 74 20 32 20 22 2d 2d 2d 22 29 0a 09 20 20 28  nt 2 "---")..  (
06f0: 73 65 74 21 20 2a 61 6c 72 65 61 64 79 2d 73 65  set! *already-se
0700: 65 6e 2d 72 75 6e 63 6f 6e 66 69 67 2d 69 6e 66  en-runconfig-inf
0710: 6f 2a 20 23 74 29 29 29 29 29 0a 0a 28 64 65 66  o* #t)))))..(def
0720: 69 6e 65 20 28 73 65 74 2d 72 75 6e 2d 63 6f 6e  ine (set-run-con
0730: 66 69 67 2d 76 61 72 73 20 64 62 20 72 75 6e 2d  fig-vars db run-
0740: 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e  id).  (let ((run
0750: 63 6f 6e 66 69 67 66 20 28 63 6f 6e 63 20 20 2a  configf (conc  *
0760: 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f  toppath* "/runco
0770: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 29 0a  nfigs.config")).
0780: 09 28 74 61 72 67 20 20 20 20 20 20 20 28 6f 72  .(targ       (or
0790: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22   (args:get-arg "
07a0: 2d 74 61 72 67 65 74 22 29 0a 09 09 09 28 61 72  -target")....(ar
07b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71  gs:get-arg "-req
07c0: 74 61 72 67 22 29 0a 09 09 09 28 64 62 3a 67 65  targ")....(db:ge
07d0: 74 2d 74 61 72 67 65 74 20 64 62 20 72 75 6e 2d  t-target db run-
07e0: 69 64 29 29 29 29 0a 20 20 20 20 28 69 66 20 28  id)))).    (if (
07f0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 75 6e  file-exists? run
0800: 63 6f 6e 66 69 67 66 29 0a 09 28 73 65 74 75 70  configf)..(setup
0810: 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 20 64 62  -env-defaults db
0820: 20 72 75 6e 63 6f 6e 66 69 67 66 20 72 75 6e 2d   runconfigf run-
0830: 69 64 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61  id #t environ-pa
0840: 74 74 3a 20 28 63 6f 6e 63 20 22 28 64 65 66 61  tt: (conc "(defa
0850: 75 6c 74 22 0a 09 09 09 09 09 09 09 09 09 28 69  ult"..........(i
0860: 66 20 74 61 72 67 0a 09 09 09 09 09 09 09 09 09  f targ..........
0870: 20 20 20 20 28 63 6f 6e 63 20 22 7c 22 20 74 61      (conc "|" ta
0880: 72 67 20 22 29 22 29 0a 09 09 09 09 09 09 09 09  rg ")").........
0890: 09 20 20 20 20 22 29 22 29 29 29 0a 09 28 64 65  .    ")")))..(de
08a0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52  bug:print 0 "WAR
08b0: 4e 49 4e 47 3a 20 59 6f 75 20 64 6f 20 6e 6f 74  NING: You do not
08c0: 20 68 61 76 65 20 61 20 72 75 6e 20 63 6f 6e 66   have a run conf
08d0: 69 67 20 66 69 6c 65 3a 20 22 20 72 75 6e 63 6f  ig file: " runco
08e0: 6e 66 69 67 66 29 29 29 29 0a 20                 nfigf)))).