63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
(define-inline (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
(define-inline (keys->key/field keys . additional)
(string-join (map (lambda (k)(conc (key:get-fieldname k) " " (key:get-fieldtype k)))(append keys additional)) ","))
(define (args:usage . a) #f)
;; Using the keys pulled from the database (initially set from the megatest.config file)
;; look for the equivalent value on the command line and add it to a list, or #f if not found.
;; default => (val1 val2 val3 ...)
;; withkey => (:key1 val1 :key2 val2 :key3 val3 ...)
(define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE!
(let* ((keynames (map key:get-fieldname keys))
(argkeys (map (lambda (k)(conc ":" k)) keynames))
(withkey (not (null? withkey)))
(newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args [args assumes ("calling-prog-name" .... ) ]
;;(debug:print 0 "remargs: " remargs " newremargs: " newremargs)
(apply append (map (lambda (x)
(let ((val (args:get-arg x)))
;; (debug:print 0 "x: " x " val: " val)
(if (not val)
;; (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
(set! val "default"))
(if withkey (list x val) (list val))))
argkeys))))
;; Given a list of keys (list of vectors) return an alist ((key argval) ...)
(define (keys->alist keys defaultval)
(let* ((keynames (map key:get-fieldname keys))
(newremargs (args:get-args (cons "blah" remargs) (map (lambda (k)(conc ":" k)) keynames) '() args:arg-hash 0))) ;; the cons blah works around a bug in args
|
>
>
>
>
>
>
>
|
>
|
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(define-inline (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
(define-inline (keys->key/field keys . additional)
(string-join (map (lambda (k)(conc (key:get-fieldname k) " " (key:get-fieldtype k)))(append keys additional)) ","))
(define (args:usage . a) #f)
;; keys->vallist is called several times (quite unnecessarily), use this hash to suppress multiple
;; reporting of missing keys on the command line.
(define keys:warning-suppress-hash (make-hash-table))
;; Using the keys pulled from the database (initially set from the megatest.config file)
;; look for the equivalent value on the command line and add it to a list, or #f if not found.
;; default => (val1 val2 val3 ...)
;; withkey => (:key1 val1 :key2 val2 :key3 val3 ...)
(define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE!
(let* ((keynames (map key:get-fieldname keys))
(argkeys (map (lambda (k)(conc ":" k)) keynames))
(withkey (not (null? withkey)))
(newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args [args assumes ("calling-prog-name" .... ) ]
;;(debug:print 0 "remargs: " remargs " newremargs: " newremargs)
(apply append (map (lambda (x)
(let ((val (args:get-arg x)))
;; (debug:print 0 "x: " x " val: " val)
(if (not val)
(begin
(if (not (hash-table-ref/default keys:warning-suppress-hash x #f))
(begin
(debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
(hash-table-set! keys:warning-suppress-hash x #t)))
(set! val "default")))
(if withkey (list x val) (list val))))
argkeys))))
;; Given a list of keys (list of vectors) return an alist ((key argval) ...)
(define (keys->alist keys defaultval)
(let* ((keynames (map key:get-fieldname keys))
(newremargs (args:get-args (cons "blah" remargs) (map (lambda (k)(conc ":" k)) keynames) '() args:arg-hash 0))) ;; the cons blah works around a bug in args
|