| ︙ | | |
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
-
+
|
(append tmptests prev-tests))
(lambda (a b)
(eq? (db:test-get-id a)(db:test-get-id b)))))))
(if (eq? *tests-sort-reverse* 3) ;; +event_time
(sort newdat dboard:compare-tests)
newdat))))
(vector-set! prev-dat 3 (- (current-seconds) 2)) ;; go back two seconds in time to ensure all changes are captured.
;; (debug:print 0 #f "(dboard:get-tests-for-run-duplicate: filters-changed=" (d:alldat-filters-changed data) " last-update=" last-update " got " (length tmptests) " test records for run " run-id)
;; (debug:print 0 *default-log-port* "(dboard:get-tests-for-run-duplicate: filters-changed=" (d:alldat-filters-changed data) " last-update=" last-update " got " (length tmptests) " test records for run " run-id)
tests))
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat data runnamepatt numruns testnamepatt keypatts)
(let* ((referenced-run-ids '())
(allruns (if (d:alldat-useserver data)
|
| ︙ | | |
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
-
+
|
(key-vals (if (d:alldat-useserver data)
(rmt:get-key-vals run-id)
(db:get-key-vals (d:alldat-dblocal data) run-id)))
(tests (dboard:get-tests-for-run-duplicate data run-id run testnamepatt key-vals)))
;; NOTE: bubble-up also sets the global (d:alldat-item-test-names data)
;; (tests (bubble-up tmptests priority: bubble-type))
;; NOTE: 11/01/2013 This routine is *NOT* getting called excessively.
;; (debug:print 0 #f "Getting data for run " run-id " with key-vals=" key-vals)
;; (debug:print 0 *default-log-port* "Getting data for run " run-id " with key-vals=" key-vals)
;; Not sure this is needed?
(if (not (null? tests))
(begin
(set! referenced-run-ids (cons run-id referenced-run-ids))
(if (> (length tests) maxtests)
(set! maxtests (length tests)))
(if (or (not (d:alldat-hide-empty-runs data)) ;; this reduces the data burden when set
|
| ︙ | | |
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
|
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
|
-
+
|
#f #f
"id,testname,item_path,state,status"
(if (d:alldat-filters-changed data)
0
last-update)
*dashboard-mode*))
'()))) ;; get 'em all
(debug:print 0 #f "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(sort tdat (lambda (a b)
(let* ((aval (vector-ref a 2))
(bval (vector-ref b 2))
(anum (string->number aval))
(bnum (string->number bval)))
(if (and anum bnum)
(< anum bnum)
|
| ︙ | | |
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
|
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
|
-
+
|
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id ddata (cdr run-path))))
(if (number? run-id)
(begin
(d:data-curr-run-id-set! ddata run-id)
(dashboard:update-run-summary-tab))
(debug:print 0 #f "ERROR: tree-path->run-id returned non-number " run-id)))
(debug:print 0 *default-log-port* "ERROR: tree-path->run-id returned non-number " run-id)))
;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
)))
(cell-lookup (make-hash-table))
(run-matrix (iup:matrix
#:expand "YES"
#:click-cb
(lambda (obj lin col status)
|
| ︙ | | |
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
|
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
|
-
+
|
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id ddata (cdr run-path))))
(if (number? run-id)
(begin
(d:data-curr-run-id-set! ddata run-id)
(dashboard:update-new-view-tab))
(debug:print 0 #f "ERROR: tree-path->run-id returned non-number " run-id)))
(debug:print 0 *default-log-port* "ERROR: tree-path->run-id returned non-number " run-id)))
;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
)))
(cell-lookup (make-hash-table))
(run-matrix (iup:matrix
#:expand "YES"
#:click-cb
(lambda (obj lin col status)
|
| ︙ | | |
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
|
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
|
-
+
|
(map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
(iup:valuator #:valuechanged_cb (lambda (obj)
(let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10))))
(oldmax (string->number (iup:attribute obj "MAX")))
(maxruns (d:alldat-tot-runs data)))
(d:alldat-start-run-offset-set! data val)
(mark-for-update)
(debug:print 6 #f "(d:alldat-start-run-offset data) " (d:alldat-start-run-offset data) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
(debug:print 6 *default-log-port* "(d:alldat-start-run-offset data) " (d:alldat-start-run-offset data) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
(iup:attribute-set! obj "MAX" (* maxruns 10))))
#:expand "HORIZONTAL"
#:max (* 10 (length (d:alldat-allruns data)))
#:min 0
#:step 0.01)))
;(iup:button "inc rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (+ (d:alldat-num-tests data) 1))))
;(iup:button "dec rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (if (> (d:alldat-num-tests data) 0)(- (d:alldat-num-tests data) 1) 0))))
|
| ︙ | | |
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
|
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
|
-
+
|
(set! lftlst (append lftlst (list (iup:hbox #:expand "HORIZONTAL"
(iup:valuator #:valuechanged_cb (lambda (obj)
(let ((val (string->number (iup:attribute obj "VALUE")))
(oldmax (string->number (iup:attribute obj "MAX")))
(newmax (* 10 (length *alltestnamelst*))))
(d:alldat-please-update-set! data #t)
(d:alldat-start-test-offset-set! *alldat* (inexact->exact (round (/ val 10))))
(debug:print 6 #f "(d:alldat-start-test-offset *alldat*) " (d:alldat-start-test-offset *alldat*) " val: " val " newmax: " newmax " oldmax: " oldmax)
(debug:print 6 *default-log-port* "(d:alldat-start-test-offset *alldat*) " (d:alldat-start-test-offset *alldat*) " val: " val " newmax: " newmax " oldmax: " oldmax)
(if (< val 10)
(iup:attribute-set! obj "MAX" newmax))
))
#:expand "VERTICAL"
#:orientation "VERTICAL"
#:min 0
#:step 0.01)
|
| ︙ | | |
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
|
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
|
-
+
|
;; Force creation of the db in case it isn't already there.
(tasks:open-db)
(define (dashboard:get-youngest-run-db-mod-time)
(handle-exceptions
exn
(begin
(debug:print 0 #f "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
(current-seconds)) ;; something went wrong - just print an error and return current-seconds
(apply max (map (lambda (filen)
(file-modification-time filen))
(glob (conc (d:alldat-dbdir *alldat*) "/*.db"))))))
(define (dashboard:run-update x)
(let* ((modtime (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time (d:alldat-dbfpath *alldat*)))
|
| ︙ | | |
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
|
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
|
-
+
|
(run-id (car dat))
(test-id (cadr dat)))
(if (and (number? run-id)
(number? test-id)
(>= test-id 0))
(examine-test run-id test-id)
(begin
(debug:print 3 #f "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
(debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
(exit 1)))))
((args:get-arg "-guimonitor")
(gui-monitor (d:alldat-dblocal data)))
(else
(set! uidat (make-dashboard-buttons data ;; (d:alldat-dblocal data)
(d:alldat-numruns data)
(d:alldat-num-tests data)
|
| ︙ | | |