| ︙ | | | ︙ | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(declare (uses ezsteps))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
>
>
>
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
(declare (uses sdb))
(declare (uses filedb))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
| ︙ | | | ︙ | |
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(db:test-get-status testdat))))
(iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
lbl)
(store-label "testcomment"
(iup:label "TestComment "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-comment testdat)))
(store-label "testid"
(iup:label "TestId "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-id testdat)))
(store-label "testdate"
(iup:label "TestDate "
|
|
|
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
(db:test-get-status testdat))))
(iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
lbl)
(store-label "testcomment"
(iup:label "TestComment "
#:expand "HORIZONTAL")
(lambda (testdat)
(sdb:qry 'getstr (db:test-get-comment testdat))))
(store-label "testid"
(iup:label "TestId "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-id testdat)))
(store-label "testdate"
(iup:label "TestDate "
|
| ︙ | | | ︙ | |
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
"Run duration: "
"Logfile: "))
(iup:label "" #:expand "VERTICAL")))
(apply iup:vbox ; #:expand "YES"
(list
;; NOTE: Yes, the host can change!
(store-label "HostName"
(iup:label (db:test-get-host testdat) #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-host testdat)))
(store-label "Uname"
(iup:label " " #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-uname testdat)))
(store-label "DiskFree"
(iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-diskfree testdat))))
(store-label "CPULoad"
(iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-cpuload testdat))))
(store-label "RunDuration"
|
|
|
|
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
"Run duration: "
"Logfile: "))
(iup:label "" #:expand "VERTICAL")))
(apply iup:vbox ; #:expand "YES"
(list
;; NOTE: Yes, the host can change!
(store-label "HostName"
(iup:label (sdb:qry 'getstr (db:test-get-host testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-host testdat)))
(store-label "Uname"
(iup:label " " #:expand "HORIZONTAL")
(lambda (testdat)(sdb:qry 'getstr (db:test-get-uname testdat))))
(store-label "DiskFree"
(iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-diskfree testdat))))
(store-label "CPULoad"
(iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL")
(lambda (testdat)(conc (db:test-get-cpuload testdat))))
(store-label "RunDuration"
|
| ︙ | | | ︙ | |
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
|
#f))
(string<? (conc time-a)(conc time-b)))))))))
;;======================================================================
;;
;;======================================================================
(define (examine-test test-id) ;; run-id run-key origtest)
(let* ((db-path (conc *toppath* "/megatest.db"))
(db (open-db))
(tdb (tdb:open-test-db-by-test-id-local test-id))
(testdat (db:get-test-info-by-id db test-id))
(db-mod-time 0) ;; (file-modification-time db-path))
(last-update 0) ;; (current-seconds))
(request-update #t))
(if (not testdat)
(begin
|
|
|
|
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
|
#f))
(string<? (conc time-a)(conc time-b)))))))))
;;======================================================================
;;
;;======================================================================
(define (examine-test test-id) ;; run-id run-key origtest)
(let* ((db-path (conc *toppath* "db/main.db"))
(db (make-dbr:dbstruct path: *toppath* local: #t))
(tdb (tdb:open-test-db-by-test-id-local test-id))
(testdat (db:get-test-info-by-id db test-id))
(db-mod-time 0) ;; (file-modification-time db-path))
(last-update 0) ;; (current-seconds))
(request-update #t))
(if (not testdat)
(begin
|
| ︙ | | | ︙ | |
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
(db:get-test-info-by-id db test-id )))))
;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (dashboard-tests:get-compressed-steps db test-id))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir (db:test-get-rundir testdat))
(set! testfullname (db:test-get-fullname testdat))
;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n "))
;; I don't see why this was implemented this way. Please comment it ...
;; (if (eq? curr-mod-time db-mod-time) ;; do only once if same
;; (set! db-mod-time (+ curr-mod-time 1))
;; (set! db-mod-time curr-mod-time))
|
|
|
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
|
(db:get-test-info-by-id db test-id )))))
;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (dashboard-tests:get-compressed-steps db test-id))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir (filedb:get-path *fdb* (db:test-get-rundir testdat)))
(set! testfullname (db:test-get-fullname testdat))
;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n "))
;; I don't see why this was implemented this way. Please comment it ...
;; (if (eq? curr-mod-time db-mod-time) ;; do only once if same
;; (set! db-mod-time (+ curr-mod-time 1))
;; (set! db-mod-time curr-mod-time))
|
| ︙ | | | ︙ | |