File
keys.scm
— part of check-in
[ae6dbecf17]
at
2011-05-01 23:05:22
on branch trunk
— Importing 1.0.1 version of megatest, (nb// work in progress, please wait for next release)
(user:
matt
size: 3967)
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 06-2011, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 20 0a 3b 3b 3d 3d PURPOSE.. .;;==
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 3d 0a 3b 3b 20 52 75 6e 20 6b 65 79 73 ====.;; Run keys
01a0: 2c 20 74 68 65 73 65 20 61 72 65 20 75 73 65 64 , these are used
01b0: 20 74 6f 20 68 69 65 72 61 72 63 68 69 61 6c 6c to hierarchiall
01c0: 79 20 6f 72 67 61 6e 69 73 65 20 74 65 73 74 73 y organise tests
01d0: 20 61 6e 64 20 72 75 6e 20 61 72 65 61 73 0a 3b and run areas.;
01e0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a 28 64 65 66 69 6e =======...(defin
0230: 65 2d 69 6e 6c 69 6e 65 20 28 6b 65 79 3a 67 65 e-inline (key:ge
0240: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 t-fieldname key)
0250: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 20 (vector-ref key
0260: 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 0)).(define-inli
0270: 6e 65 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c ne (key:get-fiel
0280: 64 74 79 70 65 20 6b 65 79 29 28 76 65 63 74 6f dtype key)(vecto
0290: 72 2d 72 65 66 20 6b 65 79 20 31 29 29 0a 0a 28 r-ref key 1))..(
02a0: 64 65 66 69 6e 65 20 28 67 65 74 2d 6b 65 79 73 define (get-keys
02b0: 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 6b 65 db). (let ((ke
02c0: 79 73 20 27 28 29 29 29 20 3b 3b 20 6b 65 79 73 ys '())) ;; keys
02d0: 20 61 72 65 20 76 65 63 74 6f 72 73 20 3c 66 69 are vectors <fi
02e0: 65 6c 64 6e 61 6d 65 2c 74 79 70 65 3e 0a 20 20 eldname,type>.
02f0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
0300: 61 63 68 2d 72 6f 77 20 28 6c 61 6d 62 64 61 20 ach-row (lambda
0310: 28 66 69 65 6c 64 6e 61 6d 65 20 66 69 65 6c 64 (fieldname field
0320: 74 79 70 65 29 0a 09 09 09 20 20 20 20 28 73 65 type).... (se
0330: 74 21 20 6b 65 79 73 20 28 63 6f 6e 73 20 28 76 t! keys (cons (v
0340: 65 63 74 6f 72 20 66 69 65 6c 64 6e 61 6d 65 20 ector fieldname
0350: 66 69 65 6c 64 74 79 70 65 29 20 6b 65 79 73 29 fieldtype) keys)
0360: 29 29 0a 09 09 09 20 20 64 62 0a 09 09 09 20 20 )).... db....
0370: 22 53 45 4c 45 43 54 20 66 69 65 6c 64 6e 61 6d "SELECT fieldnam
0380: 65 2c 66 69 65 6c 64 74 79 70 65 20 46 52 4f 4d e,fieldtype FROM
0390: 20 6b 65 79 73 20 4f 52 44 45 52 20 42 59 20 69 keys ORDER BY i
03a0: 64 20 41 53 43 3b 22 29 0a 20 20 20 20 28 72 65 d ASC;"). (re
03b0: 76 65 72 73 65 20 6b 65 79 73 29 29 29 20 3b 3b verse keys))) ;;
03c0: 20 63 6f 75 6c 64 20 6a 75 73 74 20 73 6f 72 74 could just sort
03d0: 20 64 65 73 63 3f 0a 0a 3b 3b 20 67 65 74 20 6b desc?..;; get k
03e0: 65 79 20 76 61 6c 73 20 66 6f 72 20 61 20 67 69 ey vals for a gi
03f0: 76 65 6e 20 72 75 6e 2d 69 64 0a 28 64 65 66 69 ven run-id.(defi
0400: 6e 65 20 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 ne (get-key-vals
0410: 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 6c db run-id). (l
0420: 65 74 2a 20 28 28 6b 65 79 73 20 28 67 65 74 2d et* ((keys (get-
0430: 6b 65 79 73 20 64 62 29 29 0a 09 20 28 72 65 73 keys db)).. (res
0440: 20 20 27 28 29 29 29 0a 20 20 20 20 3b 3b 20 28 '())). ;; (
0450: 70 72 69 6e 74 20 22 6b 65 79 73 3a 20 22 20 6b print "keys: " k
0460: 65 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 eys " run-id: "
0470: 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 66 6f 72 run-id). (for
0480: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
0490: 62 64 61 20 28 6b 65 79 29 0a 20 20 20 20 20 20 bda (key).
04a0: 20 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e (let ((qry (con
04b0: 63 20 22 53 45 4c 45 43 54 20 22 20 28 6b 65 79 c "SELECT " (key
04c0: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
04d0: 65 79 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 ey) " FROM runs
04e0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a WHERE id=?;"))).
04f0: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 71 72 79 . ;; (print "qry
0500: 3a 20 22 20 71 72 79 29 0a 09 20 28 73 71 6c 69 : " qry).. (sqli
0510: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
0520: 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 .. (lambda (ke
0530: 79 2d 76 61 6c 29 0a 09 20 20 20 20 28 73 65 74 y-val).. (set
0540: 21 20 72 65 73 20 28 63 6f 6e 73 20 6b 65 79 2d ! res (cons key-
0550: 76 61 6c 20 72 65 73 29 29 29 0a 09 20 20 64 62 val res))).. db
0560: 20 71 72 79 20 72 75 6e 2d 69 64 29 29 29 0a 20 qry run-id))).
0570: 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 72 keys). (r
0580: 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 0a 28 everse res)))..(
0590: 64 65 66 69 6e 65 20 28 6b 65 79 73 2d 3e 6b 65 define (keys->ke
05a0: 79 73 74 72 20 6b 65 79 73 29 20 3b 3b 20 3d 3e ystr keys) ;; =>
05b0: 20 6b 65 79 31 2c 6b 65 79 32 2c 6b 65 79 33 2c key1,key2,key3,
05c0: 61 64 64 69 74 69 6f 6e 61 31 2c 20 2e 2e 2e 0a additiona1, ....
05d0: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
05e0: 70 65 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 perse (map key:g
05f0: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 et-fieldname key
0600: 73 29 20 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e s) ","))..(defin
0610: 65 2d 69 6e 6c 69 6e 65 20 28 6b 65 79 73 2d 3e e-inline (keys->
0620: 76 61 6c 73 6c 6f 74 73 20 6b 65 79 73 29 20 3b valslots keys) ;
0630: 3b 20 3d 3e 20 3f 2c 3f 2c 3f 20 2e 2e 2e 2e 0a ; => ?,?,? .....
0640: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
0650: 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
0660: 64 61 20 28 78 29 20 22 3f 22 29 20 6b 65 79 73 da (x) "?") keys
0670: 29 20 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 ) ","))..(define
0680: 2d 69 6e 6c 69 6e 65 20 28 6b 65 79 73 2d 3e 6b -inline (keys->k
0690: 65 79 2f 66 69 65 6c 64 20 6b 65 79 73 20 2e 20 ey/field keys .
06a0: 61 64 64 69 74 69 6f 6e 61 6c 29 0a 20 20 28 73 additional). (s
06b0: 74 72 69 6e 67 2d 6a 6f 69 6e 20 28 6d 61 70 20 tring-join (map
06c0: 28 6c 61 6d 62 64 61 20 28 6b 29 28 63 6f 6e 63 (lambda (k)(conc
06d0: 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e (key:get-fieldn
06e0: 61 6d 65 20 6b 29 20 22 20 22 20 28 6b 65 79 3a ame k) " " (key:
06f0: 67 65 74 2d 66 69 65 6c 64 74 79 70 65 20 6b 29 get-fieldtype k)
0700: 29 29 28 61 70 70 65 6e 64 20 6b 65 79 73 20 61 ))(append keys a
0710: 64 64 69 74 69 6f 6e 61 6c 29 29 20 22 2c 22 29 dditional)) ",")
0720: 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 67 73 )..(define (args
0730: 3a 75 73 61 67 65 20 2e 20 61 29 20 23 66 29 0a :usage . a) #f).
0740: 0a 3b 3b 20 55 73 69 6e 67 20 74 68 65 20 6b 65 .;; Using the ke
0750: 79 73 20 70 75 6c 6c 65 64 20 66 72 6f 6d 20 74 ys pulled from t
0760: 68 65 20 64 61 74 61 62 61 73 65 20 28 69 6e 69 he database (ini
0770: 74 69 61 6c 6c 79 20 73 65 74 20 66 72 6f 6d 20 tially set from
0780: 74 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e the megatest.con
0790: 66 69 67 20 66 69 6c 65 29 0a 3b 3b 20 6c 6f 6f fig file).;; loo
07a0: 6b 20 66 6f 72 20 74 68 65 20 65 71 75 69 76 61 k for the equiva
07b0: 6c 65 6e 74 20 76 61 6c 75 65 20 6f 6e 20 74 68 lent value on th
07c0: 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 61 e command line a
07d0: 6e 64 20 61 64 64 20 69 74 20 74 6f 20 61 20 6c nd add it to a l
07e0: 69 73 74 2c 20 6f 72 20 23 66 20 69 66 20 6e 6f ist, or #f if no
07f0: 74 20 66 6f 75 6e 64 2e 0a 3b 3b 20 64 65 66 61 t found..;; defa
0800: 75 6c 74 20 3d 3e 20 28 76 61 6c 31 20 76 61 6c ult => (val1 val
0810: 32 20 76 61 6c 33 20 2e 2e 2e 29 0a 3b 3b 20 77 2 val3 ...).;; w
0820: 69 74 68 6b 65 79 20 3d 3e 20 28 3a 6b 65 79 31 ithkey => (:key1
0830: 20 76 61 6c 31 20 3a 6b 65 79 32 20 76 61 6c 32 val1 :key2 val2
0840: 20 3a 6b 65 79 33 20 76 61 6c 33 20 2e 2e 2e 29 :key3 val3 ...)
0850: 0a 28 64 65 66 69 6e 65 20 28 6b 65 79 73 2d 3e .(define (keys->
0860: 76 61 6c 6c 69 73 74 20 6b 65 79 73 20 2e 20 77 vallist keys . w
0870: 69 74 68 6b 65 79 29 20 3b 3b 20 4f 52 44 45 52 ithkey) ;; ORDER
0880: 49 4e 47 20 49 53 20 56 45 52 59 20 49 4d 50 4f ING IS VERY IMPO
0890: 52 54 41 4e 54 2c 20 4b 45 45 50 20 50 52 4f 50 RTANT, KEEP PROP
08a0: 45 52 20 4f 52 44 45 52 20 48 45 52 45 21 0a 20 ER ORDER HERE!.
08b0: 20 28 6c 65 74 2a 20 28 28 6b 65 79 6e 61 6d 65 (let* ((keyname
08c0: 73 20 20 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 s (map key:get
08d0: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
08e0: 29 0a 09 20 28 61 72 67 6b 65 79 73 20 20 20 20 ).. (argkeys
08f0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 29 (map (lambda (k)
0900: 28 63 6f 6e 63 20 22 3a 22 20 6b 29 29 20 6b 65 (conc ":" k)) ke
0910: 79 6e 61 6d 65 73 29 29 0a 09 20 28 77 69 74 68 ynames)).. (with
0920: 6b 65 79 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c key (not (nul
0930: 6c 3f 20 77 69 74 68 6b 65 79 29 29 29 0a 09 20 l? withkey)))..
0940: 28 6e 65 77 72 65 6d 61 72 67 73 20 28 61 72 67 (newremargs (arg
0950: 73 3a 67 65 74 2d 61 72 67 73 20 28 63 6f 6e 73 s:get-args (cons
0960: 20 22 62 6c 61 68 22 20 72 65 6d 61 72 67 73 29 "blah" remargs)
0970: 20 61 72 67 6b 65 79 73 20 27 28 29 20 61 72 67 argkeys '() arg
0980: 73 3a 61 72 67 2d 68 61 73 68 20 30 29 29 29 20 s:arg-hash 0)))
0990: 3b 3b 20 74 68 65 20 63 6f 6e 73 20 62 6c 61 68 ;; the cons blah
09a0: 20 77 6f 72 6b 73 20 61 72 6f 75 6e 64 20 61 20 works around a
09b0: 62 75 67 20 69 6e 20 61 72 67 73 20 5b 61 72 67 bug in args [arg
09c0: 73 20 61 73 73 75 6d 65 73 20 28 22 63 61 6c 6c s assumes ("call
09d0: 69 6e 67 2d 70 72 6f 67 2d 6e 61 6d 65 22 20 2e ing-prog-name" .
09e0: 2e 2e 2e 20 29 20 5d 0a 20 20 20 20 3b 3b 28 70 ... ) ]. ;;(p
09f0: 72 69 6e 74 20 22 72 65 6d 61 72 67 73 3a 20 22 rint "remargs: "
0a00: 20 72 65 6d 61 72 67 73 20 22 20 6e 65 77 72 65 remargs " newre
0a10: 6d 61 72 67 73 3a 20 22 20 6e 65 77 72 65 6d 61 margs: " newrema
0a20: 72 67 73 29 0a 20 20 20 20 28 61 70 70 6c 79 20 rgs). (apply
0a30: 61 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d append (map (lam
0a40: 62 64 61 20 28 78 29 0a 09 09 09 20 28 6c 65 74 bda (x).... (let
0a50: 20 28 28 76 61 6c 20 28 61 72 67 73 3a 67 65 74 ((val (args:get
0a60: 2d 61 72 67 20 78 29 29 29 0a 09 09 09 20 20 20 -arg x)))....
0a70: 3b 3b 20 28 70 72 69 6e 74 20 22 78 3a 20 22 20 ;; (print "x: "
0a80: 78 20 22 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a x " val: " val).
0a90: 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 76 ... (if (not v
0aa0: 61 6c 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b al).... ;;
0ab0: 20 28 70 72 69 6e 74 20 22 57 41 52 4e 49 4e 47 (print "WARNING
0ac0: 3a 20 6d 69 73 73 69 6e 67 20 6b 65 79 20 22 20 : missing key "
0ad0: 78 20 22 2e 20 53 70 65 63 69 66 69 65 64 20 69 x ". Specified i
0ae0: 6e 20 64 61 74 61 62 61 73 65 20 62 75 74 20 6e n database but n
0af0: 6f 74 20 6f 6e 20 63 6f 6d 6d 61 6e 64 20 6c 69 ot on command li
0b00: 6e 65 2c 20 75 73 69 6e 67 20 5c 22 75 6e 6b 5c ne, using \"unk\
0b10: 22 22 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 "").... (s
0b20: 65 74 21 20 76 61 6c 20 22 64 65 66 61 75 6c 74 et! val "default
0b30: 22 29 29 0a 09 09 09 20 20 20 28 69 66 20 77 69 ")).... (if wi
0b40: 74 68 6b 65 79 20 28 6c 69 73 74 20 78 20 76 61 thkey (list x va
0b50: 6c 29 20 28 6c 69 73 74 20 76 61 6c 29 29 29 29 l) (list val))))
0b60: 0a 09 09 20 20 20 20 20 20 20 61 72 67 6b 65 79 ... argkey
0b70: 73 29 29 29 29 0a 20 20 0a 3b 3b 20 28 64 65 66 s)))). .;; (def
0b80: 69 6e 65 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 ine (keys->alist
0b90: 20 6b 65 79 73 29 0a 3b 3b 20 20 20 28 6c 65 74 keys).;; (let
0ba0: 2a 20 28 28 6b 65 79 6e 61 6d 65 73 20 20 20 28 * ((keynames (
0bb0: 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c map key:get-fiel
0bc0: 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a 3b 3b 20 dname keys)).;;
0bd0: 09 20 28 61 72 67 6b 65 79 73 20 20 20 20 28 6d . (argkeys (m
0be0: 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 29 28 63 ap (lambda (k)(c
0bf0: 6f 6e 63 20 22 3a 22 20 6b 29 29 20 6b 65 79 6e onc ":" k)) keyn
0c00: 61 6d 65 73 29 29 0a 3b 3b 20 09 20 28 77 69 74 ames)).;; . (wit
0c10: 68 6b 65 79 20 20 20 20 28 6e 6f 74 20 28 6e 75 hkey (not (nu
0c20: 6c 6c 3f 20 77 69 74 68 6b 65 79 29 29 29 0a 3b ll? withkey))).;
0c30: 3b 20 09 20 28 6e 65 77 72 65 6d 61 72 67 73 20 ; . (newremargs
0c40: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 28 (args:get-args (
0c50: 63 6f 6e 73 20 22 62 6c 61 68 22 20 72 65 6d 61 cons "blah" rema
0c60: 72 67 73 29 20 61 72 67 6b 65 79 73 20 27 28 29 rgs) argkeys '()
0c70: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 30 args:arg-hash 0
0c80: 29 29 29 20 3b 3b 20 74 68 65 20 63 6f 6e 73 20 ))) ;; the cons
0c90: 62 6c 61 68 20 77 6f 72 6b 73 20 61 72 6f 75 6e blah works aroun
0ca0: 64 20 61 20 62 75 67 20 69 6e 20 61 72 67 73 0a d a bug in args.
0cb0: 3b 3b 20 20 20 20 20 28 70 72 69 6e 74 20 22 72 ;; (print "r
0cc0: 65 6d 61 72 67 73 3a 20 22 20 72 65 6d 61 72 67 emargs: " remarg
0cd0: 73 20 22 20 6e 65 77 72 65 6d 61 72 67 73 3a 20 s " newremargs:
0ce0: 22 20 6e 65 77 72 65 6d 61 72 67 73 29 0a 3b 3b " newremargs).;;
0cf0: 20 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 (apply appe
0d00: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda
0d10: 28 78 29 0a 3b 3b 20 09 09 09 20 28 6c 65 74 20 (x).;; ... (let
0d20: 28 28 76 61 6c 20 28 61 72 67 73 3a 67 65 74 2d ((val (args:get-
0d30: 61 72 67 20 78 29 29 29 0a 3b 3b 20 09 09 09 20 arg x))).;; ...
0d40: 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 0a (if (not val).
0d50: 3b 3b 20 09 09 09 20 20 20 20 20 20 20 28 70 72 ;; ... (pr
0d60: 69 6e 74 20 22 45 52 52 4f 52 3a 20 49 67 6e 6f int "ERROR: Igno
0d70: 72 69 6e 67 20 6b 65 79 20 22 20 78 20 22 20 66 ring key " x " f
0d80: 6f 75 6e 64 20 69 6e 20 64 61 74 61 62 61 73 65 ound in database
0d90: 20 62 75 74 20 6e 6f 74 20 6f 6e 20 63 6f 6d 6d but not on comm
0da0: 61 6e 64 20 6c 69 6e 65 22 29 29 0a 3b 3b 20 09 and line")).;; .
0db0: 09 09 20 20 20 28 69 66 20 77 69 74 68 6b 65 79 .. (if withkey
0dc0: 20 28 6c 69 73 74 20 78 20 76 61 6c 29 20 28 6c (list x val) (l
0dd0: 69 73 74 20 76 61 6c 29 29 29 29 0a 3b 3b 20 09 ist val)))).;; .
0de0: 09 20 20 20 20 20 20 20 61 72 67 6b 65 79 73 29 . argkeys)
0df0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6b 65 )))..(define (ke
0e00: 79 73 74 72 69 6e 67 2d 3e 6b 65 79 73 20 6b 65 ystring->keys ke
0e10: 79 73 74 72 69 6e 67 29 0a 20 20 28 6d 61 70 20 ystring). (map
0e20: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 28 6c (lambda (x).. (l
0e30: 65 74 20 28 28 78 6c 73 74 20 28 73 74 72 69 6e et ((xlst (strin
0e40: 67 2d 73 70 6c 69 74 20 78 20 22 3a 22 29 29 29 g-split x ":")))
0e50: 0a 09 20 20 20 28 6c 69 73 74 2d 3e 76 65 63 74 .. (list->vect
0e60: 6f 72 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 or (if (> (lengt
0e70: 68 20 78 6c 73 74 29 20 31 29 20 78 6c 73 74 20 h xlst) 1) xlst
0e80: 28 61 70 70 65 6e 64 20 28 63 61 72 20 78 6c 73 (append (car xls
0e90: 74 29 28 6c 69 73 74 20 22 54 45 58 54 22 29 29 t)(list "TEXT"))
0ea0: 29 29 29 29 0a 20 20 20 20 20 20 20 28 64 65 6c )))). (del
0eb0: 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 ete-duplicates (
0ec0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6b 65 79 string-split key
0ed0: 73 74 72 69 6e 67 20 22 2c 22 29 29 29 29 0a 0a string ","))))..
0ee0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 2d (define (config-
0ef0: 67 65 74 2d 66 69 65 6c 64 73 20 63 6f 6e 66 64 get-fields confd
0f00: 61 74 29 0a 20 20 28 6c 65 74 20 28 28 66 69 65 at). (let ((fie
0f10: 6c 64 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d lds (hash-table-
0f20: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 ref/default conf
0f30: 64 61 74 20 22 66 69 65 6c 64 73 22 20 27 28 29 dat "fields" '()
0f40: 29 29 29 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 ))). (map (la
0f50: 6d 62 64 61 20 28 78 29 28 76 65 63 74 6f 72 20 mbda (x)(vector
0f60: 28 63 61 72 20 78 29 28 63 61 64 72 20 78 29 29 (car x)(cadr x))
0f70: 29 0a 09 20 66 69 65 6c 64 73 29 29 29 0a 0a ).. fields)))..