Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -199,24 +199,92 @@ 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) +(define (pgdb:get-latest-run-stats-given-target dbh ttype-id target-patt limit offset) (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, + "SELECT r.target, 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, 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)) + (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 + order by r.event_time desc limit ? offset ? ;" + ttype-id target-patt target-patt ttype-id limit offset)) + +(define (pgdb:get-latest-run-stats-given-pattern dbh patt limit offset) + (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, 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, r.id + FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + WHERE t.state like '%' AND r.target LIKE ? + and r.id in + (SELECT DISTINCT on (target) id from runs where target like ? order by target,event_time desc) + GROUP BY r.target,r.id + order by r.event_time desc limit ? offset ? ;" + patt patt limit offset)) + + +(define (pgdb:get-count-data-stats-target-latest dbh ttype-id target-patt) + (dbi:get-rows + dbh + "SELECT count(*) from + (SELECT DISTINCT on (target) id + from runs where target like ? AND ttype_id = ? + order by target, event_time desc + ) as x;" + target-patt ttype-id)) + +(define (pgdb:get-latest-run-cnt dbh ttype-id target-patt) + (let* ((cnt-result (pgdb:get-count-data-stats-target-latest dbh ttype-id target-patt)) + ;(cnt-row (car (cnt-result))) + (cnt 0) + ) + (for-each + (lambda (row) + (set! cnt (vector-ref row 0 ))) + cnt-result) + +cnt)) + +(define (pgdb:get-count-data-stats-latest-pattern dbh patt) + (dbi:get-rows + dbh + "SELECT count(*) from + (SELECT DISTINCT on (target) id + from runs where target like ? + order by target, event_time desc + ) as x;" + patt)) + +(define (pgdb:get-latest-run-cnt-by-pattern dbh target-patt) + (let* ((cnt-result (pgdb:get-count-data-stats-latest-pattern dbh target-patt)) + ;(cnt-row (car (cnt-result))) + (cnt 0) + ) + (for-each + (lambda (row) + (set! cnt (vector-ref row 0 ))) + cnt-result) + +cnt)) + + + + (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 @@ -271,11 +339,12 @@ (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-distict-target-slice3 dbh) + (dbi:get-rows dbh " select distinct on (split_part (target, '/', 3)) (split_part (target, '/', 3)) from runs;")) ;; (define (pgdb:get-targets dbh target-patt) (let ((ttypes (pgdb:get-target-types dbh))) (map (lambda (ttype-dat) @@ -311,18 +380,49 @@ ;; using row-or-col to choose row or column ;; ht{row key}=>ht{col key}=>data ;; ;; fnum is the field number in the tuples to be split ;; + +(define (pgdb:mk-pattern dot type bp rel) + (let* ((typ (if (equal? type "all") + "%" + type)) + (dotprocess (if (equal? dot "all") + "%" + dot)) + (rel-num (if (equal? rel "") + "%" + rel)) + (pattern (conc "%/" bp "/" dotprocess "/" typ "_" rel-num))) +pattern)) + (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 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))) + (hash-table-set! data first newht) + (set! coldat newht))) + (hash-table-set! coldat rest run))) + runs) + data)) + + +(define (pgdb:coalesce-runs1 runs ) + (let* ((data (make-hash-table))) + + (for-each + (lambda (run) + (let* ((target (vector-ref run 0)) + (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))) (hash-table-set! data first newht) Index: cgisetup/pages/home.scm ================================================================== --- cgisetup/pages/home.scm +++ cgisetup/pages/home.scm @@ -9,8 +9,9 @@ ;; PURPOSE. ;;====================================================================== (use regex) (load "models/pgdb.scm") +(include "pages/filter-defs.scm") (include "pages/home_ctrl.scm") (include "pages/home_view.scm") Index: cgisetup/pages/home_ctrl.scm ================================================================== --- cgisetup/pages/home_ctrl.scm +++ cgisetup/pages/home_ctrl.scm @@ -12,33 +12,19 @@ ;; a function -action is called on POST (define (home-action action) (case (string->symbol action) ((filter) - (let ((target-type (s:get-input 'target-type)) - (target-filter (s:get-input 'tfilter)) - (target (s:get-input 'target)) - (row-or-col (s:get-input 'row-or-col))) - ;; - ;; s:set! is a page local var. Better than s:session-var-set! but still not a good idea. - ;; - (s:set! "row-or-col" (if (list? row-or-col) - (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) - )) -((filter2) - (let ((tslice-select (s:get-input 'tslice-select)) - (page (s:get-input 'page)) - (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! "var" "xyz") - (s:set! "tslice" tslice-select) - (s:set! "page" page) - (s:set! "t-slice-patt" t-slice-filter))) -)) + (let ((dot (s:get-input 'dot)) + (type (s:get-input 'kit-type)) + (rel (s:get-input 'rel-num)) + (bp (s:get-input 'bp))) + ;; + ;; s:set! is a page local var. Better than s:session-var-set! but still not a good idea. + ;; + + (s:set! "dot" dot) + (s:set! "type" type) + (s:set! "bp" bp) + + (s:set! "rel" rel))))) Index: cgisetup/pages/home_view.scm ================================================================== --- cgisetup/pages/home_view.scm +++ cgisetup/pages/home_view.scm @@ -8,173 +8,90 @@ ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (define (pages:home session db shared) - (let* ((dbh (s:db)) - (tab2-limit 15) - (tab2-page (if (or (equal? (s:get-param "page") "") (equal? (s:get-param "page") #f)) - 1 - (string->number (s:get-param "page")))) - - (tab2-offset (- (* tab2-limit tab2-page) tab2-limit)) - (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 (if (s:get "tslice") - (s:get "tslice") - (if (s:get-param "tslice") - (s:get-param "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 (if (s:get "t-slice-patt") - (s:get "t-slice-patt") - (if (s:get-param "patt") - (string-substitute "x_x" "%" (s:get-param "patt") 'all) - "%") - )) - (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-limit tab2-offset))) - (tab2-cnt (if (equal? target-patt "") - 0 - (pgdb:get-slice-cnt dbh target-patt))) - - (tab2-pages (round (/ tab2-cnt tab2-limit))) - (tab2-page-lst (pgdb:get-pg-lst tab2-pages)) - - (tab2-ordered-data (pgdb:coalesce-runs-by-slice tab2-data selected-slice)) - - (targets (pgdb:get-targets-of-type dbh selected tfilter)) - (row-or-col (string-split (or (s:get "row-or-col") "") ",")) - (all-data (if (and selected - (not (eq? selected -1))) - (pgdb:get-latest-run-stats-given-target dbh selected tfilter) - '() + + (let* ((dbh (s:db)) + (limit 50) + (curr-page (if (or (equal? (s:get-param "pg") "") (equal? (s:get-param "pg") #f)) + 1 + (string->number (s:get-param "pg")))) + + (offset (- (* limit curr-page) limit)) + (dot (if (s:get-param "dot") + (string->number (s:get-param "dot")) + (if (and (s:get "dot") (not (equal? (s:get "dot") "all"))) + (string->number (s:get "dot")) + "all"))) + (type (if (s:get-param "type") + (s:get-param "type") + (if (and (s:get "type") (not (equal? (s:get "type") "all"))) + (s:get "type") + "all"))) + (bp (if (s:get-param "bp") + (s:get-param "bp") + (if (s:get "bp") + (s:get "bp") + "p1273"))) + (rel (if (s:get-param "rel") + (s:get-param "rel") + (if (and (s:get "rel") (not (equal? (s:get "rel") "all"))) + (s:get "rel") + ""))) + (pattern (pgdb:mk-pattern dot type bp rel)) + ; (targets (pgdb:get-targets-of-type dbh selected tfilter)) + + (all-data (pgdb:get-latest-run-stats-given-pattern dbh pattern limit offset)) + ;'() ) ; (pgdb:get-stats-given-type-target dbh selected tfilter) ; (pgdb:get-stats-given-target dbh tfilter) - )) - (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) + + (cnt (pgdb:get-latest-run-cnt-by-pattern dbh pattern)) + (total-pages (ceiling (/ cnt limit))) + (page-lst (pgdb:get-pg-lst total-pages)) + (ordered-data (pgdb:coalesce-runs1 all-data))) (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" 'name "form1" - (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 'type "text" 'name "t-slice-filter" 'value tslice-filter)) - (s:div 'class "col_2" - (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) - (s:br) - ; (s:p (conc tslice-filter selected-slice tab2-page)) - (s:p (map - (lambda (i) - (s:span (s:a 'href (s:link-to "home" 'page i 'patt (string-substitute "%" "x_x" tslice-filter 'all) 'tslice selected-slice) "PAGE " i )" | ")) - tab2-page-lst)) - - (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" + (map (lambda (x) + (s:li (s:a 'href (conc "#" x) x))) + *process*)) + (map (lambda (x) + + (s:div 'id x 'class "tab-content" (s:div 'class "col_11" (s:fieldset "Area type and target filter" (s:form - 'action "home.filter#tabr2" 'method "post" + 'action (conc "home.filter#" x) '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)) - (ttype (vector-ref x 1))) - (if (eq? tt-id selected) - (list ttype tt-id ttype #t) - (list ttype tt-id ttype #f))) - (list "all" -1 "all" (eq? selected -1)))) - (cons #f ttypes)) - 'name 'target-type)) - (s:div 'class "col_4" - (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")) + (s:div 'class "col_3" + (s:label "Release Type") (s:select (map (lambda (x) + (list x )) + *kit-types*) + 'name "kit-type")) + (s:div 'class "col_3" + (s:label "Dot") (s:select (map (lambda (x) + (list x )) + *dots*) + 'name "dot")) + + (s:div 'class "col_3" + (s:input 'type "hidden" 'value x 'name "bp") + (s:label "Release #") (s:input 'list "suggestions" 'name "rel-num")) (s:div 'class "col_2" (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))))) - (s:br) + (s:br) + ; (s:p (conc bp (s:get-param "bp") (s:get "bp"))) + (s:p (map + (lambda (i) + (s:span (s:a 'href (s:link-to "home" 'pg i ) "PAGE " i )" | ")) + page-lst)) (s:p "  Result Format:   total / pass / fail / other") - (s:fieldset (conc "Runs data for " tfilter) - ;; - ;; A very basic display - ;; - (let* ((a-keys (pgdb:ordered-data->a-keys ordered-data)) + (s:fieldset (conc "Runs data for " pattern) + (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)) - (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 0)(vector-ref dat 1)) - ""))))) - b-keys)))) - a-keys)) - (s:table 'class "striped" + (s:table 'class "striped" (s:tr (s:th 'class "heading" ) (map (lambda (th-key) (s:th 'class "heading" th-key )) a-keys)) @@ -184,24 +101,25 @@ (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)) - (id (vector-ref val 5)) + (let* ((total (vector-ref val 2)) + (event-time (vector-ref val 1)) + (pass (vector-ref val 3)) + (fail (vector-ref val 4)) + (other (vector-ref val 5)) + (id (vector-ref val 6)) (passper (round (* (/ pass total) 100))) (failper (- 100 passper)) - (history (pgdb:get-run-stats-history-given-target dbh selected (conc col-key "/" row-key))) + (history (pgdb:get-run-stats-history-given-target dbh 1 (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 '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) + (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 @@ -219,13 +137,11 @@ (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))) - -)) - )) + history-keys))))))) (s:td "")))) a-keys))) - b-keys))))))) + b-keys)))) ))) + *process*)))) Index: cgisetup/pages/index_view.scm ================================================================== --- cgisetup/pages/index_view.scm +++ cgisetup/pages/index_view.scm @@ -22,10 +22,17 @@ index:kickstart-junk ) (s:body (s:div 'class "grid flex" 'id "top_of_page" ;; add visible to columns to help visualize them e.g. "col_12 visible" + (s:ul 'class "menu" +(s:li (s:a 'href "" (s:i 'class "fa fa-inbox") "QA Summary") + (s:ul + (s:li (s:a 'href "/cgi-bin/megatest.sh/home" "Component Snapshot")) + (s:li (s:a 'href "/cgi-bin/megatest.sh/kitprogress" "Kit/Contour progress")) + ))) +;(s:li (s:a 'href (s:link-to "run" ) "Runs"))) (case (string->symbol page-name) ((index) (s:call "home")) (else (s:call page-name)))) index:jquery index:javascript