143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
+
+
|
db ;; db handle
)
;; testdat, basic test data
(define-record testdat
run-id ;; what run is this from
id ;; test id
testname ;; test name
itempath ;; item path
state ;; test state, symbol
status ;; test status, symbol
event-time ;; when the test started
duration ;; how long the test took
)
;; general data for the dboard application
|
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
259
260
261
262
263
264
265
266
267
268
269
270
|
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
259
260
261
262
263
264
265
266
267
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
|
-
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let* ((runs (areadat-runs areadat))
(rundat (if (> run-id 0) ;; it is a run
(hash-table-ref/default runs run-id #f)
#f))
(db (case run-id ;; if already opened, get the db and return it
((-1) (areadat-monitordb areadat))
((0) (areadat-maindb areadat))
(else (if run
(else (if rundat
(rundat-db rundat)
#f)))))
(if db
db ;; merely return the already opened db
(let* ((dbfile (areadb:dbfile-path areadat run-id)) ;; not already opened, so open it
(db (if (file-exists? dbfile)
(open-database dbfile)
(begin
(debug:print 0 "ERROR: I was asked to open " dbfile ", but file does not exist or is not readable.")
#f))))
(case run-id
((-1)(areadat-monitordb-set! areadat db))
((0) (areadat-maindb-set! areadat db))
(else (rundat-db-set! rundat db)))
db))))
;; populate the areadat tests info, does NOT fill the tests data itself
;; populate the areadat tests info, does NOT fill the tests data itself unless asked
;;
(define (areadb:populate-run-info areadat)
(let* ((runs (or (areadat-runs areadat) (make-hash-table)))
(keys (areadat-run-keys areadat))
(maindb (areadb:open areadat 0)))
(query (for-each-row (lambda (row)
(let ((id (list-ref row 0))
(dat (apply make-rundat (append row (list #f #f))))) ;; add placeholders for tests and db
(print row)
(hash-table-set! runs id dat))))
(sql maindb (conc "SELECT id,"
(string-intersperse keys "||'/'||")
",runname,state,status,event_time FROM runs WHERE state != 'DELETED';")))
",runname,state,status,event_time FROM runs WHERE state != 'deleted';")))
areadat))
;; given an areadat and target/runname patt fill up runs data
;;
;; ?????/
;; given a list of run-ids refresh/retrieve runs data into areadat
;;
(define (areadb:fill-tests areadat #!key (run-ids #f))
(let* ((runs (or (areadat-runs areadat) (make-hash-table))))
(for-each
(lambda (run-id)
(let* ((rundat (hash-table-ref/default runs run-id #f))
(tests (if (and rundat
(rundat-tests rundat)) ;; re-use existing hash table?
(rundat-tests rundat)
(let ((ht (make-hash-table)))
(rundat-tests-set! rundat ht)
ht)))
(rundb (areadb:open areadat run-id)))
(query (for-each-row (lambda (row)
(let* ((id (list-ref row 0))
(testname (list-ref row 1))
(itempath (list-ref row 2))
(state (list-ref row 3))
(status (list-ref row 4))
(eventtim (list-ref row 5))
(duration (list-ref row 6)))
(hash-table-set! tests id
(make-testdat run-id id testname itempath state status eventtim duration)))))
(sql rundb "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE state != 'DELETED';"))))
(or run-ids (hash-table-keys runs)))
areadat))
;; initialize and refresh data
;;
(define (dboard:general-updater con port)
(for-each
(lambda (window-id)
;; (print "Processing for window-id " window-id)
(let* ((window-dat (hash-table-ref *windows* window-id))
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
|
+
-
|
(if current-tree
(let* ((partial-path (append (string-split target "/")(list runname)))
(full-path (cons area-name partial-path)))
(if (not (hash-table-exists? seen-nodes full-path))
(begin
(print "INFO: Adding node " partial-path " to section " area-name)
(tree:add-node current-tree "Areas" full-path)
(areadb:fill-tests area-dat run-ids: (list run-id))))
(hash-table-set! seen-nodes full-path #t)))))
))
(hash-table-keys runs))))))
(hash-table-keys areas))))
(hash-table-keys *windows*)))
;;======================================================================
;; D A S H B O A R D D B
;;======================================================================
|