Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -753,14 +753,12 @@ ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match ;; run-ids is a list of run-ids or a single number (define (db:get-tests-for-runs db run-ids testpatt states statuses #!key (not-in #t) - (sort-by #f) ;; 'rundir 'event_time - (keypatts #f) - ) - (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) + (sort-by #f)) ;; 'rundir 'event_time + (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) (let* ((res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) #f (conc " state " @@ -779,11 +777,11 @@ (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 " (if run-ids (if (list? run-ids) (conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ") - (conc "run_id=" run-id " ")) + (conc "run_id=" run-ids " ")) " ") ;; #f => run-ids don't filter on run-ids (if states-qry (conc " AND " states-qry) "") (if statuses-qry (conc " AND " statuses-qry) "") (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by @@ -796,11 +794,11 @@ (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 ) - (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) + (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db test-id) ;; Breaking it into two queries for better file access interleaving Index: newdashboard.scm ================================================================== --- newdashboard.scm +++ newdashboard.scm @@ -373,23 +373,31 @@ ;; TO-DO ;; 1. Make "data" hash-table hierarchial store of all displayed data ;; 2. Update synchash to understand "get-runs", "get-tests" etc. ;; 3. Add extraction of filters to synchash calls ;; -(define (run-update data filters) - (synchash:client-get db:get-runs "get-runs" data filters) - (synchash:client-get db:get-tests "get-tests" data filters)) +(define (run-update data runname keypatts testpatt states statuses) + (let ((run-ids '())) + ;; count and offset => #f so not used + ;; the synchash calls modify the "data" hash + (synchash:client-get 'db:get-runs "get-runs" (length keypatts) data runname #f #f keypatts) + ;; Now can calculate the run-ids + (let* ((run-hash (hash-table-ref/default data "get-runs" #f)) + (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '()))) + (synchash:client-get 'db:get-tests-for-runs "get-tests-for-runs" 0 data run-ids testpatt states statuses)))) (define (newdashboard) - (let* ((data (make-hash-table)) - (filters (make-hash-table)) - (keys (cdb:remote-run db:get-keys #f)) - (keyvals (map (lambda (k)(list (vector-ref k 0) "%")) keys))) + (let* ((data (make-hash-table)) + (keys (cdb:remote-run db:get-keys #f)) + (runname "%") + (testpatt "%") + (keypatts (map (lambda (k)(list (vector-ref k 0) "%")) keys)) + (states '()) + (statuses '())) (iup:show (main-panel)) - ;; (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) - (run-update rundata keyvals))))) + (run-update data runname keypatts testpatt states statuses))))) (newdashboard) (iup:main-loop) Index: synchash.scm ================================================================== --- synchash.scm +++ synchash.scm @@ -56,12 +56,15 @@ (list changed deleted))) ;; (cdb:remote-run db:get-keys #f) ;; (cdb:remote-run db:get-num-runs #f "%") ;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts) +;; +;; keynum => the field to use as the unique key (usually 0 but can be other field) +;; (define (synchash:client-get proc synckey keynum synchash . params) - (let* ((data (apply cdb:remote-run synchash:server-get #f proc synckey params)) + (let* ((data (apply cdb:remote-run synchash:server-get #f proc synckey keynum params)) (newdat (car data)) (removs (cadr data))) (for-each (lambda (item) (let ((id (car item)) @@ -76,13 +79,32 @@ (define *synchashes* (make-hash-table)) (define (synchash:server-get db proc synckey keynum . params) + (debug:print 2 "synckey: " synckey ", keynum: " keynum ", params: " params) (let* ((synchash (hash-table-ref/default *synchashes* synckey #f)) - (newdat (apply proc db params))) + (newdat (apply (case proc + ((db:get-runs) db:get-runs) + ((db:get-tests-for-runs) db:get-tests-for-runs) + (else print)) + db params)) + (postdat #f) + (make-indexed (lambda (x) + (list (vector-ref x keynum) x)))) + ;; Now process newdat based on the query type + (set! postdat (case proc + ((db:get-runs) + (debug:print 2 "Get runs call") + (let ((header (vector-ref newdat 0)) + (data (vector-ref newdat 1))) + (list (list "header" header) ;; add the header keyed by the word "header" + (map make-indexed data)))) ;; add each element keyed by the keynum'th val + (else + (debug:print 2 "Non-get runs call") + (map make-indexed newdat)))) (if (not synchash) (begin (set! synchash (make-hash-table)) (hash-table-set! *synchashes* synckey synchash))) - (synchash:get-delta newdat synchash))) + (synchash:get-delta postdat synchash)))