Megatest

Check-in [58256fbbe7]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Basic working display of runs data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 58256fbbe748a89bc09d4bed037e53c563e81e69
User & Date: matt on 2017-03-01 23:33:38
Other Links: branch diff | manifest | tags
Context
2017-03-03
06:10
Merged from v1.63 check-in: 64f440e2e1 user: matt tags: v1.64
2017-03-01
23:33
Basic working display of runs data check-in: 58256fbbe7 user: matt tags: v1.64
2017-02-28
23:44
Re-org'd some files and provided a skeleton cgi with some examples check-in: 6c5ce13b65 user: matt tags: v1.64
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified cgisetup/models/pgdb.scm from [0256fd6a9b] to [4312bc0643].

︙︙
165
166
167
168
169
170
171
172
173
174
175






176

177
178
179
180
181
182
183

  (dbi:get-rows
   dbh
   "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)
  (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))


(define (pgdb:get-target-types dbh)
  (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;"))

;; 
(define (pgdb:get-targets dbh target-patt)
  (let ((ttypes (pgdb:get-target-types dbh)))








|


|
>
>
>
>
>
>
|
>








165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190

  (dbi:get-rows
   dbh
   "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 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
            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;"))

;; 
(define (pgdb:get-targets dbh target-patt)
  (let ((ttypes (pgdb:get-target-types dbh)))
︙︙
201
202
203
204
205
206
207


208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224


;; probably want to move these to a different model file

;; 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)
  (let* ((data  (make-hash-table)))
    ;;	 (rnums (
    ;; for now just do first => remainder
    (for-each
     (lambda (run)
       (let* ((target (vector-ref run 2))
	      (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))








>
>
|





|











208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233


;; probably want to move these to a different model file

;; 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
;;
;; 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 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))

Modified cgisetup/pages/index_view.scm from [8e73b032f8] to [d888a50158].

︙︙
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

			  (vector-ref (car curr-trec) 1) #f))
	 (all-parts   (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '()))
	 (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    (pgdb:get-tests dbh tfilter))
	 (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col)))
    
    (list
     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
     (s:html
      (s:title (conc "Megatest")) 
      (s:head
       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))
       (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
		      "Area type and target filter"
		      (s:form








|
>

|











|








19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

			  (vector-ref (car curr-trec) 1) #f))
	 (all-parts   (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '()))
	 (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    (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 0)))
    
    (list
     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
     (s:html
      (s:title (conc "Megatest")) 
      (s:head
       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))
       (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
		      "Area type and target filter"
		      (s:form
︙︙
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78

79









80

81
82
83
84
85
86
87
88

89
90










91












92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

						     (list ttype tt-id ttype #f))))
					     ttypes)
					'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:fieldset
		      (conc "Runs data for " tfilter)
		      ;;
		      ;; This is completely wrong!!! However it may provide some ideas!

		      ;;









		      (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
		      ))))))))

  
		       ;; 	  (s:div 'class "col_12"
		       ;; 		 (s:div 'class "col_1" "row")
		       ;; 		 (map (lambda (target-var)
		       ;; 			(s:div 'class "col_1" (s:input 'type "radio" 'name target-var 'value "row")))
		       ;; 		      all-parts))








|
|
|
|
|
|
|
|
|
|
|
|
|
>



<
>

>
>
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
<
|
>
|
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|








56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

						     (list ttype tt-id ttype #f))))
					     ttypes)
					'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:fieldset
		      (conc "Runs data for " tfilter)
		      ;;

		      ;; A very basic display
		      ;;
		      (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)
		       ;; 			(s:div 'class "col_1" (s:input 'type "radio" 'name target-var 'value "row")))
		       ;; 		      all-parts))
︙︙

This page was generated in about 0.114s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00