Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -304,10 +304,27 @@ (hash-table-set! data first newht) (set! coldat newht))) (hash-table-set! coldat rest run))) runs) data)) + +;; given ordered data hash return a-keys +;; +(define (pgdb:ordered-data->a-keys ordered-data) + (sort (hash-table-keys ordered-data) string>=?)) + +;; given ordered data hash return b-keys +;; +(define (pgdb:ordered-data->b-keys ordered-data a-keys) + (delete-duplicates + (sort (apply + append + (map (lambda (sub-key) + (let ((subdat (hash-table-ref ordered-data sub-key))) + (hash-table-keys subdat))) + a-keys)) + string>=?))) ;; given ordered data hash return a-keys ;; (define (pgdb:ordered-data->a-keys ordered-data) (sort (hash-table-keys ordered-data) string>=?)) Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -64,11 +64,11 @@ ;;====================================================================== ;; Make the regexp's needed globally available ;;====================================================================== (define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) -(define configf:script-rx (regexp "^\\[scriptinc\\s+(.*)\\]\\s*$")) ;; include output from a script +(define configf:script-rx (regexp "^\\[scriptinc\\s+(\\S+)([^\\]]*)\\]\\s*$")) ;; include output from a script (define configf:section-rx (regexp "^\\[(.*)\\]\\s*$")) (define configf:blank-l-rx (regexp "^\\s*$")) (define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) (define configf:key-val-pr (regexp "^(\\S+)(\\s+(.*)|())$")) (define configf:key-no-val (regexp "^(\\S+)(\\s*)$")) @@ -292,17 +292,17 @@ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (begin (debug:print '(2 9) #f "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 *default-log-port* " " full-conf) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))) - (configf:script-rx ( x include-script );; handle-exceptions - ;; exn - ;; (begin - ;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.") - ;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) + (configf:script-rx ( x include-script params);; handle-exceptions + ;; exn + ;; (begin + ;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.") + ;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (if (and (file-exists? include-script)(file-execute-access? include-script)) - (let* ((new-inp-port (open-input-pipe include-script))) + (let* ((new-inp-port (open-input-pipe (conc include-script " " params)))) (debug:print '(2 9) *default-log-port* "Including from script output: " include-script) ;; (print "We got here, calling read-config next. Port is: " new-inp-port) (read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) (close-input-port new-inp-port) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3334,18 +3334,21 @@ (bad-not-started (length (filter (lambda (x) (and (equal? (dbr:counts-state x) "NOT_STARTED") (not (member (dbr:counts-status x) *common:not-started-ok-statuses*)))) state-status-counts))) - (all-curr-states (common:special-sort ;; worst -> best (sort of) - (delete-duplicates - (cons state (map dbr:counts-state state-status-counts))) - *common:std-states* >)) - (all-curr-statuses (common:special-sort ;; worst -> best - (delete-duplicates - (cons status (map dbr:counts-status state-status-counts))) - *common:std-statuses* >)) + ;; (non-completes (filter (lambda (x) + ;; (not (equal? (dbr:counts-state x) "COMPLETED"))) + ;; state-status-counts)) + (all-curr-states (common:special-sort ;; worst -> best (sort of) + (delete-duplicates + (cons state (map dbr:counts-state state-status-counts))) + *common:std-states* >)) + (all-curr-statuses (common:special-sort ;; worst -> best + (delete-duplicates + (cons status (map dbr:counts-status state-status-counts))) + *common:std-statuses* >)) (non-completes (filter (lambda (x) (not (equal? x "COMPLETED"))) all-curr-states)) (newstate (cond ((> (length non-completes) 0) ;; @@ -3355,15 +3358,15 @@ ;; (if (> running 0) ;; "RUNNING" ;; (if (> bad-not-started 0) ;; "COMPLETED" ;; (car all-curr-states)))) - (newstatus (if (> bad-not-started 0) - "CHECK" - (car all-curr-statuses)))) - (print "running: " running " bad-not-started: " bad-not-started " all-curr-states: " all-curr-states " non-completes: " non-completes " state-status-counts: " state-status-counts - " newstate: " newstate " newstatus: " newstatus) + (newstatus (if (> bad-not-started 0) + "CHECK" + (car all-curr-statuses)))) + ;; (print "bad-not-supported: " bad-not-support " all-curr-states: " all-curr-states " all-curr-statuses: " all-curr-states) + ;; " newstate: " newstate " newstatus: " newstatus) ;; NB// Pass the db so it is part of the transaction (db:test-set-state-status db run-id tl-test-id newstate newstatus #f))))))) (mutex-unlock! *db-transaction-mutex*) (if (and test-id state status (equal? status "AUTO")) (db:test-data-rollup dbstruct run-id test-id status)) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -1,7 +1,7 @@ -;; Copyright 2006-2013, Matthew Welland. +;; Copyright 2006-2017, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the Index: runconfigs.config ================================================================== --- runconfigs.config +++ runconfigs.config @@ -10,14 +10,16 @@ # [a/b/c] all:scheduled:sync cron= 0/5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config quick:scheduled:sync cron= 0/5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config -[scriptinc ./gentargets.sh] +[scriptinc ./gentargets.sh #{getenv USER}] # [v1.23/45/67] # tip will be replaced with hashkey? + +# [%/%/%] doesn't work [/.*/] # [v1.63/tip/dev] # file: files changes since last run trigger new run