Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -55,10 +55,11 @@ get-tests-for-run-mindata get-run-name-from-id get-runs simple-get-runs get-num-runs + get-runs-cnt-by-patt get-all-run-ids get-prev-run-ids get-run-ids-matching-target get-runs-by-patt get-steps-data @@ -275,10 +276,11 @@ ((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct params)) ((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata dbstruct params)) ((get-runs) (apply db:get-runs dbstruct params)) ((simple-get-runs) (apply db:simple-get-runs dbstruct params)) ((get-num-runs) (apply db:get-num-runs dbstruct params)) + ((get-runs-cnt-by-patt) (apply db:get-runs-cnt-by-patt dbstruct params)) ((get-all-run-ids) (db:get-all-run-ids dbstruct)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2242,10 +2242,45 @@ (set! numruns count)) db "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" runpatt) (debug:print-info 11 *default-log-port* "db:get-num-runs END " runpatt) numruns)))) + +;; just get count of runs +(define (db:get-runs-cnt-by-patt dbstruct runpatt targetpatt keys) + (db:with-db + dbstruct + #f + #f + (lambda (db) + (let ((numruns 0) + (qry-str #f) + (key-patt "") + (keyvals (if targetpatt (keys:target->keyval keys targetpatt) '()))) + (for-each (lambda (keyval) + (let* ((key (car keyval)) + (patt (cadr keyval)) + (fulkey (conc ":" key)) + (wildtype (if (substring-index "%" patt) "like" "glob"))) + (if patt + (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'")) + (begin + (debug:print-error 0 *default-log-port* "searching for runs with no pattern set for " fulkey) + (exit 6))))) + keyvals) + ; (print runpatt " -- " key-patt) + (set! qry-str (conc "SELECT COUNT(id) FROM runs WHERE state != 'deleted' AND runname like " runpatt key-patt)) + ; (print qry-str ) + (debug:print-info 11 *default-log-port* "db:get-num-runs START " runpatt) +; (sqlite3:for-each-row +; (lambda (count) +; (set! numruns count)) +; db +; qry-str) + (debug:print-info 11 *default-log-port* "db:get-num-runs END " runpatt) + numruns)))) + ;; (sqlite3#fold-row proc3670 init3671 db-or-stmt3672 . params3673)> ;; (define (db:get-raw-run-stats dbstruct run-id) (db:with-db Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -698,10 +698,13 @@ (rmt:send-receive 'get-run-info run-id (list run-id))) (define (rmt:get-num-runs runpatt) (rmt:send-receive 'get-num-runs #f (list runpatt))) +(define (rmt:get-runs-cnt-by-patt runpatt targetpatt keys) + (rmt:send-receive 'get-runs-cnt-by-patt #f (list runpatt targetpatt keys))) + ;; Use the special run-id == #f scenario here since there is no run yet (define (rmt:register-run keyvals runname state status user contour) (rmt:send-receive 'register-run #f (list keyvals runname state status user contour))) (define (rmt:get-run-name-from-id run-id) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -773,19 +773,21 @@ resh)) ;; tests:genrate dashboard body ;; -(define (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links flag) +(define (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links flag run-patt target-patt) (let* ((start (* page pg-size)) - (runsdat (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys))) + ;(runsdat (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys))) + (runsdat (rmt:get-runs-by-patt keys run-patt target-patt start pg-size #f 0)) + ; db:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-update (header (vector-ref runsdat 0)) (runs (vector-ref runsdat 1)) - (ctr 0) - (test-runs-hash (tests:get-rest-data runs header numkeys)) - (test-list (hash-table-keys test-runs-hash)) - ) + (ctr 0) + (test-runs-hash (tests:get-rest-data runs header numkeys)) + (test-list (hash-table-keys test-runs-hash))) + (print header ) (s:html tests:css-jscript-block (tests:css-jscript-block-cond flag) (s:title "Summary for " area-name) (s:body 'onload "addEvents();" (get-prev-links page linktree) (get-next-links page linktree total-runs) @@ -805,11 +807,11 @@ res)) keys) (s:tr (s:th "Run Name") (map (lambda (run) - (s:th (vector-ref run 3))) + (s:th (db:get-value-by-header run header "runname"))) runs)) (map (lambda (test-name) (let* ((item-hash (hash-table-ref/default test-runs-hash test-name #f)) (item-keys (sort (hash-table-keys item-hash) string<=?))) @@ -836,16 +838,29 @@ ;; (tests:create-html-tree "test-index.html") ;; (define (tests:create-html-tree outf) (let* ((lockfile (conc outf ".lock")) - (runs-to-process '()) + (runs-to-process '()) (linktree (common:get-linktree)) - (area-name (common:get-testsuite-name)) - (keys (rmt:get-keys)) - (numkeys (length keys)) - (total-runs (rmt:get-num-runs "%")) + (area-name (common:get-testsuite-name)) + (keys (rmt:get-keys)) + (numkeys (length keys)) + (run-patt (if (args:get-arg "-run-patt") + (args:get-arg "-run-patt") + "%")) + (target (if (args:get-arg "-target-patt") + (args:get-arg "-target-patt") + "%")) + (targlist (string-split target "/")) + (numtarg (length targlist)) + (targtweaked (if (> numkeys numtarg) + (append targlist (make-list (- numkeys numtarg) "%")) + targlist)) + (target-patt (string-join targtweaked "/")) + ;(total-runs (rmt:get-num-runs "%")) ;;this needs to be changed to filter by target + (total-runs (rmt:get-runs-cnt-by-patt run-patt target-patt keys )) (pg-size 10)) (if (common:simple-file-lock lockfile) (begin ;(print total-runs) (let loop ((page 0)) @@ -858,14 +873,13 @@ (get-next-links (lambda (page linktree total-runs) (let* ((link (if (> total-runs (+ 10 (* page pg-size))) (s:a "next>>" 'href (conc linktree "/page" (+ page 1) ".html")) (s:a "" 'href (conc linktree "/page" page ".html"))))) link))) ) - ;(print (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name)) - (s:output-new - oup - (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f)) + (s:output-new + oup + (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f run-patt target-patt)) ;; update this function (close-output-port oup) ; (set! page (+ 1 page)) (if (> total-runs (* (+ 1 page) pg-size)) (loop (+ 1 page))))) (common:simple-file-release-lock lockfile)) @@ -919,12 +933,14 @@ ;(define (tests:create-html-tree o) (let* ( ;(page "1") (linktree (common:get-linktree)) (area-name (common:get-testsuite-name)) - (keys (rmt:get-keys)) - (numkeys (length keys)) + (keys (rmt:get-keys)) + (numkeys (length keys)) + (targtweaked (make-list numkeys "%")) + (target-patt (string-join targtweaked "/")) (total-runs (rmt:get-num-runs "%")) (pg-size 10) (pg (if (equal? page #f) 0 (- (string->number page) 1))) @@ -940,13 +956,12 @@ (let* ((link (if (> total-runs (+ 10 (* pg pg-size))) (s:a "next>> " 'href (conc "dashboard?page=" (+ pg 2) )) (s:a "" 'href (conc "dashboard?page=" pg ))))) link))) - (html-body (tests:dashboard-body pg pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #t))) - ;(print (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name)) -html-body)) + (html-body (tests:dashboard-body pg pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #t "%" target-patt))) ;; update tis function + html-body)) (define (tests:create-html-summary outf) (let* ((lockfile (conc outf ".lock")) (linktree (common:get-linktree)) (keys (rmt:get-keys)) @@ -1126,12 +1141,14 @@ (s:td 'class "test" target) (let* ((runs (hash-table-ref/default target-hash target #f)) (rest-row (map (lambda (run) (if (equal? run "") (s:td run) - (s:td - (s:a 'href (conc linktree "/" target "/" run "/run.html") run)))) + (if (file-exists?(conc linktree "/" target "/" run )) + (begin + (s:td + (s:a 'href (conc linktree "/" target "/" run "/run.html") run)))))) (reverse runs)))) rest-row))) targets))) tbl))))) (close-output-port oup)))