Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -167,15 +167,22 @@ "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived, r.id,r.target,r.ttype_id,r.run_name,r.state,r.status,r.owner,r.event_time,r.comment FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE r.target LIKE ?;" target-patt)) -(define (pgdb:get-stats-given-target dbh target-patt) +(define (pgdb:get-stats-given-target dbh ttype-id target-patt) (dbi:get-rows dbh - "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id - WHERE t.state='COMPLETED' AND r.target LIKE ? GROUP BY t.status,r.target;" target-patt)) + ;; "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + ;; WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;" + "SELECT r.target,COUNT(*) AS total, + SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass, + SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail, + SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other + FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target;" + ttype-id target-patt)) (define (pgdb:get-target-types dbh) (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;")) ;; @@ -203,17 +210,19 @@ ;; create a hash of hashes with keys extracted from all-parts ;; using row-or-col to choose row or column ;; ht{row key}=>ht{col key}=>data ;; -(define (pgdb:coalesce-runs dbh runs all-parts row-or-col) +;; fnum is the field number in the tuples to be split +;; +(define (pgdb:coalesce-runs dbh runs all-parts row-or-col fnum) (let* ((data (make-hash-table))) ;; (rnums ( ;; for now just do first => remainder (for-each (lambda (run) - (let* ((target (vector-ref run 2)) + (let* ((target (vector-ref run fnum)) (parts (string-split target "/")) (first (car parts)) (rest (string-intersperse (cdr parts) "/")) (coldat (hash-table-ref/default data first #f))) (if (not coldat)(let ((newht (make-hash-table))) Index: cgisetup/pages/index_view.scm ================================================================== --- cgisetup/pages/index_view.scm +++ cgisetup/pages/index_view.scm @@ -21,13 +21,14 @@ (tfilter (or (s:session-var-get "target-filter") "%")) (targets (pgdb:get-targets-of-type dbh selected tfilter)) ;; (target (s:session-var-get "target")) ;; (target-patt (or target "%")) (row-or-col (string-split (or (s:session-var-get "row-or-col") "") ",")) - (all-data (pgdb:get-stats-given-target dbh tfilter)) + (all-data (if selected (pgdb:get-stats-given-target dbh selected tfilter) + '())) ;; (all-data (pgdb:get-tests dbh tfilter)) - (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col))) + (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) (list "" (s:html (s:title (conc "Megatest")) @@ -35,11 +36,11 @@ index:kickstart-junk ) (s:body ;; (s:session-var-get "target-type") ;; (conc " selected = " selected ", ttypes = " ttypes ", curr-ttype = " curr-ttype ", curr-trec = " curr-trec) - (conc (hash-table->alist ordered-data)) + ;; (conc (hash-table->alist ordered-data)) (s:div 'class "grid flex" 'id "top_of_page" ;; add visible to columns to help visualize them e.g. "col_12 visible" ;; BEGINNING OF HEADER (s:div 'class "col_12" (s:fieldset @@ -57,52 +58,85 @@ 'name 'target-type) (s:input-preserve 'name "tfilter" 'placeholder "Filter targets") (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit" 'class "col_3")) ;; use radio buttons to select whether to put this identifier in row or column. ;; this seems clumsly and takes up a lot of screen realestate - (s:div 'class "col_12" - (s:div 'class "col_1" "identifier") - (map (lambda (target-var) - (s:div 'class "col_1" target-var)) - all-parts)) - (s:div 'class "col_12" - (s:div 'class "col_1" "row") - (map (lambda (target-var) - (s:div 'class "col_1" (s:input 'type "checkbox" 'name "row-or-col" 'value target-var - ;; this silly trick preserves the checkmark - (if (member target-var row-or-col) 'checked "") - ""))) - all-parts)))) + ;; (s:div 'class "col_12" + ;; (s:div 'class "col_1" "identifier") + ;; (map (lambda (target-var) + ;; (s:div 'class "col_1" target-var)) + ;; all-parts)) + ;; (s:div 'class "col_12" + ;; (s:div 'class "col_1" "row") + ;; (map (lambda (target-var) + ;; (s:div 'class "col_1" (s:input 'type "checkbox" 'name "row-or-col" 'value target-var + ;; ;; this silly trick preserves the checkmark + ;; (if (member target-var row-or-col) 'checked "") + ;; ""))) + ;; all-parts)) + )) (s:fieldset (conc "Runs data for " tfilter) ;; - ;; This is completely wrong!!! However it may provide some ideas! + ;; A very basic display ;; - (s:table - (map - (lambda (key) - (let ((subdat (hash-table-ref ordered-data key))) - (s:tr (s:td key) - (map - (lambda (remkey) - (s:td remkey - (let ((dat (hash-table-ref subdat remkey))) - (s:td (vector-ref dat 1) (vector-ref dat 0))))) - (sort (hash-table-keys subdat) string>=?))))) - (sort (hash-table-keys ordered-data) string>=?))) - - ;;(map (lambda (area) - ;; (s:p "data=" (conc area))) - ;; ;; (pgdb:get-tests dbh tfilter)) - ;; (pgdb:get-stats-given-target dbh tfilter)) - - - - - index:jquery - index:javascript - )))))))) + (let* ((a-keys (sort (hash-table-keys ordered-data) string>=?)) + (b-keys (sort (apply + append + (map (lambda (sub-key) + (let ((subdat (hash-table-ref ordered-data sub-key))) + (hash-table-keys subdat))) + a-keys)) + string>=?))) + (if #f ;; swap rows/cols + (s:table + (s:tr (s:td "")(map s:tr b-keys)) + (map + (lambda (row-key) + (let ((subdat (hash-table-ref ordered-data row-key))) + (s:tr (s:td row-key) + (map + (lambda (col-key) + (s:td (let ((dat (hash-table-ref/default subdat col-key #f))) + (s:td (if dat + (list (vector-ref dat 1) (vector-ref dat 0)) + ""))))) + b-keys)))) + a-keys)) + (s:table + (s:tr (s:td "")(map s:td a-keys)) + (map + (lambda (row-key) + (s:tr (s:td row-key) + (map + (lambda (col-key) + (let ((val (let* ((ht (hash-table-ref/default ordered-data col-key #f))) + (if ht (hash-table-ref/default ht row-key #f))))) + (if val + (let* ((total (vector-ref val 1)) + (pass (vector-ref val 2)) + (fail (vector-ref val 3)) + (other (vector-ref val 4)) + (passper (round (* (/ pass total) 100))) + (failper (- 100 passper))) + (s:td 'style (conc "background: linear-gradient(to right, green " passper "%, red " failper "%);") + (conc total "/" pass "/" fail "/" other))) + (s:td "")))) + a-keys))) + b-keys)))))) + + ;;(map (lambda (area) + ;; (s:p "data=" (conc area))) + ;; ;; (pgdb:get-tests dbh tfilter)) + ;; (pgdb:get-stats-given-target dbh tfilter)) + + + + + index:jquery + index:javascript + )))))) ;; (s:div 'class "col_12" ;; (s:div 'class "col_1" "row") ;; (map (lambda (target-var)