1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
|
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
|
+
+
+
+
+
-
+
-
+
|
(lambda (option)
(case option
;; kill servers
((killservers)
(for-each
(lambda (server)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Unable to get host and/or port from " servr ", exn=" exn)
#f)
(match-let (((mod-time host port start-time pid) server))
(match-let (((mod-time host port start-time server-id pid) server))
(if (and host pid)
(tasks:kill-server host pid))))
(tasks:kill-server host pid)))))
servers)
;; /tmp/bjbarcla/megatest_localdb/fullrun/.nfs.pdx.disks.icf_env_disk001.bjbarcla.gwa.issues.mtdev.matt-bisect.megatest.ext-tests.runs.all.v1.65.1.6524.dev.bb-24-justrollup-f8.rollup.fullrun/megatest.db.lock
(delete-file* (common:get-sync-lock-filepath))
)
;; clear out junk records
|
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
|
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
|
-
+
|
id INTEGER PRIMARY KEY,
test_id INTEGER,
state TEXT DEFAULT 'new',
status TEXT DEFAULT 'n/a',
archive_type TEXT DEFAULT 'bup',
du INTEGER,
archive_path TEXT);")))
;; (print "creating trigges from init")
(print "creating triggers from init")
(db:create-triggers db)
db)) ;; )
;;======================================================================
;; A R C H I V E S
;;======================================================================
|
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
|
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
-1 "-" "-"))
;;
;; 1. cache tests-match-qry
;; 2. compile qry and store in hash
;; 3. convert for-each-row to fold
;;
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
(db:with-db
dbstruct run-id #f
(lambda (db)
(let* ((res '())
(stmt-cache (dbr:dbstruct-stmt-cache dbstruct))
(stmth (let* ((sh (db:hoh-get stmt-cache db testpatt)))
(or sh
(let* ((tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))
(newsh (sqlite3:prepare db qry)))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
(db:hoh-set! stmt-cache db testpatt newsh)
newsh)))))
(reverse
(sqlite3:fold-row
(lambda (res id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
(cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))
'()
stmth
run-id))))))
;; (define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
;; (db:with-db
;; dbstruct run-id #f
;; (lambda (db)
;; (let* ((res '())
;; (stmt-cache (dbr:dbstruct-stmt-cache dbstruct))
;; (stmth (let* ((sh (db:hoh-get stmt-cache db testpatt)))
;; (or sh
;; (let* ((tests-match-qry (tests:match->sqlqry testpatt))
;; (qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? "
;; (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))
;; (newsh (sqlite3:prepare db qry)))
;; (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
;; (db:hoh-set! stmt-cache db testpatt newsh)
;; newsh)))))
;; (reverse
;; (sqlite3:fold-row
;; (lambda (res id testname item-path state status)
;; ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
;; (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))
;; '()
;; stmth
;; run-id))))))
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0))
(let* ((res '())
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? "
" AND last_update > ? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
|
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
|
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
(define (db:get-test-times dbstruct run-name target)
(let ((res `())
(qry (conc "select testname, item_path, run_duration, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname = ? and target = ? ;")))
(db:with-db
dbstruct
#f ;; this is for the main runs db
#f ;; does not modify db
(lambda (db)
(sqlite3:for-each-row
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
|
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
|
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
|
-
+
|
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
db
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(reverse res)))))
;; This routine moved from tdb.scm, :read-test-data
;;
(define (db:read-test-data* dbstruct run-id test-id categorypatt varpatt)
(define (db:read-test-data-varpatt dbstruct run-id test-id categorypatt varpatt)
(let* ((res '()))
(db:with-db
dbstruct #f #f
(lambda (db)
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
|