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 Side-by-Side 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

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

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

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

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    (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
     "<!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))
       ;; (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

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: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
		      ;;
		      (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
		       (map
			(lambda (key)
			  (let ((subdat (hash-table-ref ordered-data key)))
			    (s:tr (s:td key)
				  (map
				   (lambda (remkey)
			    (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 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: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.108s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00