404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
(dboard:commondat-please-update commondat)
(dboard:get-last-db-update tabdat context-key))))
;; (dboard:tabdat-last-db-update tabdat))))
(if recalc
(dboard:set-last-db-update! tabdat context-key run-update-time))
(dboard:commondat-please-update-set! commondat #f)
recalc))
(define (dboard:areas-update-tree tabdat runs-hash runs-header tb)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(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 runs-header "event_time"))
(time-b (db:get-value-by-header record-b runs-header "event_time")))
(< time-a time-b)))))
(changed #f)
(last-runs-update (dboard:tabdat-last-runs-update tabdat))
(runs-dat (mrmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0)) ;; last-runs-update))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(runs (vector-ref runs-dat 1))
(new-run-ids (map (lambda (run)
(db:get-value-by-header run runs-header "id"))
runs))
(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 runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (cons "local " (append key-vals (list run-name)))))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
;; (let ((existing (tree:find-node tb run-path)))
;; (if (not existing)
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Areas" run-path) ;; (append key-vals (list run-name))
;; userdata: (conc "run-id: " run-id))))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
(append new-run-ids run-ids)))) ;; for-each run-id
(define (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)
(let* ((run (hash-table-ref/default runs-hash run-id #f))
(key-vals (mrmt:get-key-vals run-id))
(testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
(tests-dat (dashboard:tests-ht->tests-dat tests-ht))
(tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
|
(dboard:commondat-please-update commondat)
(dboard:get-last-db-update tabdat context-key))))
;; (dboard:tabdat-last-db-update tabdat))))
(if recalc
(dboard:set-last-db-update! tabdat context-key run-update-time))
(dboard:commondat-please-update-set! commondat #f)
recalc))
;; open the area dbs, given list of areas that are "cared about"
;; areas: '( (area_name . path) ... ) ;; NOT necessarily the section [areas] from megatest.config
;;
(define (dboard:areas-open-areas commondat tabdat areas)
(let ((areas-ht (dboard:commondat-areas commondat)))
(for-each
(lambda (area-dat)
(db:dashboard-open-db areas (car area-dat)(cdr area-dat)))
areas)))
(define (dboard:areas-update-tree tabdat runs-hash runs-header tb)
(let* ((tree-path (dboard:tabdat-tree-path tabdat))
;; (access-mode (dboard:tabdat-access-mode tabdat))
;; (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 runs-header "event_time"))
;; (time-b (db:get-value-by-header record-b runs-header "event_time")))
;; (< time-a time-b)))))
;; (changed #f)
;; (last-runs-update (dboard:tabdat-last-runs-update tabdat))
;; (runs-dat (mrmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0)) ;; last-runs-update))
;; (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
;; (runs (vector-ref runs-dat 1))
;; (new-run-ids (map (lambda (run)
;; (db:get-value-by-header run runs-header "id"))
;; runs))
(areas (configf:get-section *configdat* "areas")))
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(for-each
(lambda (area)
(let ((run-path (list area)))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
(begin
(tree:add-node tb "Areas" run-path)
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path 0)))))
(map car areas))
;; here the local area
;;(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 runs-header key))
;; (dboard:tabdat-keys tabdat)))
;; (run-name (db:get-value-by-header run-record runs-header "runname"))
;; (col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
;; (run-path (cons "local " (append key-vals (list run-name)))))
;; (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
;; ;; (let ((existing (tree:find-node tb run-path)))
;; ;; (if (not existing)
;; (begin
;; (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
;; ;; (conc rownum ":" colnum) col-name)
;; ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; ;; Here we update the tests treebox and tree keys
;; (tree:add-node tb "Areas" run-path) ;; (append key-vals (list run-name))
;; ;; userdata: (conc "run-id: " run-id))))
;; (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; ;; (set! colnum (+ colnum 1))
;; ))))
;; (append new-run-ids run-ids)))) ;; for-each run-id
))
(define (dashboard:areas-run-id->tests-mindat run-id tabdat runs-hash)
(let* ((run (hash-table-ref/default runs-hash run-id #f))
(key-vals (mrmt:get-key-vals run-id))
(testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
(tests-dat (dashboard:tests-ht->tests-dat tests-ht))
(tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display
|