ADDED cgisetup/css/pjhatwal-modal.css Index: cgisetup/css/pjhatwal-modal.css ================================================================== --- /dev/null +++ cgisetup/css/pjhatwal-modal.css @@ -0,0 +1,43 @@ +.modal { + display: none; /* Hidden by default */ + position: fixed; /* Stay in place */ + z-index: 1; /* Sit on top */ + padding-top: 100px; /* Location of the box */ + left: 0; + top: 0; + width: 100%; /* Full width */ + height: 100%; /* Full height */ + overflow: auto; /* Enable scroll if needed */ + background-color: rgb(0,0,0); /* Fallback color */ + background-color: rgba(0,0,0,0.4); /* Black w/ opacity */ +} + +/* Modal Content */ +.modal-content { + background-color: #fefefe; + margin: auto; + padding: 20px; + border: 1px solid #888; + width: 80%; + top: 50% +} + +/* The Close Button */ +.close { + color: #aaaaaa; + float: right; + font-size: 28px; + font-weight: bold; +} + +.close:hover, +.close:focus { + color: #000; + text-decoration: none; + cursor: pointer; +} + +.vote { + color: #faaaaa; +} + ADDED cgisetup/js/pjhatwal-modal.js Index: cgisetup/js/pjhatwal-modal.js ================================================================== --- /dev/null +++ cgisetup/js/pjhatwal-modal.js @@ -0,0 +1,15 @@ +$(document).ready(function(){ + $(".viewmodal").click(function(){ + var modal = document.getElementById("myModal" + this.id); + // alert(this.id); + modal.style.display = "block"; + + }); + $(".close").click(function(){ + var modal = document.getElementById("myModal" + this.id); + // alert(this.id); + modal.style.display = "none"; + + }); +}); + Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -197,13 +197,60 @@ 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 r.target LIKE ? GROUP BY r.target;" target-patt)) + +(define (pgdb:get-latest-run-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 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, r.id + FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + WHERE t.state like '%' AND ttype_id=? AND r.target LIKE ? + and r.id in +(SELECT DISTINCT on (target) id from runs where target like ? AND ttype_id=? order by target,event_time desc) GROUP BY r.target,r.id;" + ttype-id target-patt target-patt ttype-id)) + +(define (pgdb:get-run-stats-history-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 ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;" + "SELECT r.run_name,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 like '%' AND ttype_id=? AND r.target LIKE ? + GROUP BY r.run_name;" + ttype-id target-patt )) + +(define (pgdb:get-all-run-stats-target-slice dbh target-patt) +(dbi:get-rows + dbh + "SELECT r.target, r.run_name,r.event_time, 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 r.target LIKE ? + + GROUP BY r.target,r.run_name, r.event_time;" + target-patt)) + (define (pgdb:get-target-types dbh) (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;")) + + (define (pgdb:get-distict-target-slice dbh) + (dbi:get-rows dbh " select distinct on (split_part (target, '/', 1)) (split_part (target, '/', 1)) from runs;")) + ;; (define (pgdb:get-targets dbh target-patt) (let ((ttypes (pgdb:get-target-types dbh))) (map @@ -274,10 +321,28 @@ (map (lambda (sub-key) (let ((subdat (hash-table-ref ordered-data sub-key))) (hash-table-keys subdat))) a-keys)) string>=?))) + +(define (pgdb:coalesce-runs-by-slice runs slice) + (let* ((data (make-hash-table))) + (for-each + (lambda (run) + (let* ((target (vector-ref run 0)) + (run-name (vector-ref run 1)) + (parts (string-split target "/")) + (first (car parts)) + (rest (string-intersperse (cdr parts) "/")) + (coldat (hash-table-ref/default data rest #f))) + (if (not coldat)(let ((newht (make-hash-table))) + (hash-table-set! data rest newht) + (set! coldat newht))) + (hash-table-set! coldat run-name run))) + runs) + data)) + (define (pgdb:runs-to-hash runs ) (let* ((data (make-hash-table))) (for-each (lambda (run) @@ -288,5 +353,14 @@ (hash-table-set! data run-name newht) (set! coldat newht))) (hash-table-set! coldat test run))) runs) data)) + +(define (pgdb:get-history-hash runs) + (let* ((data (make-hash-table))) + (for-each + (lambda (run) + (let* ((run-name (vector-ref run 0))) + (hash-table-set! data run-name run))) + runs) + data)) Index: cgisetup/pages/home_ctrl.scm ================================================================== --- cgisetup/pages/home_ctrl.scm +++ cgisetup/pages/home_ctrl.scm @@ -25,7 +25,16 @@ (string-intersperse row-or-col ",") row-or-col)) (s:set! "target-type" target-type) (s:set! "tfilter" target-filter) (s:set! "target" target) - (s:set! "target-filter" target-filter))))) + (s:set! "target-filter" target-filter))) +((filter2) + (let ((tslice-select (s:get-input 'tslice-select)) + (t-slice-filter (s:get-input 't-slice-filter))) + ;; + ;; s:set! is a page local var. Better than s:session-var-set! but still not a good idea. + ;; + (s:set! "tslice" tslice-select) + (s:set! "t-slice-patt" t-slice-filter))) +)) Index: cgisetup/pages/home_view.scm ================================================================== --- cgisetup/pages/home_view.scm +++ cgisetup/pages/home_view.scm @@ -11,33 +11,99 @@ (define (pages:home session db shared) (let* ((dbh (s:db)) (ttypes (pgdb:get-target-types dbh)) (selected (string->number (or (s:get "target-type") "-1"))) + (target-slice (pgdb:get-distict-target-slice dbh)) + (selected-slice (or (s:get "tslice") "")) (curr-trec (filter (lambda (x)(eq? selected (vector-ref x 0))) ttypes)) (curr-ttype (if (and selected (not (null? curr-trec))) (vector-ref (car curr-trec) 1) #f)) (all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '())) (tfilter (or (s:get "target-filter") "%")) + (tslice-filter (or (s:get "t-slice-patt") "")) + (target-patt (if (or (equal? selected-slice "") (equal? tslice-filter "" )) + "" + (conc selected-slice "/" tslice-filter ))) + (tab2-data (if (equal? target-patt "") + `() + (pgdb:get-all-run-stats-target-slice dbh target-patt))) + (tab2-ordered-data (pgdb:coalesce-runs-by-slice tab2-data selected-slice)) (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:get "row-or-col") "") ",")) (all-data (if (and selected (not (eq? selected -1))) - (pgdb:get-stats-given-type-target dbh selected tfilter) - (pgdb:get-stats-given-target dbh tfilter) + (pgdb:get-latest-run-stats-given-target dbh selected tfilter) + '() + ; (pgdb:get-stats-given-type-target dbh selected tfilter) + ; (pgdb:get-stats-given-target dbh tfilter) )) - ;; (all-data (pgdb:get-tests dbh tfilter)) - (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) - - (s:div 'class "col_12" - (s:fieldset - "Area type and target filter" + (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) + (s:div 'class "col_12" + (s:ul 'class "tabs left" + (s:li (s:a 'href "#tabr1" "Sliced Filter")) + (s:li (s:a 'href "#tabr2" "Genral Filter"))) + (s:div 'id "tabr1" 'class "tab-content" + (s:div 'class "col_11" + (s:fieldset "Filter Targets by slice" + (s:form + 'action "home.filter2" 'method "post" + (s:div 'class "col_12" + (s:div 'class "col_6" + (s:select (map (lambda (x) + (let ((t-slice (vector-ref x 0))) + (if (equal? t-slice selected-slice) + (list t-slice t-slice t-slice #t) + (list t-slice t-slice t-slice #f)))) + target-slice) + 'name 'tslice-select)) + (s:div 'class "col_4" + (s:input-preserve 'name "t-slice-filter" 'placeholder "Filter remainder target")) + (s:div 'class "col_2" + (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) + (s:br) + (s:p "  Result Format:   total / pass / fail / other") + (s:fieldset (conc "Runs data for " target-patt) + (let* ((target-keys (hash-table-keys tab2-ordered-data)) + (run-keys (delete-duplicates (apply append (map (lambda (sub-key) + (let ((subdat (hash-table-ref tab2-ordered-data sub-key))) + (hash-table-keys subdat))) + target-keys))))) + (s:table 'class "striped" + (s:tr (s:th 'class "heading" ) + (map + (lambda (th-key) + (s:th 'class "heading" th-key )) + run-keys)) + (map + (lambda (row-key) + (s:tr (s:td row-key) + (map + (lambda (col-key) + (let ((val (let* ((ht (hash-table-ref/default tab2-ordered-data row-key #f))) + (if ht (hash-table-ref/default ht col-key #f))))) + (if val + (let* ((total (vector-ref val 3)) + (pass (vector-ref val 4)) + (fail (vector-ref val 5)) + (other (vector-ref val 6)) + (passper (round (* (/ pass total) 100))) + (target-param (string-substitute "[/]" "_x_" (conc selected-slice "/" row-key) 'all))) + (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") + (s:a 'class "white" 'href (s:link-to "run" 'target target-param 'run col-key) +(conc total "/" pass "/" fail "/" other)))) + (s:td "")))) + run-keys))) + target-keys)) +)) +)) + (s:div 'id "tabr2" 'class "tab-content" + (s:div 'class "col_11" + (s:fieldset "Area type and target filter" (s:form - 'action "home.filter" 'method "post" + 'action "home.filter#tabr2" 'method "post" (s:div 'class "col_12" (s:div 'class "col_6" (s:select (map (lambda (x) (if x (let ((tt-id (vector-ref x 0)) @@ -49,41 +115,23 @@ (cons #f ttypes)) 'name 'target-type)) (s:div 'class "col_4" (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")) (s:div 'class "col_2" - (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))) - ;; 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:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) (s:br) (s:p "  Result Format:   total / pass / fail / other") - - (s:fieldset - (conc "Runs data for " tfilter) + (s:fieldset (conc "Runs data for " tfilter) ;; ;; A very basic display ;; (let* ((a-keys (pgdb:ordered-data->a-keys ordered-data)) (b-keys (pgdb:ordered-data->b-keys ordered-data a-keys))) ;; (c-keys (delete-duplicates b-keys))) (if #f ;; swap rows/cols (s:table - (s:tr (s:td "")(map s:tr b-keys)) + (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 @@ -92,13 +140,16 @@ (s:td (if dat (list (vector-ref dat 0)(vector-ref dat 1)) ""))))) b-keys)))) a-keys)) - - (s:table - (s:tr (s:td "")(map s:td a-keys)) + (s:table 'class "striped" + (s:tr (s:th 'class "heading" ) + (map + (lambda (th-key) + (s:th 'class "heading" th-key )) + a-keys)) (map (lambda (row-key) (s:tr (s:td row-key) (map (lambda (col-key) @@ -107,19 +158,44 @@ (if val (let* ((total (vector-ref val 1)) (pass (vector-ref val 2)) (fail (vector-ref val 3)) (other (vector-ref val 4)) + (id (vector-ref val 5)) (passper (round (* (/ pass total) 100))) (failper (- 100 passper)) - (run-key ;; (string-substitute ;; %2F = / - ;; "-" "%2D" - ;;(string-substitute "/" "%2F" (conc col-key "/" row-key) 'all) - (string-substitute "[/]" "_x_" (conc col-key "/" row-key) 'all) - ;; 'all))) - )) + (history (pgdb:get-run-stats-history-given-target dbh selected (conc col-key "/" row-key))) + (history-hash (pgdb:get-history-hash history)) + (history-keys (sort (hash-table-keys history-hash) string>=?)) + (run-key (string-substitute "[/]" "_x_" (conc col-key "/" row-key) 'all))) (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") - (s:a 'href (s:link-to "run" 'target run-key) - (conc total "/" pass "/" fail "/" other)))) + (s:a 'class "white" 'href (s:link-to "run" 'target run-key) + (conc "Latest:" total "/" pass "/" fail "/" other)) (s:span " | ") (s:a 'id id 'class "viewmodal" 'title "Click to see description" "History") (s:br) + (s:div 'id (conc "myModal" id) 'class "modal" + (s:div 'class "modal-content" + (s:span 'id id 'class "close" "×") + ;(s:p (conc "Modal " id "..")) + (s:div + (s:table + (s:tr + (s:th "Runame") + (s:th "Result") + ) + (map + (lambda (history-key) + (let* ((history-row (hash-table-ref/default history-hash history-key #f)) + (htotal (vector-ref history-row 1)) + (hpass (vector-ref history-row 2)) + (hfail (vector-ref history-row 3)) + (hother (vector-ref history-row 4)) + (passper (round (* (/ hpass htotal) 100)))) + (s:tr (s:td history-key) + (s:td 'style (conc "background: -webkit-linear-gradient(left, green " passper "%, red); background: -o-linear-gradient(right, green " passper "%, red); background: -moz-linear-gradient(right, green " passper "%, red); background: linear-gradient(to right, green " passper "%, red);") +(conc htotal "/" hpass "/" hfail "/" hother ))))) + history-keys))) + +)) + )) (s:td "")))) a-keys))) - b-keys)))))))) + b-keys))))))) +))) Index: cgisetup/pages/index_ctrl.scm ================================================================== --- cgisetup/pages/index_ctrl.scm +++ cgisetup/pages/index_ctrl.scm @@ -26,17 +26,25 @@ + EOF ) @@ -56,8 +64,9 @@ (define index:javascript #< + EOF ) Index: cgisetup/pages/run_view.scm ================================================================== --- cgisetup/pages/run_view.scm +++ cgisetup/pages/run_view.scm @@ -15,12 +15,13 @@ (s:get "target") (s:get-param 'target))) (target (if (equal? target1 #f) "%" (string-substitute "_x_" "/" target1 'all) - )) - (run-filter (or (s:get "run-name-filter") "%")) + )) + + (run-filter (or (or (s:get "run-name-filter") (s:get-param 'run)) "%")) (runs (pgdb:get-runs-by-target dbh target run-filter)) (ordered-runs (pgdb:runs-to-hash runs))) (s:div 'class "col_12" (s:fieldset @@ -64,11 +65,11 @@ (test-id (vector-ref val 4)) (bg (if (equal? result "PASS") "green" "red"))) (s:td 'style (conc "background: " bg ) - (s:a 'href (s:link-to "log" 'testid test-id) + (s:a 'class "white" 'href (s:link-to "log" 'testid test-id) result))) (s:td "")))) a-keys))) b-keys)))))))