109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
;; args and pkt key specs
;;
(define *arg-keys*
'(("-run" . r)
("-area" . G) ;; maps to group
|
<
|
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
;; args and pkt key specs
;;
(define *arg-keys*
'(("-area" . G) ;; maps to group
("-target" . t)
("-run-name" . n)
("-state" . e)
("-status" . s)
("-contour" . c)
("-test-patt" . p) ;; idea, enhance margs ("-test-patt" "-testpatt") => yields one value in "-test-patt"
("-mode-patt" . o)
|
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
(if (and (not (null? remargs))
(not (or
(args:get-arg "-runstep")
(args:get-arg "-envcap")
(args:get-arg "-envdelta")
)))
(debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " ")))
;;======================================================================
;; pkts
;;======================================================================
(define (with-queue-db mtconf proc)
(let* ((pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
|
>
>
>
>
>
>
|
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
(if (and (not (null? remargs))
(not (or
(args:get-arg "-runstep")
(args:get-arg "-envcap")
(args:get-arg "-envdelta")
)))
(debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " ")))
(if (or (args:any? "-h" "help" "-help" "--help")
(member *action* '("-h" "-help" "--help" "help")))
(begin
(print help)
(exit 1)))
;;======================================================================
;; pkts
;;======================================================================
(define (with-queue-db mtconf proc)
(let* ((pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
(mtconf (if mtconfdat (car mtconfdat) #f)))
;; we set some dynamic data in a section called "dyndata"
(if mtconf
(begin
(configf:section-var-set! mtconf "dyndat" "toppath" start-dir)))
(print "TOPPATH: " (configf:lookup mtconf "dyndat" "toppath"))
mtconfdat))
;; make a run request pkt from basic data
;;
(define (create-run-pkt mtconf area runkey runname mode-patt tag-expr pktsdir reason)
(let ((area-path (configf:lookup mtconf "areas" area)))
(let-values (((uuid pkt)
(command-line->pkt
|
>
>
>
>
|
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
(mtconf (if mtconfdat (car mtconfdat) #f)))
;; we set some dynamic data in a section called "dyndata"
(if mtconf
(begin
(configf:section-var-set! mtconf "dyndat" "toppath" start-dir)))
(print "TOPPATH: " (configf:lookup mtconf "dyndat" "toppath"))
mtconfdat))
;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.
;; make a run request pkt from basic data
;;
(define (create-run-pkt mtconf area runkey runname mode-patt tag-expr pktsdir reason)
(let ((area-path (configf:lookup mtconf "areas" area)))
(let-values (((uuid pkt)
(command-line->pkt
|