Megatest

Check-in [3354a201a4]
Login
Overview
Comment:Cleaned up dup in rmt.scm. Part of gather data in dashboard
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi-area
Files: files | file ages | folders
SHA1: 3354a201a4f633559ecca67cae043b5e70f43f9e
User & Date: matt on 2015-04-12 23:58:17
Other Links: branch diff | manifest | tags
Context
2015-04-16
00:00
Working on unit tests check-in: 5770402337 user: matt tags: multi-area
2015-04-12
23:58
Cleaned up dup in rmt.scm. Part of gather data in dashboard check-in: 3354a201a4 user: matt tags: multi-area
21:03
Minor merge from v1.60 prior to more big changes: check-in: a72834e9cd user: matt tags: multi-area
Changes

Modified dashboard.scm from [fcc592dbea] to [5cc910be04].

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

;;======================================================================
;; T E S T S
;;======================================================================


;; Test browser
(define (tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))







|







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

;;======================================================================
;; T E S T S
;;======================================================================


;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3







|







212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310






311
312
313

314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; Main Panel
;;
(define (main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (let* ((apath      (configf:lookup (dboard:data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
				      ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
				      (area-dat   (dashboard:init-area data aname apath))
				      (tb         (tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
				      (ad         (area-display data area-dat window-id))
				      (areas      (dboard:data-areas data))
				      (dboard-dat (make-dboard:area 
						   #f           ;; tree
						   #f           ;; matrix
						   area-dat     ;;
						   #f           ;; view path
						   'default     ;; view type
						   #f           ;; matrix
						   #f           ;; controls
						   #f           ;; cached data
						   #f           ;; filters
						   #f           ;; the run-id
						   (make-hash-table) ;; run-id -> test-id, for current test id
						   ""
						   )))
				 (hash-table-set! (dboard:data-areas data) aname dboard-dat)
				 (dboard:area-tree-set!   dboard-dat tb)
				 (dboard:area-matrix-set! dboard-dat ad)
				 (iup:split
				  #:value 200
				  tb ad)))
			     area-names))
	   (tabtop      (apply iup:tabs area-panels)))






      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))

	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if







|










|
|

|





<








|
|




|
>
>
>
>
>
>



>
















|







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (let* ((apath      (configf:lookup (dboard:data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
				      ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
				      (area-dat   (dashboard:init-area data aname apath))
				      (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
				      (ad         (dashboard:area-display data area-dat window-id))
				      (areas      (dboard:data-areas data))
				      (dboard-dat (make-dboard:tab
						   #f           ;; tree
						   #f           ;; matrix
						   area-dat     ;;
						   #f           ;; view path
						   'default     ;; view type

						   #f           ;; controls
						   #f           ;; cached data
						   #f           ;; filters
						   #f           ;; the run-id
						   (make-hash-table) ;; run-id -> test-id, for current test id
						   ""
						   )))
				 (hash-table-set! (dboard:data-areas data) aname dboard-dat)
				 (dboard:tab-tree-set!   dboard-dat tb)
				 (dboard:tab-matrix-set! dboard-dat ad)
				 (iup:split
				  #:value 200
				  tb ad)))
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (dboard:data-current-tab-id-set! data curr)
						   (dboard:data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tab-ids     (dboard:data-tab-ids data)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(hash-table-set! tab-ids index hed)
	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
350
351
352
353
354
355
356
357



358
359
360
(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0 



		   )))
  (newdashboard data window-id)
  (iup:main-loop))







|
>
>
>



356
357
358
359
360
361
362
363
364
365
366
367
368
369
(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0                 ;; current window id
		   0                 ;; current tab id
		   #f                ;; redraw needed for current tab id
		   (make-hash-table) ;; tab-id -> areaname
		   )))
  (newdashboard data window-id)
  (iup:main-loop))

Modified dcommon.scm from [5d6b4a68c6] to [bceb20a8e4].

36
37
38
39
40
41
42
43
44
45



46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
;; 
;; A single data structure for all the data used in a dashboard for
;; all areas tracked.
;;


(define-record dboard:data
  cfgdat            ;; data from ~/.megatest/<group>.dat
  areas             ;; hash of areaname -> area-rec
  current-window-id



  )

(define-record dboard:area
  tree
  matrix
  area-dat  ;; the one-structure (one day dbstruct will be put in here)
  view-path ;; <target/path>/<runname>/...
  view-type ;; standard, etc.
  matrix    ;; the spreadsheet 
  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters 
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field
  )







|
|
|
>
>
>


|

|



<







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
;; 
;; A single data structure for all the data used in a dashboard for
;; all areas tracked.
;;


(define-record dboard:data
  cfgdat             ;; data from ~/.megatest/<group>.dat
  areas              ;; hash of areaname -> area-rec
  current-window-id  ;; 
  current-tab-id     ;; 
  update-needed      ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
  tab-ids            ;; hash of tab-id -> areaname
  )

(define-record dboard:tab
  tree
  matrix    ;; the spreadsheet 
  area-dat  ;; the one-structure (one day dbstruct will be put in here)
  view-path ;; <target/path>/<runname>/...
  view-type ;; standard, etc.

  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters 
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field
  )
145
146
147
148
149
150
151
152
153






154
155
156
157
158
159
160
161
162
163
164
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
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
;; TO-DO
;;  1. Make "data" hash-table hierarchial store of all displayed data
;;  2. Update synchash to understand "get-runs", "get-tests" etc.
;;  3. Add extraction of filters to synchash calls
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update data)
  (thread-sleep! 0.25))







;;  (let* (;; count and offset => #f so not used
;; 	 ;; the synchash calls modify the "data" hash
;; 	 (get-runs-sig    (conc (client:get-signature) " get-runs"))
;; 	 (get-tests-sig   (conc (client:get-signature) " get-tests"))
;; 	 (get-details-sig (conc (client:get-signature) " get-test-details"))
;; 
;; 	 ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
;; 	 (test-ids        (hash-table-values (dboard:data-get-curr-test-ids *data*)))
;; 	 ;; run-id is #f in next line to send the query to server 0
;;  	 (run-changes     (synchash:client-get *area-dat* 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
;; 	 (tests-detail-changes (if (not (null? test-ids))
;; 				   (synchash:client-get *area-dat* 'db:get-test-info-by-ids get-details-sig 0  data #f test-ids)
;; 				   '()))
;; 
;; 	 ;; Now can calculate the run-ids
;; 	 (run-hash    (hash-table-ref/default data get-runs-sig #f))
;; 	 (run-ids     (if run-hash (filter number? (hash-table-keys run-hash)) '()))



;; 
;; 	 (all-test-changes (let ((res (make-hash-table)))
;; 			     (for-each (lambda (run-id)
;; 					 (if (> run-id 0)
;; 					     (hash-table-set! res run-id (synchash:client-get *area-dat* 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
;; 				       run-ids)
;; 			     res))
;; 	 (runs-hash    (hash-table-ref/default data get-runs-sig #f))
;; 	 (header       (hash-table-ref/default runs-hash "header" #f))
;; 	 (run-ids      (sort (filter number? (hash-table-keys runs-hash))
;; 			     (lambda (a b)
;; 			       (let* ((record-a (hash-table-ref runs-hash a))
;; 				      (record-b (hash-table-ref runs-hash b))
;; 				      (time-a   (db:get-value-by-header record-a header "event_time"))
;; 				      (time-b   (db:get-value-by-header record-b header "event_time")))
;; 				 (> time-a time-b)))
;; 			     ))
;; 	 (runid-to-col    (hash-table-ref *cachedata* "runid-to-col"))
;; 	 (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) 
;; 	 (colnum       1)
;; 	 (rownum       0)) ;; rownum = 0 is the header
;; ;; (debug:print 0 "test-ids " test-ids ", tests-detail-changes " tests-detail-changes)
;;     
;; 	 ;; tests related stuff
;; 	 ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes))))
;; 
;;     ;; Given a run-id and testname/item_path calculate a cell R:C
;; 
;;     ;; NOTE: Also build the test tree browser and look up table
;;     ;;
;;     ;; Each run is unique on its keys and runname or run-id, store in hash on colnum
;;     (for-each (lambda (run-id)
;; 		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
;; 		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record header key))
;; 					keys))
;; 		       (run-name   (db:get-value-by-header run-record header "runname"))
;; 		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
;; 		       (run-path   (append key-vals (list run-name))))







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







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
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
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
;; TO-DO
;;  1. Make "data" hash-table hierarchial store of all displayed data
;;  2. Update synchash to understand "get-runs", "get-tests" etc.
;;  3. Add extraction of filters to synchash calls
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update data)
  (let* ((current-tab-id  (dboard:data-current-tab-id data))
	 (area-name       (hash-table-ref (dboard:data-tab-ids data) current-tab-id))
	 (tab-dat         (hash-table-ref (dboard:data-areas   data) area-name))
	 (matrix          (dboard:tab-matrix tab-dat))
	 (tree            (dboard:tab-tree   tab-dat))
	 (area-dat        (dboard:tab-area-dat tab-dat))
	 (runpatt         "%")) ;; get from dboard:tab-filters
    (if (dboard:data-update-needed data)
	(let* (;; count and offset => #f so not used
	       ;; the synchash calls modify the "data" hash
	       ;; (get-runs-sig    (conc (client:get-signature) " get-runs"))
	       ;; (get-tests-sig   (conc (client:get-signature) " get-tests"))
	       ;; (get-details-sig (conc (client:get-signature) " get-test-details"))
 
	       ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
	       ;; (test-ids        (hash-table-values (dboard:data-get-curr-test-ids *data*)))
	       ;; run-id is #f in next line to send the query to server 0
	       ;; (run-changes     (synchash:client-get *area-dat* 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
	       ;; (tests-detail-changes (if (not (null? test-ids))
	       ;;				 (synchash:client-get *area-dat* 'db:get-test-info-by-ids get-details-sig 0  data #f test-ids)
	       ;;				 '()))
 
	       ;; Now can calculate the run-ids
	       ;; (run-hash    (hash-table-ref/default data get-runs-sig #f))
	       ;; (run-ids     (if run-hash (filter number? (hash-table-keys run-hash)) '()))
	       (launch:setup-for-run area-dat)
	       (all-runs-dat   (rmt:get-runs runpatt #f #f '() area-dat)))
	  (print "all-runs-dat: " all-runs-dat)))))

	       ;; (all-test-changes (let ((res (make-hash-table)))
	       ;;  		       (for-each (lambda (run-id)
	       ;;  			            (if (> run-id 0)
	       ;;  				        (hash-table-set! res run-id (synchash:client-get *area-dat* 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
	       ;;  			                run-ids)
 	       ;;  	                          res))
	       ;; (runs-hash    (hash-table-ref/default data get-runs-sig #f))
	       ;; (header       (hash-table-ref/default runs-hash "header" #f))
	       ;; (run-ids      (sort (filter number? (hash-table-keys runs-hash))
	       ;;  		   (lambda (a b)
	       ;;  		     (let* ((record-a (hash-table-ref runs-hash a))
	       ;;  			    (record-b (hash-table-ref runs-hash b))
	       ;;  			    (time-a   (db:get-value-by-header record-a header "event_time"))
	       ;;  			    (time-b   (db:get-value-by-header record-b header "event_time")))
	       ;;  		       (> time-a time-b)))
	       ;;  		   ))
	       ;; (runid-to-col    (hash-table-ref *cachedata* "runid-to-col"))
	       ;; (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) 
	       ;; (colnum       1)
	       ;; (rownum       0)) ;; rownum = 0 is the header
	       ;; ;; (debug:print 0 "test-ids " test-ids ", tests-detail-changes " tests-detail-changes)
	       ;;     
	       ;; 	 ;; tests related stuff
	       ;; 	 ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes))))
	       ;; 
	       ;;     ;; Given a run-id and testname/item_path calculate a cell R:C
	       ;; 
	       ;;     ;; NOTE: Also build the test tree browser and look up table
	       ;;     ;;
	       ;;     ;; Each run is unique on its keys and runname or run-id, store in hash on colnum
;;     (for-each (lambda (run-id)
;; 		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
;; 		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record header key))
;; 					keys))
;; 		       (run-name   (db:get-value-by-header run-record header "runname"))
;; 		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
;; 		       (run-path   (append key-vals (list run-name))))

Modified rmt.scm from [2831eddb48] to [58944482bc].

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551

(define (rmt:delete-run run-id area-dat)
  (rmt:send-receive 'delete-run run-id (list run-id) area-dat))

(define (rmt:delete-old-deleted-test-records area-dat)
  (rmt:send-receive 'delete-old-deleted-test-records #f '() area-dat))

(define (rmt:get-runs runpatt count offset keypatts area-dat)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat))

(define (rmt:get-runs runpatt count offset keypatts area-dat)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat))

(define (rmt:get-all-run-ids area-dat)
  (rmt:send-receive 'get-all-run-ids #f '() area-dat))

(define (rmt:get-prev-run-ids run-id area-dat)







<
<
<







535
536
537
538
539
540
541



542
543
544
545
546
547
548

(define (rmt:delete-run run-id area-dat)
  (rmt:send-receive 'delete-run run-id (list run-id) area-dat))

(define (rmt:delete-old-deleted-test-records area-dat)
  (rmt:send-receive 'delete-old-deleted-test-records #f '() area-dat))




(define (rmt:get-runs runpatt count offset keypatts area-dat)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat))

(define (rmt:get-all-run-ids area-dat)
  (rmt:send-receive 'get-all-run-ids #f '() area-dat))

(define (rmt:get-prev-run-ids run-id area-dat)