| ︙ | | | ︙ | |
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
;; (print "[" x "]"))
(print x))
targets)
(set! *didsomething* #t)))
(define (full-runconfigs-read)
(let* ((keys (cdb:remote-run db:get-keys #f))
(target (if (args:get-arg "-reqtarg")
(args:get-arg "-reqtarg")
(if (args:get-arg "-target")
(args:get-arg "-target")
#f)))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f))
(data (begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(if key-vals
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
|
|
<
<
<
<
|
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
;; (print "[" x "]"))
(print x))
targets)
(set! *didsomething* #t)))
(define (full-runconfigs-read)
(let* ((keys (cdb:remote-run db:get-keys #f))
(target (common:args-get-target))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f))
(data (begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(if key-vals
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
|
| ︙ | | | ︙ | |
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action)
(let* ((runrec (runs:runrec-make-record))
(target (or (args:get-arg "-reqtarg")
(args:get-arg "-target"))))
(cond
((not target)
(debug:print 0 "ERROR: Missing required parameter for " action ", you must specify -target or -reqtarg")
(exit 1))
((not (args:get-arg ":runname"))
(debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt")
(exit 2))
|
|
<
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action)
(let* ((runrec (runs:runrec-make-record))
(target (common:args-get-target)))
(cond
((not target)
(debug:print 0 "ERROR: Missing required parameter for " action ", you must specify -target or -reqtarg")
(exit 1))
((not (args:get-arg ":runname"))
(debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt")
(exit 2))
|
| ︙ | | | ︙ | |
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
|
(if (or (args:get-arg "-set-run-status")
(args:get-arg "-get-run-status"))
(general-run-call
"-set-run-status"
"set run status"
(lambda (target runname keys keyvals)
(let* ((runsdat (cdb:remote-run db:get-runs-by-patt #f keys runname (or (args:get-arg "-target")
(args:get-arg "-reqtarg")) #f #f))
|
|
>
|
|
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
|
(if (or (args:get-arg "-set-run-status")
(args:get-arg "-get-run-status"))
(general-run-call
"-set-run-status"
"set run status"
(lambda (target runname keys keyvals)
(let* ((runsdat (cdb:remote-run db:get-runs-by-patt #f keys runname
(common:args-get-target)
#f #f))
(header (vector-ref runsdat 0))
(rows (vector-ref runsdat 1)))
(if (null? rows)
(begin
(debug:print-info 0 "No matching run found.")
(exit 1))
(let* ((row (car (vector-ref runsdat 1)))
|
| ︙ | | | ︙ | |
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
|
(if (setup-for-run)
(let* ((db #f)
(runpatt (args:get-arg "-list-runs"))
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (cdb:remote-run db:get-keys #f))
(runsdat (cdb:remote-run db:get-runs-by-patt #f keys runpatt (or (args:get-arg "-target")
(args:get-arg "-reqtarg")) #f #f))
|
|
>
|
|
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
|
(if (setup-for-run)
(let* ((db #f)
(runpatt (args:get-arg "-list-runs"))
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (cdb:remote-run db:get-keys #f))
(runsdat (cdb:remote-run db:get-runs-by-patt #f keys runpatt
(common:args-get-target)
#f #f))
;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
(runs (db:get-rows runsdat))
(header (db:get-header runsdat))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table)))
;; Each run
(for-each
|
| ︙ | | | ︙ | |