Megatest

Check-in [9b83825da5]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Remove *db-keys* as global. Fixed typo in common:simple-setup Changed hh:get to hh:get-value and hh:get-subhash Ripped out guts of Run Areas (derived from Run Summary) and put in some stubs. Primed dashboard.scm to use areas based dbstucts. The rmt: calls have not being eliminated yet. Disabled ro db handling in dashboard. Added tab for pivot controls. Added couple missing bits for the db:dashboard-open-db multi-area support. Tested and working now.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-areas-dashboard
Files: files | file ages | folders
SHA1: 9b83825da52aa91df4c199ee5d43fcd09d5c8fc6
User & Date: matt on 2017-08-13 23:07:18
Other Links: branch diff | manifest | tags
Context
2017-11-16
16:21
Deconstructing changes make for areas-dashboard to isolate catastrophic bug in fixme-matt Closed-Leaf check-in: 436bc0ac0f user: mrwellan tags: v1.64-areas-dashboard-bug-fix
2017-08-14
01:03
Partially removed global *db-cache-path* (might need to add it back for performance reasons, used in rmt: calls.) Modified common:get-db-tmp-area to get info from dbstruct instead of globals. Added proc to open area dbs Gutted dboard:areas-update-tree. Does only areas now. First pass on some refactoring in db:get-db, db:open-db, db:dbfile-path (these need to be reduced to one function). check-in: 37c6122258 user: matt tags: v1.64-areas-dashboard, fixme-matt
2017-08-13
23:07
Remove *db-keys* as global. Fixed typo in common:simple-setup Changed hh:get to hh:get-value and hh:get-subhash Ripped out guts of Run Areas (derived from Run Summary) and put in some stubs. Primed dashboard.scm to use areas based dbstucts. The rmt: calls have not being eliminated yet. Disabled ro db handling in dashboard. Added tab for pivot controls. Added couple missing bits for the db:dashboard-open-db multi-area support. Tested and working now. check-in: 9b83825da5 user: matt tags: v1.64-areas-dashboard
2017-08-09
23:24
Completed generalized open db proc given area. check-in: 79525ab1fe user: matt tags: v1.64-areas-dashboard
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [bc7da1c8f9] to [261f9da290].

︙
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111

97
98
99
100
101
102
103

104
105
106
107
108
109
110
111








-
+








;;         res))))
        
;; A hash table that can be accessed by #{scheme ...} calls in
;; config files. Allows communicating between confgs
;;
(define *user-hash-data* (make-hash-table))

(define *db-keys* #f)
;; (define *db-keys* #f)

(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f)   ;; run configs data
(define *configdat*    #f)   ;; megatest.config data
(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath*      #f)
(define *already-seen-runconfig-info* #f)
︙
1129
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143

1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143








-
+








		     mtconfigf
		     ;; environ-patt: "env-override"
		     given-toppath: toppath
		     ;; pathenvvar: "MT_RUN_AREA_HOME"
		     ))
	 (mtconf    (if mtconfdat (car mtconfdat) #f)))
    (if mtconf
	(configf:section-var-set! mtconf "dyndat" "toppath" start-dir))
	(configf:section-var-set! mtconf "dyndat" "toppath" toppath))
    mtconfdat))

;; do we honor the caches of the config files?
;;
(define (common:use-cache?)
  (let ((res #t)) ;; priority by order of evaluation
    (if *configdat* ;; sillyness here. can't use setup/use-cache to know if we can use the cached files!
︙
2396
2397
2398
2399
2400
2401
2402
2403

2404
2405
2406
2407
2408
2409
2410












2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430










2396
2397
2398
2399
2400
2401
2402

2403
2404
2405
2406
2407
2408
2409

2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440

2441
2442
2443
2444
2445
2446
2447
2448
2449








-
+






-
+
+
+
+
+
+
+
+
+
+
+
+



















-
+
+
+
+
+
+
+
+
+

(define-inline (hh:set-ht! hh ht)       (vector-set! hh 0 ht))
(define-inline (hh:get-ht hh)           (vector-ref  hh 0))
(define-inline (hh:set-value! hh value) (vector-set! hh 1 value))
(define-inline (hh:get-value  hh value) (vector-ref  hh 1))

;; given a hierarchial hash and some keys look up the value ...
;;
(define (hh:get hh . keys)
(define (hh:get-value hh . keys)
  (if (null? keys)
      (vector-ref hh 1) ;; we have reached the end of the line, return the value sought
      (let ((sub-ht (hh:get-ht hh)))
	(if sub-ht ;; yes, there is more hierarchy
	    (let ((sub-hh (hash-table-ref/default sub-ht (car keys) #f)))
	      (if sub-hh
		  (apply hh:get sub-hh (cdr keys))
		  (apply hh:get-value sub-hh (cdr keys))
		  #f))
	    #f))))

(define (hh:get-subhash hh . keys)
  (if (null? keys)
      (vector-ref hh 0) ;; we have reached the end of the line, return the value sought
      (let ((sub-ht (hh:get-ht hh)))
	(if sub-ht ;; yes, there is more hierarchy
	    (let ((sub-hh (hash-table-ref/default sub-ht (car keys) #f)))
	      (if sub-hh
		  (apply hh:get-subhash sub-hh (cdr keys))
		  #f))
	    #f))))

;; given a hierarchial hash, a value and some keys, add needed hierarcy and insert the value
;;
(define (hh:set! hh value . keys)
  (if (null? keys)
      (hh:set-value! hh value) ;; we have reached the end of the line, store the value
      (let ((sub-ht (hh:get-ht hh)))
	(if sub-ht ;; yes, there is more hierarchy
	    (let ((sub-hh (hash-table-ref/default sub-ht (car keys) #f)))
	      (if (not sub-hh) ;; we'll need to add the next level of hierarchy
		  (let ((new-sub-hh (hh:make-hh)))
		    (hash-table-set! sub-ht (car keys) new-sub-hh)
		    (apply hh:set! new-sub-hh value (cdr keys)))
		  (apply hh:set! sub-hh value (cdr keys))))    ;; call the sub-hierhash with remaining keys
	    (begin
	      (hh:set-ht! hh (make-hash-table))
	      (apply hh:set! hh value keys))))))
  

;; given a hierarchial hash and some keys, return the keys for that hash level
;;
(define (hh:get-keys hh . keys)
  (let ((ht (apply hh:get-subhash hh keys)))
    (if ht
	(hash-table-keys ht)
	'())))

Modified dashboard-areas.scm from [686be016f0] to [e946817510]. 

1
2
3
4
5






















6
7
8
9
10
11
12
13
14
15
16
17
18














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










49
50
51
52
53
54
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
111
112
113

































































114
115
116
117
118
119
120

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
49
50
51
52
53
54
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
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






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;;======================================================================
;; AREAS
;;======================================================================

(define (dashboard:areas-summary-updater commondat tabdat tb cell-lookup run-matrix)
  ;; maps data from tabdat view-dat to the matrix
  ;; if input databases have changed, refresh view-dat
  ;; if filters have changed, refresh view-dat from input databases
  ;; if pivots  have changed, refresh view-dat from input databases
  (let* ((runs-hash    (dashboard:areas-get-runs-hash tabdat))
	 (runs-header '("contour_name" "release" "iteration" "testsuite_mode" "id" "runname" "state" "status" "owner" "event_time"))
	 (tree-path    (dboard:tabdat-tree-path tabdat)))
    (dboard:areas-update-tree tabdat runs-hash runs-header tb)
    (print "Tree path: " tree-path)
    (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
    (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
    (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")

    ;; (if (> max-col (string->number (iup:attribute run-matrix "NUMCOL")))
    (iup:attribute-set! run-matrix "NUMCOL" 10) ;; max-col ))
   
    ;; (let ((effective-max-row (if (< max-row max-visible) max-visible max-row)))
    ;; (if (> effective-max-row (string->number (iup:attribute run-matrix "NUMLIN")))
    (iup:attribute-set! run-matrix "NUMLIN" 10) ;; effective-max-row )))
    (iup:attribute-set! run-matrix "1:1" (conc tree-path))
    (iup:attribute-set! run-matrix "REDRAW" "ALL")))
  
  (dashboard:areas-do-update-rundat tabdat) ;; )
  (dboard:areas-summary-control-panel-updater tabdat)
  (let* ((last-runs-update  (dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (mrmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
         (runs         (vector-ref runs-dat 1))
	 (run-id       (dboard:tabdat-curr-run-id tabdat))
         (runs-hash (dashboard:areas-get-runs-hash tabdat))
         ;; (runs-hash    (let ((ht (make-hash-table)))
	 ;;        	 (for-each (lambda (run)
	 ;;        		     (hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
	 ;;        		   runs)
	 ;;        	 ht))
  ;; (dashboard:areas-do-update-rundat tabdat) ;; )
  ;; (dboard:areas-summary-control-panel-updater tabdat)
  ;; (let* ((last-runs-update  (dboard:tabdat-last-runs-update tabdat))
  ;; 	 (runs-dat     (mrmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
  ;; 	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
  ;;        (runs         (vector-ref runs-dat 1))
  ;; 	 (run-id       (dboard:tabdat-curr-run-id tabdat))
  ;;        (runs-hash (dashboard:areas-get-runs-hash tabdat))
  ;;        ;; (runs-hash    (let ((ht (make-hash-table)))
  ;; 	 ;;        	 (for-each (lambda (run)
  ;; 	 ;;        		     (hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
  ;; 	 ;;        		   runs)
  ;; 	 ;;        	 ht))
  ;;        )
         )
    (if (dashboard:areas-database-changed? commondat tabdat context-key: 'runs-summary-tree)
        (dboard:areas-update-tree tabdat runs-hash runs-header tb))
    (if run-id
        (let* ((matrix-content
                (case (dboard:tabdat-runs-summary-mode tabdat) 
                  ((one-run) (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash))
                  ((xor-two-runs) (dashboard:areas-runs-summary-xor-matrix-content tabdat runs-hash))
                  ((xor-two-runs-hide-clean) (dashboard:areas-runs-summary-xor-matrix-content tabdat runs-hash hide-clean: #t))
                  (else (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)))))
          (when matrix-content
            (let* ((indices      (common:sparse-list-generate-index matrix-content)) ;;  proc: set-cell))
                   (row-indices  (cadr indices))
                   (col-indices  (car indices))
                   (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
                   (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
                   (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
                   (numrows      1)
                   (numcols      1)
                   (changed      #f)
  ;;   (if (dashboard:areas-database-changed? commondat tabdat context-key: 'runs-summary-tree)
  ;;       (dboard:areas-update-tree tabdat runs-hash runs-header tb))
  ;;   (if run-id
  ;;       (let* ((matrix-content
  ;;               (case (dboard:tabdat-runs-summary-mode tabdat) 
  ;;                 ((one-run) (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash))
  ;;                 ((xor-two-runs) (dashboard:areas-runs-summary-xor-matrix-content tabdat runs-hash))
  ;;                 ((xor-two-runs-hide-clean) (dashboard:areas-runs-summary-xor-matrix-content tabdat runs-hash hide-clean: #t))
  ;;                 (else (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)))))
  ;;         (when matrix-content
  ;;           (let* ((indices      (common:sparse-list-generate-index matrix-content)) ;;  proc: set-cell))
  ;;                  (row-indices  (cadr indices))
  ;;                  (col-indices  (car indices))
  ;;                  (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
  ;;                  (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
  ;;                  (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
  ;;                  (numrows      1)
  ;;                  (numcols      1)
  ;;                  (changed      #f)
                   )
              
              (dboard:tabdat-filters-changed-set! tabdat #f)
              (let loop ((pass-num 0)
                         (changed  #f))
                (if (eq? pass-num 1)
                    (begin ;; big reset
                      (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
                      (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
                      (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")))
  ;;                  )
  ;;             
  ;;             (dboard:tabdat-filters-changed-set! tabdat #f)
  ;;             (let loop ((pass-num 0)
  ;;                        (changed  #f))
  ;;               (if (eq? pass-num 1)
  ;;                   (begin ;; big reset
  ;;                     (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
  ;;                     (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
  ;;                     (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")))

                (if (> max-col (string->number (iup:attribute run-matrix "NUMCOL")))
                    (iup:attribute-set! run-matrix "NUMCOL" max-col ))

                (let ((effective-max-row (if (< max-row max-visible) max-visible max-row)))
                  (if (> effective-max-row (string->number (iup:attribute run-matrix "NUMLIN")))
                      (iup:attribute-set! run-matrix "NUMLIN" effective-max-row )))
                
                ;; Row labels
                (for-each (lambda (ind)
                            (let* ((name (car ind))
                                   (num  (cadr ind))
                                   (key  (conc num ":0")))
                              (if (not (equal? (iup:attribute run-matrix key) name))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key name)))))
                          row-indices)
                ;; (print "row-indices: " row-indices " col-indices: " col-indices)
                (if (and (eq? pass-num 0) changed)
                    (loop 1 #t)) ;; force second pass
                
                ;; Cell contents
                (for-each (lambda (entry)
                            ;; (print "entry: " entry)
                            (let* ((row-name  (cadr entry))
                                   (col-name  (car entry))
                                   (valuedat  (caddr entry))
                                   (test-id   (list-ref valuedat 0))
                                   (test-name row-name) ;; (list-ref valuedat 1))
                                   (item-path col-name) ;; (list-ref valuedat 2))
                                   (state     (list-ref valuedat 1))
                                   (status    (list-ref valuedat 2))
                                   (value     (gutils:get-color-for-state-status state status))
                                   (row-num   (cadr (assoc row-name row-indices)))
                                   (col-num   (cadr (assoc col-name col-indices)))
                                   (key       (conc row-num ":" col-num)))
                              (hash-table-set! cell-lookup key test-id)
                              (if (not (equal? (iup:attribute run-matrix key) (cadr value)))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key (cadr value))
                                    (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
                          matrix-content)
                
                ;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
                
                (for-each (lambda (ind)
                            (let* ((name (car ind))
                                   (num  (cadr ind))
                                   (key  (conc "0:" num)))
                              (if (not (equal? (iup:attribute run-matrix key) name))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key name)
                                    (if (<= num max-col)
                                        (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))))
                          col-indices)
                
                (if (and (eq? pass-num 0) changed)
                    (loop 1 #t)) ;; force second pass due to column labels changing
                
                ;; (debug:print 0 *default-log-port* "runs-summary-updater, changed: " changed " pass-num: " pass-num)
                ;; (print "runs-summary-updater, changed: " changed " pass-num: " pass-num)
                (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))))))
  ;; 
  ;;               (if (> max-col (string->number (iup:attribute run-matrix "NUMCOL")))
  ;;                   (iup:attribute-set! run-matrix "NUMCOL" max-col ))
  ;; 
  ;;               (let ((effective-max-row (if (< max-row max-visible) max-visible max-row)))
  ;;                 (if (> effective-max-row (string->number (iup:attribute run-matrix "NUMLIN")))
  ;;                     (iup:attribute-set! run-matrix "NUMLIN" effective-max-row )))
  ;;               
  ;;               ;; Row labels
  ;;               (for-each (lambda (ind)
  ;;                           (let* ((name (car ind))
  ;;                                  (num  (cadr ind))
  ;;                                  (key  (conc num ":0")))
  ;;                             (if (not (equal? (iup:attribute run-matrix key) name))
  ;;                                 (begin
  ;;                                   (set! changed #t)
  ;;                                   (iup:attribute-set! run-matrix key name)))))
  ;;                         row-indices)
  ;;               ;; (print "row-indices: " row-indices " col-indices: " col-indices)
  ;;               (if (and (eq? pass-num 0) changed)
  ;;                   (loop 1 #t)) ;; force second pass
  ;;               
  ;;               ;; Cell contents
  ;;               (for-each (lambda (entry)
  ;;                           ;; (print "entry: " entry)
  ;;                           (let* ((row-name  (cadr entry))
  ;;                                  (col-name  (car entry))
  ;;                                  (valuedat  (caddr entry))
  ;;                                  (test-id   (list-ref valuedat 0))
  ;;                                  (test-name row-name) ;; (list-ref valuedat 1))
  ;;                                  (item-path col-name) ;; (list-ref valuedat 2))
  ;;                                  (state     (list-ref valuedat 1))
  ;;                                  (status    (list-ref valuedat 2))
  ;;                                  (value     (gutils:get-color-for-state-status state status))
  ;;                                  (row-num   (cadr (assoc row-name row-indices)))
  ;;                                  (col-num   (cadr (assoc col-name col-indices)))
  ;;                                  (key       (conc row-num ":" col-num)))
  ;;                             (hash-table-set! cell-lookup key test-id)
  ;;                             (if (not (equal? (iup:attribute run-matrix key) (cadr value)))
  ;;                                 (begin
  ;;                                   (set! changed #t)
  ;;                                   (iup:attribute-set! run-matrix key (cadr value))
  ;;                                   (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
  ;;                         matrix-content)
  ;;               
  ;;               ;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
  ;;               
  ;;               (for-each (lambda (ind)
  ;;                           (let* ((name (car ind))
  ;;                                  (num  (cadr ind))
  ;;                                  (key  (conc "0:" num)))
  ;;                             (if (not (equal? (iup:attribute run-matrix key) name))
  ;;                                 (begin
  ;;                                   (set! changed #t)
  ;;                                   (iup:attribute-set! run-matrix key name)
  ;;                                   (if (<= num max-col)
  ;;                                       (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))))
  ;;                         col-indices)
  ;;               
  ;;               (if (and (eq? pass-num 0) changed)
  ;;                   (loop 1 #t)) ;; force second pass due to column labels changing
  ;;               
  ;;               ;; (debug:print 0 *default-log-port* "runs-summary-updater, changed: " changed " pass-num: " pass-num)
  ;;               ;; (print "runs-summary-updater, changed: " changed " pass-num: " pass-num)
  ;;               (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))))))

(define (dboard:areas-make-matrix commondat tabdat )
  (iup:matrix
   #:expand "YES"
   #:click-cb
   
   (lambda (obj lin col status)
︙
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

203
204
205
206
207
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
234
235
236



237
238
239
240
241
242
243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258








+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+






+
+
+
+

-
+








		   #:expand "YES"
		   #:addexpanded "YES"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			;; (print "obj: " obj ", id: " id ", state: " state)
			(let* ((prev-tree-path (dboard:tabdat-tree-path tabdat))
			(let* ((run-path (tree:node->path obj id))
			       (run-id   (tree-path->run-id tabdat (cdr run-path))))
			  (if (number? run-id)
			      (begin
                                (dboard:tabdat-prev-run-id-set!
                                 tabdat
                                 (dboard:tabdat-curr-run-id tabdat))

				(dboard:tabdat-curr-run-id-set! tabdat run-id)
				(dboard:tabdat-layout-update-ok-set! tabdat #f)
				;; (dashboard:update-run-summary-tab)
			       (tree-path      (tree:node->path obj id))
			       ;; Need to get the path construction from the pivot data but for now assume:
			       ;;   Area Target Runname




			       
			       ;;; ADD STUFF HERE ....


			       )
			  (if (not (equal? prev-tree-path tree-path))
			      (dboard:tabdat-view-changed tabdat))
			  
			  (dboard:tabdat-tree-path-set! tabdat tree-path)))
			  ;;      (run-id   (tree-path->run-id tabdat (cdr run-path))))
			  ;; (if (number? run-id)
			  ;;     (begin
                          ;;       (dboard:tabdat-prev-run-id-set!
                          ;;        tabdat
                          ;;        (dboard:tabdat-curr-run-id tabdat))
			  ;; 
			  ;; 	(dboard:tabdat-curr-run-id-set! tabdat run-id)
			  ;; 	(dboard:tabdat-layout-update-ok-set! tabdat #f)
			  ;; 	;; (dashboard:update-run-summary-tab)
				)
			      ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)
			      )))
			  ;; 	)
			  ;;     ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)
			  ;;     )))
		      "selection-cb in areas-summary")
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup            (make-hash-table))
	 (areas-matrix           (dboard:areas-make-matrix commondat tabdat))
	 (areas-summary-updater  (lambda ()
				   ;; maps data from tabdat view-dat to the matrix
				   ;; if input databases have changed, refresh view-dat
				   ;; if filters have changed, refresh view-dat from input databases
				   ;; if pivots  have changed, refresh view-dat from input databases
				   (mutex-lock! update-mutex)
				   (if  (or (dashboard:areas-database-changed? commondat tabdat context-key: 'runs-summary-updater)
				   (if  (or ;; (dashboard:areas-database-changed? commondat tabdat context-key: 'runs-summary-updater)
					    (dboard:tabdat-view-changed tabdat))
					(debug:catch-and-dump
					 (lambda () ;; check that areas-matrix is initialized before calling the updater
					   (if areas-matrix 
					       (dashboard:areas-summary-updater commondat tabdat tb cell-lookup areas-matrix)))
					 "dashboard:areas-summary-updater")
					)
︙

Modified dashboard.scm from [baf0a27cbf] to [136f08f6a7].

︙
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
145
146
147






148
149

150
151
152
153

154
155
156
157

158
159

160
161
162
163
164
165
166

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
145






146
147
148
149
150
151


152




153




154


155
156
157
158
159
160
161
162








-
-
-
-
+
+
+
+








-
-
-
+
+
+






+
+
-
+
+
+












-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
+








(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))
;; (if (not (launch:setup))
;;     (begin
;;       (print "Failed to find megatest.config, exiting") 
;;       (exit 1)))

;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature
;; first check for the switch
;;
(if (or (args:get-arg "-rh5.11")
	(configf:lookup *configdat* "dashboard" "no-detachbox"))
    (set! iup:detachbox iup:vbox))

(if (not (common:on-homehost?))
    (begin
      (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost))))
;; (if (not (common:on-homehost?))
;;     (begin
;;       (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost))))
    
;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")


(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;  (thread-start! (make-thread common:watchdog "Watchdog thread"))


;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin
;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  ((curr-tab-num 0) : number)
  please-update  
  tabdats
  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  (tabdats            (make-hash-table))
  (update-mutex       (make-mutex))
  (updaters           (make-hash-table))
  (updating           #f)
  uidat                                   ;; needs to move to tabdat at some time
  (hide-not-hide-tabs #f)
  )

  (current-area-path  #f)                 ;; the area of the path where the dashboard was started, if it is a megatest area
(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
  (areas              (make-hash-table))  ;; area-name ==> area-path
   please-update:        #t
   update-mutex:         (make-mutex)
   updaters:             (make-hash-table)
   updating:             #f
  (area-dbs           #f)                 ;; use db:dashboard-open-db to add areas to the areas hash  
   hide-not-hide-tabs:   #f
   ))
  )

;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
;;
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (let* ((tnum (or tab-num
		   (dboard:commondat-curr-tab-num commondat)
		   0)) ;; tab-num value is curr-tab-num value in passed commondat
︙
307
308
309
310
311
312
313
314
315
316






317
318
319
320
321
322
323

303
304
305
306
307
308
309



310
311
312
313
314
315
316
317
318
319
320
321
322








-
-
-
+
+
+
+
+
+








  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)
  (runs-summary-source-runname-label #f)
  (runs-summary-dest-runname-label #f)
  ;; runs summary view
  
  tests-tree       ;; used in newdashboard

  ;; Areas summary view
  (tree-path   '())
  (pivots #f)
  (filters #f)
  (view-dat  (hh:make-hh)) ;; hierarchial hash of the data to view
  )

;; register tabdat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* TABDAT:
                 (cons dboard:tabdat?
                       (lambda (tabdat-item)
︙
346
347
348
349
350
351
352

353


354
355
356
357
358
359
360

345
346
347
348
349
350
351
352

353
354
355
356
357
358
359
360
361








+
-
+
+









(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))

  ;; HACK ALERT: this is a hack, please fix.
  (if #f
  (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
      (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
      (print "FIXME on line 350"))
  
  (dboard:tabdat-keys-set! tabdat (mrmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
  (dboard:tabdat-tot-runs-set! tabdat (mrmt:get-num-runs "%"))
  )

;; RADT => Matrix defstruct addition
︙
2334
2335
2336
2337
2338
2339
2340


2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355


























2356
2357
2358
2359
2360
2361
2362

2335
2336
2337
2338
2339
2340
2341
2342
2343















2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376








+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








							    (if (eq? val 1)
								(hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t)
								(hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state))
							    (set-bg-on-filter commondat tabdat))))
				 (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
	    (num-toggle-cols (inexact->exact (round (/ (max (length status-toggles)(length state-toggles)) 3)))))
       (iup:vbox
	
	(let ((filter-pivot (iup:tabs
	(iup:hbox
	 (iup:frame
	  #:title "states"
	  (apply
	   iup:hbox
	   (map (lambda (colgrp)
		  (apply iup:vbox colgrp))
		(dboard:squarify state-toggles 3))))
	 (iup:frame
	  #:title "statuses"
	  (apply
	   iup:hbox
	   (map (lambda (colgrp)
		  (apply iup:vbox colgrp))
		(dboard:squarify status-toggles 3)))))
			     (iup:hbox
			      (iup:frame
			       #:title "states"
			       (apply
				iup:hbox
				(map (lambda (colgrp)
				       (apply iup:vbox colgrp))
				     (dboard:squarify state-toggles 3))))
			      (iup:frame
			       #:title "statuses"
			       (apply
				iup:hbox
				(map (lambda (colgrp)
				       (apply iup:vbox colgrp))
				     (dboard:squarify status-toggles 3)))))
			     (iup:hbox
			      (iup:frame
			       #:title "Rows"
			       (iup:button "Rows pivot"))
			      (iup:frame
			       #:title "Cols"
			       (iup:button "Cols pivot"))))))
	  (iup:attribute-set! filter-pivot "TABTITLE0" "Filters")
	  (iup:attribute-set! filter-pivot "TABTITLE1" "Pivots ")
	  filter-pivot)

	;; 
	;; (iup:frame 
	;; 	#:title "state/status filter"
	;; 	(iup:vbox
	;; 	 (apply
	;; 	  iup:hbox
	;; 	  (map
︙
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589









3590
3591
3592
3593
3594
3595
3596
3597







3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637







































3638
3639
3640
3641
3642
3643
3644
3645
3646
3647

3588
3589
3590
3591
3592
3593
3594









3595
3596
3597
3598
3599
3600
3601
3602
3603
3604







3605
3606
3607
3608
3609
3610
3611
3612







































3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











   "dashboard:runs-tab-updater"))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

(define (main)
  (let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; 
    (if (and (common:file-exists? mtdb-path)
	     (file-write-access? mtdb-path))
	(if (not (args:get-arg "-skip-version-check"))
            (common:exit-on-version-changed)))
    (let* ((commondat       (dboard:commondat-make)))
      ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
      (cond 
       ((args:get-arg "-test") ;; run-id,test-id
  ;; (let* ((areas    (make-hash-table))) ;; mtdb-path (conc *toppath* "/megatest.db"))) ;; 
  ;; (if (and (common:file-exists? mtdb-path)
  ;; 	     (file-write-access? mtdb-path))
  ;; 	(if (not (args:get-arg "-skip-version-check"))
  ;;         (common:exit-on-version-changed)))
  (let* ((commondat       (make-dboard:commondat)))
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
    (cond 
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) 
			  (if (> (length d) 1)
			      d
			      (list #f #f))))
	       (run-id  (car dat))
	       (test-id (cadr dat)))
	  (if (and (number? run-id)
		   (number? test-id)
			(if (> (length d) 1)
			    d
			    (list #f #f))))
	     (run-id  (car dat))
	     (test-id (cadr dat)))
	(if (and (number? run-id)
		 (number? test-id)
		   (>= test-id 0))
	      (dashboard-tests:examine-test run-id test-id)
	      (begin
		(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 (dboard:tabdat-dblocal tabdat)))
       (else
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			       (mutex-lock! (dboard:commondat-update-mutex commondat))
			       (set! update-is-running (dboard:commondat-updating commondat))
			       (if (not update-is-running)
				   (dboard:commondat-updating-set! commondat #t))
			       (mutex-unlock! (dboard:commondat-update-mutex commondat))
			       (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
				   (begin
				     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
				     (mutex-lock! (dboard:commondat-update-mutex commondat))
				     (dboard:commondat-updating-set! commondat #f)
				     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				   ))
			     1))))
      
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))
	(thread-start! th2)
	(thread-join! th2)))))
	    (dashboard-tests:examine-test run-id test-id)
	    (begin
	      (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 (dboard:tabdat-dblocal tabdat)))
     (else
      (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
      (dboard:commondat-curr-tab-num-set! commondat 0)
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
	 (dashboard:runs-tab-updater commondat 1))
       tab-num: 1)
      (iup:callback-set! *tim*
			 "ACTION_CB"
			 (lambda (time-obj)
			   (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)
				 (dboard:commondat-updating-set! commondat #t))
			     (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
				 (begin
				   (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
				   (mutex-lock! (dboard:commondat-update-mutex commondat))
				   (dboard:commondat-updating-set! commondat #f)
				   (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				 ))
			   1))))
    
    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      (thread-start! th2)
      (thread-join! th2))))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

(if (args:get-arg "-repl")
    (repl)
    (main))

Modified db.scm from [ab18972644] to [ecd11e6ee3].

︙
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102

103
104
105
106
107
108
109

88
89
90
91
92
93
94

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








-
+







+








  ;; 2. get homehost
  ;; 3. create /tmp db area  (if needed)
  ;; 4. sync data to /tmp db (or update if exists)
  ;; 5. return dbstruct
  (if (hash-table-exists? areas area-path)
      (hash-table-ref areas area-path)
      (if (common:file-exists? (conc area-path "/megatest.config") quiet-mode: #t)
	  (let* ((homehost (common:minimal-get-homehost toppath))
	  (let* ((homehost (common:minimal-get-homehost area-path))
		 (on-hh    (common:on-host? homehost))
		 (mtconfig (common:simple-setup area-path)) ;; returns ( configdat toppath configfile configf-name )
		 (dbstruct (make-dbr:dbstruct
			    area-path: area-path
			    homehost:  homehost
			    configdat: (car mtconfig)))
		 (tmpdb    (db:open-db dbstruct area-path: area-path do-sync: #t)))
	    (hash-table-set! areas area-path dbstruct)
	    tmpdb)
	  (begin
	    (debug:print-info 0 *default-log-port* "attempt to open megatest.db in " area-path " but no megatest.config found.")
	    #f))))

;; sync all the areas listed in area-paths
;;
︙
1999
2000
2001
2002
2003
2004
2005

2006

2007
2008
2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021
2022

2000
2001
2002
2003
2004
2005
2006
2007

2008
2009
2010
2011
2012
2013
2014
2015
2016

2017
2018
2019
2020
2021
2022
2023
2024








+
-
+








-
+








;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys dbstruct)
  (if (dbr:dbstruct-keys dbstruct)
  (if *db-keys* *db-keys* 
      (dbr:dbstruct-keys dbstruct)
      (let ((res '()))
	(db:with-db dbstruct #f #f
		    (lambda (db)
		      (sqlite3:for-each-row 
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	(dbr:dbstruct-keys-set! dbstruct res)
	res)))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
︙

Modified mrmt.scm from [3ceebb0592] to [c091af7199].

︙
475
476
477
478
479
480
481
482
483
484
485




486
487
488
489

490
491
492
493
494
495
496

475
476
477
478
479
480
481




482
483
484
485
486
487
488

489
490
491
492
493
494
495
496








-
-
-
-
+
+
+
+



-
+









;; These require run-id because the values come from the run!
;;
(define (mrmt:get-key-val-pairs run-id)
  (mrmt:send-receive 'get-key-val-pairs run-id (list run-id)))

(define (mrmt:get-keys)
  (if *db-keys* *db-keys* 
     (let ((res (mrmt:send-receive 'get-keys #f '())))
       (set! *db-keys* res)
       res)))
  ;; (if *db-keys* *db-keys* 
  (let ((res (mrmt:send-receive 'get-keys #f '())))
    ;; (set! *db-keys* res)
    res)) ;; )

(define (mrmt:get-keys-write) ;; dummy query to force server start
  (let ((res (mrmt:send-receive 'get-keys-write #f '())))
    (set! *db-keys* res)
    ;; (set! *db-keys* res)
    res))

;; we don't reuse run-id's (except possibly *after* a db cleanup) so it is safe
;; to cache the resuls in a hash
;;
(define (mrmt:get-key-vals run-id)
  (or (hash-table-ref/default *keyvals* run-id #f)
︙

Modified rmt.scm from [677a774188] to [8ae137f573].

︙
475
476
477
478
479
480
481
482
483
484
485




486
487
488
489

490
491
492
493
494
495
496

475
476
477
478
479
480
481




482
483
484
485
486
487
488

489
490
491
492
493
494
495
496








-
-
-
-
+
+
+
+



-
+









;; These require run-id because the values come from the run!
;;
(define (rmt:get-key-val-pairs run-id)
  (rmt:send-receive 'get-key-val-pairs run-id (list run-id)))

(define (rmt:get-keys)
  (if *db-keys* *db-keys* 
     (let ((res (rmt:send-receive 'get-keys #f '())))
       (set! *db-keys* res)
       res)))
  ;; (if *db-keys* *db-keys* 
  (let ((res (rmt:send-receive 'get-keys #f '())))
    ;; (set! *db-keys* res)
    res)) ;; )

(define (rmt:get-keys-write) ;; dummy query to force server start
  (let ((res (rmt:send-receive 'get-keys-write #f '())))
    (set! *db-keys* res)
    ;; (set! *db-keys* res)
    res))

;; we don't reuse run-id's (except possibly *after* a db cleanup) so it is safe
;; to cache the resuls in a hash
;;
(define (rmt:get-key-vals run-id)
  (or (hash-table-ref/default *keyvals* run-id #f)
︙

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