Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -75,11 +75,11 @@ (define toplevel #f) (define dlg #f) (define max-test-num 0) (define *keys* (get-keys *db*)) -(define dbkeys (map (lambda (x)(vector-ref x 0)) +(define *dbkeys* (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; (define *alltestnamelst* '()) @@ -175,12 +175,13 @@ (let* ((c1 (map string->number (string-split color1))) (c2 (map string->number (string-split color2))) (delta (map (lambda (a b)(abs (- a b))) c1 c2))) (null? (filter (lambda (x)(> x 3)) delta)))) -(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt) - (let* ((allruns (db-get-runs *db* runnamepatt numruns *start-run-offset*)) +;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) +(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt keypatts) + (let* ((allruns (db:get-runs *db* runnamepatt numruns *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) (maxtests 0)) (if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes @@ -521,12 +522,12 @@ (if (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS" )) (begin (set! *num-tests* (string->number (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS")))) - (update-rundat "%" *num-runs* "%" "%")) - (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20))) + (update-rundat "%" *num-runs* "%" "%" '())) + (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%" '()) 8) 20))) (define *tim* (iup:timer)) (define *ord* #f) (iup:attribute-set! *tim* "TIME" 300) (iup:attribute-set! *tim* "RUN" "YES") @@ -533,11 +534,17 @@ (define (run-update x) (update-buttons uidat *num-runs* *num-tests*) (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* (hash-table-ref/default *searchpatts* "test-name" "%") - (hash-table-ref/default *searchpatts* "item-name" "%"))) + (hash-table-ref/default *searchpatts* "item-name" "%") + (let ((res '())) + (for-each (lambda (key) + (let ((val (hash-table-ref/default *searchpatts* key #f))) + (if val (set! res (cons (list key val) res))))) + *dbkeys*) + res))) (cond ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid @@ -555,13 +562,13 @@ (examine-test *db* testid) (begin (print "ERROR: testid is not a number " (args:get-arg "-test")) (exit 1))))) (else - (set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys)) + (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) (run-update x))))) ;(print x))))) (iup:main-loop) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -239,32 +239,50 @@ remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) (list keystr header))) +;; WAS db-get-runs FIXME IN REMAINING CODE +;; +;; MERGE THIS WITH db:get-runs, accidently wrote it twice +;; ;; replace header and keystr with a call to runs:get-std-run-fields -(define (db-get-runs db runpatt . count) +;; +;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) +;; +(define (db:get-runs db runpatt count offset keypatts) (let* ((res '()) (keys (db-get-keys db)) (remfields (list "id" "runname" "state" "status" "owner" "event_time")) (header (append (map key:get-fieldname keys) remfields)) (keystr (conc (keys->keystr keys) "," - (string-intersperse remfields ",")))) + (string-intersperse remfields ","))) + (qrystr (conc "SELECT " keystr " FROM runs WHERE runname LIKE ? " + ;; Generate: " AND x LIKE 'keypatt' ..." + (if (null? keypatts) "" + (conc " AND " + (string-join + (map (lambda (keypatt) + (let ((key (car keypatt)) + (patt (cadr keypatt))) + (conc key " LIKE '" patt "'"))) + keypatts) + " AND "))) + " ORDER BY event_time DESC " + (if (number? count) + (conc " LIMIT " count) + "") + (if (number? offset) + (conc " OFFSET " offset) + "")))) + (debug:print 4 "db:get-runs qrystr: " qrystr "\nkeypatts: " keypatts) (sqlite3:for-each-row (lambda (a . x) (set! res (cons (apply vector a x) res))) db - (conc "SELECT " keystr " FROM runs WHERE runname LIKE ? ORDER BY event_time DESC " - (if (and (not (null? count)) - (number? (car count))) - (conc " LIMIT " (car count)) - "") - (if (and (> (length count) 1) - (number? (cadr count))) - (conc " OFFSET " (cadr count)) - "")) + qrystr runpatt) (vector header res))) ;; just get count of runs (define (db:get-num-runs db runpatt) @@ -275,31 +293,10 @@ db "SELECT COUNT(id) FROM runs WHERE runname LIKE ?;" runpatt) numruns)) -;; replace header and keystr with a call to runs:get-std-run-fields -;; keypatt: '(("key1" "patt1")("key2" "patt2")...) -(define (db:get-runs db keys keypatts runpatt) - (let* ((res '()) - (remfields (list "id" "runname" "state" "status" "owner" "event_time")) - (header (append (map key:get-fieldname keys) - remfields)) - (keystr (conc (keys->keystr keys) "," - (string-intersperse remfields ",")))) - (sqlite3:for-each-row - (lambda (a . x) ;; turn all the fields returned into a vector and add to the list - (set! res (cons (apply vector a x) res))) - db - (conc "SELECT " keystr " FROM runs WHERE runname LIKE ? " - (map (lambda (keypatt) - (conc "AND " (car keypatt) " LIKE " (cadr keypatt) " ")) - keypatts) - "ORDER BY event_time DESC;") - runpatt) - (vector header res))) - ;; use this one for db-get-run-info (define-inline (db:get-row vec)(vector-ref vec 1)) ;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo)) (define (db:get-run-info db run-id) @@ -676,12 +673,12 @@ (lambda (step) (debug:print 6 "step=" step) (let ((record (hash-table-ref/default res (db:step-get-stepname step) - ;; stepname start end status - (vector (db:step-get-stepname step) "" "" "" "")))) + ;; stepname start end status time (needed for sorting) + (vector (db:step-get-stepname step) "" "" "" "" 0)))) (debug:print 6 "record(before) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) "\nstatus: " (db:step-get-status step) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -223,11 +223,11 @@ (setup-for-run) (open-db))) (runpatt (args:get-arg "-list-runs")) (testpatt (args:get-arg "-testpatt")) (itempatt (args:get-arg "-itempatt")) - (runsdat (db-get-runs db runpatt)) + (runsdat (db:get-runs db runpatt #f #f '())) (runs (db:get-rows runsdat)) (header (db:get-header runsdat)) (keys (db-get-keys db)) (keynames (map key:get-fieldname keys))) ;; Each run @@ -263,11 +263,11 @@ "\n diskfree: " (db:test-get-diskfree test) "\n uname: " (db:test-get-uname test) "\n rundir: " (db:test-get-rundir test) ) ;; Each test - (let ((steps (db-get-test-steps-for-run db (db:test-get-id test)))) + (let ((steps (db:get-steps-for-test db (db:test-get-id test)))) (for-each (lambda (step) (format #t " Step: ~20a State: ~10a Status: ~10a Time ~22a\n" (db:step-get-stepname step)