Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -162,10 +162,11 @@ (let ((modtime (file-modification-time *db-file-path*))) (if (or (and (> modtime *last-db-update-time*) (> (current-seconds)(+ *last-db-update-time* 5))) (> *delayed-update* 0)) (begin + (debug:print 4 "INFO: update-rundat runnamepatt: " runnamepatt " numruns: " numruns " testnamepatt: " testnamepatt " itemnamepatt: " itemnamepatt " keypatts: " keypatts) (set! *please-update-buttons* #t) (set! *last-db-update-time* modtime) (set! *delayed-update* (- *delayed-update* 1)) (let* ((allruns (rdb:get-runs *db* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) *start-run-offset* keypatts)) @@ -620,12 +621,13 @@ (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* (hash-table-ref/default *searchpatts* "test-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))))) + (if (not (equal? key "runname")) + (let ((val (hash-table-ref/default *searchpatts* key #f))) + (if val (set! res (cons (list key val) res)))))) *dbkeys*) res)) ; (db:set-db-update-time) )) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -289,24 +289,32 @@ (let* ((header (append (map key:get-fieldname keys) remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) (list keystr header))) + +;; make a query (fieldname like 'patt1' OR fieldname +(define (db:patt->like fieldname pattstr #!key (comparator " OR ")) + (let ((patts (if (string? pattstr) + (string-split pattstr ",") + '("")))) + (string-intersperse (map (lambda (patt) + (conc fieldname " LIKE '" patt "'")) + (if (null? patts) + '("") + patts)) + comparator))) ;; replace header and keystr with a call to runs:get-std-run-fields ;; ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; runpatts: patt1,patt2 ... ;; (define (db:get-runs db runpatt count offset keypatts) (let* ((res '()) (keys (db:get-keys db)) - (runpatts (string-split runpatt ",")) - (runpattstr (string-intersperse (map (lambda (patt) - (conc "runname LIKE '" patt "'")) - runpatts) - " OR ")) + (runpattstr (db:patt->like "runname" runpatt)) (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 ","))) @@ -316,11 +324,11 @@ (conc " AND " (string-join (map (lambda (keypatt) (let ((key (car keypatt)) (patt (cadr keypatt))) - (conc key " LIKE '" patt "'"))) + (db:patt->like key patt))) keypatts) " AND "))) " ORDER BY event_time DESC " (if (number? count) (conc " LIMIT " count) @@ -454,11 +462,14 @@ (state-status-qry (if (or (not (null? states)) (not (null? states))) (conc " AND " (if not-in "NOT" "") " (" states-str " AND " statuses-str ") ") "")) (qry (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment " - " FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? " + " FROM tests WHERE run_id=? AND " + ;; testname like ? AND item_path LIKE ? " + (db:patt->like "testname" testpatt) " AND " + (db:patt->like "item_path" itempatt) state-status-qry (case sort-by ((rundir) " ORDER BY length(rundir) DESC;") ((event_time) " ORDER BY event_time ASC;") (else ";")) @@ -468,12 +479,13 @@ (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db qry run-id - (if testpatt testpatt "%") - (if itempatt itempatt "%")) + ;; (if testpatt testpatt "%") + ;; (if itempatt itempatt "%")) + ) res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db run-id test-name itemdat) ;; Breaking it into two queries for better file access interleaving Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -281,16 +281,17 @@ (if (not (args:get-arg "-server")) (server:client-setup db)) ;; Each run (for-each (lambda (run) - (debug:print 2 "Run: " + (debug:print 1 "Run: " (string-intersperse (map (lambda (x) (db:get-value-by-header run header x)) keynames) "/") "/" - (db:get-value-by-header run header "runname")) + (db:get-value-by-header run header "runname") + " status: " (db:get-value-by-header run header "state")) (let ((run-id (db:get-value-by-header run header "id"))) (let ((tests (rdb:get-tests-for-run db run-id testpatt itempatt '() '()))) ;; Each test (for-each (lambda (test)