@@ -92,23 +92,10 @@ (define (db:hoh-get dat key1 key2) (let* ((subhash (hash-table-ref/default dat key1 #f))) (and subhash (hash-table-ref/default subhash key2 #f)))) -;; the stmt-cache is associated with a single db handle -;; so there is no need for the hoh stuff. -(define (db:get-cache-stmth dbdat run-id db stmt) - (let* ((stmt-cache (dbr:dbdat-stmt-cache dbdat)) - ;; (stmth (db:hoh-get stmt-cache db stmt)) - (stmth (hash-table-ref/default stmt-cache stmt #f)) - ) - (or stmth - (let* ((newstmth (sqlite3:prepare db stmt))) - ;; (db:hoh-set! stmt-cache db stmt newstmth) - (hash-table-set! stmt-cache stmt newstmth) - newstmth)))) - ;;====================================================================== ;; SQLITE3 HELPERS ;;====================================================================== (define (db:general-sqlite-error-dump exn stmt . params) @@ -1051,12 +1038,12 @@ ;; what to do with toplevel? call rollup? (begin (set! toplevels (cons (list test-id run-dir uname testname item-path run-id) toplevels)) (debug:print-info 0 *default-log-port* "Found old toplevel test in RUNNING state, test-id=" test-id)) (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted)))) - db - "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING','REMOTEHOSTSTART');" + (db:get-cache-stmth dbdat db + "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING','REMOTEHOSTSTART');") run-id deadtime) ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config ;; ;; (db:delay-if-busy dbdat) @@ -1065,12 +1052,12 @@ (if (and (equal? uname "n/a") (equal? item-path "")) ;; this is a toplevel test ;; what to do with toplevel? call rollup? (set! toplevels (cons (list test-id run-dir uname testname item-path run-id) toplevels)) (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))) - db - "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');" + (db:get-cache-stmth dbdat db + "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');") run-id) (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, " (length toplevels) " old LAUNCHED toplevel tests and " (length incompleted) " tests marked RUNNING but apparently dead.") (if (and (null? incompleted) (null? oldlaunched) @@ -1117,21 +1104,21 @@ (db:with-db dbstruct run-id #f (lambda (dbdat db) (let* ((stmth1 (db:get-cache-stmth - dbdat run-id db + dbdat db "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING');")) (stmth2 (db:get-cache-stmth - dbdat run-id db + dbdat db "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('REMOTEHOSTSTART');")) (stmth3 (db:get-cache-stmth - dbdat run-id db + dbdat db "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"))) ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes ;; @@ -1363,27 +1350,27 @@ dbstruct #f #f ;; for the moment vars are only stored in main.db (lambda (dbdat db) (sqlite3:for-each-row (lambda (val) (set! res val)) - db - "SELECT val FROM metadat WHERE var=?;" var) + (db:get-cache-stmth dbdat db + "SELECT val FROM metadat WHERE var=?;") var) ;; convert to number if can (if (string? res) (let ((valnum (string->number res))) (if valnum (set! res valnum)))) res)))) (define (db:inc-var dbstruct var) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "UPDATE metadat SET val=val+1 WHERE var=?;" var)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE metadat SET val=val+1 WHERE var=?;") var)))) (define (db:dec-var dbstruct var) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "UPDATE metadat SET val=val-1 WHERE var=?;" var)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE metadat SET val=val-1 WHERE var=?;") var)))) ;; This was part of db:get-var. It was used to estimate the load on ;; the database files. ;; ;; scale by 10, average with current value. @@ -1396,21 +1383,21 @@ ;; (set! *last-global-delta-printed* *global-delta*))) (define (db:set-var dbstruct var val) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);") var val)))) (define (db:add-var dbstruct var val) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "UPDATE metadat SET val=val+? WHERE var=?;" val var)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE metadat SET val=val+? WHERE var=?;") val var)))) (define (db:del-var dbstruct var) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "DELETE FROM metadat WHERE var=?;") var)))) ;;====================================================================== ;; no-sync.db - small bits of data to be shared between servers ;;====================================================================== @@ -1523,12 +1510,12 @@ (lambda (dbdat db) (let ((res #f)) (sqlite3:for-each-row (lambda (runname) (set! res runname)) - db - "SELECT runname FROM runs WHERE id=?;" + (db:get-cache-stmth dbdat db + "SELECT runname FROM runs WHERE id=?;") run-id) res)))) (define (db:get-run-key-val dbstruct run-id key) (db:with-db @@ -1586,13 +1573,14 @@ (db:with-db dbstruct #f #f (lambda (dbdat db) ;; (debug:print 0 *default-log-port* "Got here 1.") (let ((res #f)) - (apply sqlite3:execute db - (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" - comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");") + (apply sqlite3:execute + (db:get-cache-stmth dbdat db + (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" + comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");")) allvals) (apply sqlite3:for-each-row (lambda (id) (set! res id)) db @@ -1747,12 +1735,12 @@ (let ((numruns 0)) (debug:print-info 11 *default-log-port* "db:get-num-runs START " runpatt) (sqlite3:for-each-row (lambda (count) (set! numruns count)) - db - "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" runpatt) + (db:get-cache-stmth dbdat db + "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" )runpatt) (debug:print-info 11 *default-log-port* "db:get-num-runs END " runpatt) numruns)))) ;; just get count of runs (define (db:get-runs-cnt-by-patt dbstruct runpatt targetpatt keys) @@ -1801,12 +1789,12 @@ (lambda (dbdat db) (sqlite3:fold-row (lambda (res state status count) (cons (list state status count) res)) '() - db - "SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;" + (db:get-cache-stmth dbdat db + "SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;") run-id)))) ;; Update run_stats for given run_id ;; input data is a list (state status count) ;; @@ -1818,24 +1806,21 @@ #f (lambda (dbdat db) ;; remove previous data - (let* ((stmt1 (sqlite3:prepare db "DELETE FROM run_stats WHERE run_id=? AND state=? AND status=?;")) - (stmt2 (sqlite3:prepare db "INSERT INTO run_stats (run_id,state,status,count) VALUES (?,?,?,?);")) + (let* ((stmt1 (db:get-cache-stmth dbdat db "DELETE FROM run_stats WHERE run_id=? AND state=? AND status=?;")) + (stmt2 (db:get-cache-stmth dbdat db "INSERT INTO run_stats (run_id,state,status,count) VALUES (?,?,?,?);")) (res (sqlite3:with-transaction db (lambda () (for-each (lambda (dat) (sqlite3:execute stmt1 run-id (car dat)(cadr dat)) (apply sqlite3:execute stmt2 run-id dat)) stats))))) - (sqlite3:finalize! stmt1) - (sqlite3:finalize! stmt2) - ;; (mutex-unlock! *db-transaction-mutex*) res)))) (define (db:get-main-run-stats dbstruct run-id) (db:with-db dbstruct @@ -1844,12 +1829,12 @@ (lambda (dbdat db) (sqlite3:fold-row (lambda (res state status count) (cons (list state status count) res)) '() - db - "SELECT state,status,count FROM run_stats WHERE run_id=? AND run_id IN (SELECT id FROM runs WHERE state NOT IN ('DELETED','deleted'));" + (db:get-cache-stmth dbdat db + "SELECT state,status,count FROM run_stats WHERE run_id=? AND run_id IN (SELECT id FROM runs WHERE state NOT IN ('DELETED','deleted'));") run-id)))) (define (db:print-current-query-stats) ;; generate stats from *db-api-call-time* (let ((ordered-keys (sort (hash-table-keys *db-api-call-time*) @@ -1877,12 +1862,12 @@ (lambda (dbdat db) (let ((run-ids '())) (sqlite3:for-each-row (lambda (run-id) (set! run-ids (cons run-id run-ids))) - db - "SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") + (db:get-cache-stmth dbdat db + "SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")) (reverse run-ids))))) ;; get some basic run stats ;; ;; data structure: @@ -1900,12 +1885,12 @@ dbstruct #f #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (run-id runname) (set! runs-info (cons (list run-id runname) runs-info))) - db - "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;"))) ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats + (db:get-cache-stmth dbdat db + "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")))) ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats ;; for each run get stats data (for-each (lambda (run-info) ;; get the net state/status counts for this run (let* ((run-id (car run-info)) @@ -1920,12 +1905,12 @@ (let ((netstate (if (equal? state "COMPLETED") status state))) (if (string? netstate) (begin (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count)) (hash-table-set! curr netstate (+ (hash-table-ref/default curr netstate 0) count)))))) - db - "SELECT state,status,count(id) FROM tests AS t WHERE run_id=? GROUP BY state,status ORDER BY state,status DESC;" + (db:get-cache-stmth dbdat db + "SELECT state,status,count(id) FROM tests AS t WHERE run_id=? GROUP BY state,status ORDER BY state,status DESC;") run-id) ;; add the per run counts to res (for-each (lambda (state) (set! res (cons (list run-name state (hash-table-ref curr state)) res))) (sort (hash-table-keys curr) string>=)) @@ -2016,11 +2001,11 @@ (define (db:set-comment-for-run dbstruct run-id comment) (db:with-db dbstruct #f #f (lambda (dbdat db) - (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment ;; (sdb:qry 'getid comment) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE runs SET comment=? WHERE id=?;") comment ;; (sdb:qry 'getid comment) run-id)))) ;; does not (obviously!) removed dependent data. But why not!!? (define (db:delete-run dbstruct run-id) (db:with-db @@ -2037,11 +2022,11 @@ (define (db:update-run-event_time dbstruct run-id) (db:with-db dbstruct #f #t (lambda (dbdat db) - (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;") run-id)))) (define (db:lock/unlock-run dbstruct run-id lock unlock user) (db:with-db dbstruct #f #t (lambda (dbdat db) @@ -2057,32 +2042,32 @@ (define (db:set-run-status dbstruct run-id status msg) (db:with-db dbstruct #f #f (lambda (dbdat db) (if msg - (sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id) - (sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id))))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE runs SET status=?,comment=? WHERE id=?;") status msg run-id) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE runs SET status=? WHERE id=?;") status run-id))))) -(define (db:set-run-state-status-db db run-id state status ) - (sqlite3:execute db "UPDATE runs SET status=?,state=? WHERE id=?;" status state run-id)) +(define (db:set-run-state-status-db dbdat db run-id state status ) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE runs SET status=?,state=? WHERE id=?;") status state run-id)) (define (db:set-run-state-status dbstruct run-id state status ) (db:with-db dbstruct #f #f (lambda (dbdat db) - (db:set-run-state-status-db db run-id state status)))) + (db:set-run-state-status-db dbdat db run-id state status)))) (define (db:get-run-status dbstruct run-id) (let ((res "n/a")) (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (status) (set! res status)) - db - "SELECT status FROM runs WHERE id=?;" + (db:get-cache-stmth dbdat db + "SELECT status FROM runs WHERE id=?;" ) run-id) res)))) (define (db:get-run-state dbstruct run-id) (let ((res "n/a")) @@ -2090,12 +2075,12 @@ dbstruct #f #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (status) (set! res status)) - db - "SELECT state FROM runs WHERE id=?;" + (db:get-cache-stmth dbdat db + "SELECT state FROM runs WHERE id=?;" ) run-id) res)))) ;;====================================================================== @@ -2114,11 +2099,11 @@ (lambda (key) (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;"))) (sqlite3:for-each-row (lambda (key-val) (set! res (cons (list key (if (string? key-val) key-val "")) res))) ;; replace non-string bad values with empty string to prevent crashes. This scenario can happen when Megatest is killed on updating the db - db qry run-id))) + (db:get-cache-stmth dbdat db qry) run-id))) keys))) (reverse res))) ;; get key vals for a given run-id (define (db:get-key-vals dbstruct run-id) @@ -2132,11 +2117,11 @@ (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;"))) ;; (db:delay-if-busy dbdat) (sqlite3:for-each-row (lambda (key-val) (set! res (cons (if (string? key-val) key-val "") res))) ;; check that the key-val is a string for cases where a crash injected bad data in the megatest.db - db qry run-id))) + (db:get-cache-stmth dbdat db qry) run-id))) keys))) (let ((final-res (reverse res))) (hash-table-set! *keyvals* run-id final-res) final-res))) @@ -2160,12 +2145,12 @@ (db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db (lambda (dbdat db) (apply sqlite3:for-each-row (lambda (id) (set! prev-run-ids (cons id prev-run-ids))) - db - (conc "SELECT id FROM runs WHERE " qrystr " AND state != 'deleted' AND id != ?;") + (db:get-cache-stmth dbdat db + (conc "SELECT id FROM runs WHERE " qrystr " AND state != 'deleted' AND id != ?;")) (append kvalues (list run-id))))) prev-run-ids))))) ;;====================================================================== ;; T E S T S @@ -2337,12 +2322,12 @@ (lambda (dbdat db) (sqlite3:for-each-row (lambda (run-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 (set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-"))) - db - "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=? and run_id=?;" + (db:get-cache-stmth dbdat db + "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=? and run_id=?;" ) test-id run-id))) res)) ;; get a useful subset of the tests data (used in dashboard ;; use db:mintest-get-{id ,run_id,testname ...} @@ -2372,11 +2357,11 @@ (db:general-call dbstruct run-id 'delete-test-step-records (list test-id)) (db:general-call dbstruct run-id 'delete-test-data-records (list test-id)) (db:with-db dbstruct run-id #f (lambda (dbdat db) - (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))) + (sqlite3:execute (db:get-cache-stmth dbdat db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;") test-id)))) ;; (define (db:delete-old-deleted-test-records dbstruct) (let ((targtime (- (current-seconds) (or (configf:lookup-number *configdat* "setup" "keep-deleted-records") @@ -2387,13 +2372,13 @@ #t (lambda (dbdat db) (sqlite3:with-transaction db (lambda () - (sqlite3:execute db "DELETE FROM test_steps WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_timelist rec)) ",") "\n") (apply sqlite3:execute qry (append (vector->list rec)(list run-id)))) testrecs))) - (sqlite3:finalize! qry))))) + ;; (sqlite3:finalize! qry) + )))) ;; map a test-id into the proper range ;; (define (db:adj-test-id mtdb min-test-id test-id) (if (>= test-id min-test-id) @@ -2720,12 +2706,12 @@ (let ((res #f)) (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update))) - db - (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;") + (db:get-cache-stmth dbdat db + (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")) test-id) res)))) ;; Use db:test-get* to access ;; Get test data using test_ids. NB// Only works within a single run!! @@ -2750,19 +2736,19 @@ (db:with-db dbstruct run-id #f (lambda (dbdat db) - (db:get-test-info-db db run-id test-name item-path)))) + (db:get-test-info-db dbdat db run-id test-name item-path)))) -(define (db:get-test-info-db db run-id test-name item-path) +(define (db:get-test-info-db dbdat db run-id test-name item-path) (let ((res #f)) (sqlite3:for-each-row (lambda (a . b) (set! res (apply vector a b))) - db - (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=? AND run_id=?;") + (db:get-cache-stmth dbdat db + (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=? AND run_id=?;")) test-name item-path run-id) res)) (define (db:test-get-rundir-from-test-id dbstruct run-id test-id) (db:with-db @@ -2787,12 +2773,12 @@ #f ;; does not modify db (lambda (dbdat 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 + (db:get-cache-stmth dbdat db + qry ) run-name target) res)))) ;;====================================================================== ;; S T E P S @@ -2803,12 +2789,12 @@ dbstruct run-id #t (lambda (dbdat db) (sqlite3:execute - db - "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);" + (db:get-cache-stmth dbdat db + "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);") test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile ""))))) @@ -2819,12 +2805,12 @@ dbstruct run-id #t (lambda (dbdat db) (sqlite3:execute - db - "UPDATE test_steps set status='DELETED' where test_id=?" ;; and run_id=? !! - run_id not in table (bummer) TODO: get run_id into schema for test_steps + (db:get-cache-stmth dbdat db + "UPDATE test_steps set status='DELETED' where test_id=?") ;; and run_id=? !! - run_id not in table (bummer) TODO: get run_id into schema for test_steps test-id)))) ;; db-get-test-steps-for-run (define (db:get-steps-for-test dbstruct run-id test-id) @@ -2835,12 +2821,12 @@ (lambda (dbdat db) (let* ((res '())) (sqlite3:for-each-row (lambda (id test-id stepname state status event-time logfile comment) (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment) res))) - db - "SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + (db:get-cache-stmth dbdat db + "SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;") ;; event_time DESC,id ASC; test-id) (reverse res))))) (define (db:get-steps-info-by-id dbstruct run-id test-step-id) (db:with-db @@ -2850,12 +2836,12 @@ (lambda (dbdat db) (let* ((res (vector #f #f #f #f #f #f #f #f #f))) (sqlite3:for-each-row (lambda (id test-id stepname state status event-time logfile comment last-update) (set! res (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment last-update))) - db - "SELECT id,test_id,stepname,state,status,event_time,logfile,comment,last_update FROM test_steps WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + (db:get-cache-stmth dbdat db + "SELECT id,test_id,stepname,state,status,event_time,logfile,comment,last_update FROM test_steps WHERE id=? ORDER BY id ASC;") ;; event_time DESC,id ASC; test-step-id) res)))) (define (db:get-steps-data dbstruct run-id test-id) (db:with-db @@ -2865,12 +2851,12 @@ (lambda (dbdat db) (let ((res '())) (sqlite3:for-each-row (lambda (id test-id stepname state status event-time logfile) (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res))) - db - "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + (db:get-cache-stmth dbdat db + "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;") ;; event_time DESC,id ASC; test-id) (reverse res))))) ;;====================================================================== ;; T E S T D A T A @@ -2881,11 +2867,11 @@ (db:with-db dbstruct run-id #f (lambda (dbdat db) - (let* ((stmth (db:get-cache-stmth dbdat #f db stmt)) + (let* ((stmth (db:get-cache-stmth dbdat db stmt)) (res (sqlite3:fold-row (lambda (res id test-id category variable value expected tol units comment status type last-update) (vector id test-id category variable value expected tol units comment status type last-update)) (vector #f #f #f #f #f #f #f #f #f #f #f #f) stmth @@ -2905,13 +2891,13 @@ (lambda (dbdat db) (sqlite3:for-each-row (lambda (fcount pcount) (set! fail-count fcount) (set! pass-count pcount)) - db + (db:get-cache-stmth dbdat db "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count, - (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;" + (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;") test-id test-id) ;; Now rollup the counts to the central megatest.db (db:general-call dbstruct run-id 'pass-fail-counts (list pass-count fail-count test-id)) ;; if the test is not FAIL then set status based on the fail and pass counts. (db:general-call dbstruct run-id 'test_data-pf-rollup (list test-id test-id test-id test-id)))))) @@ -3066,12 +3052,12 @@ dbstruct #f #f (lambda (dbdat 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))) - 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) + (db:get-cache-stmth dbdat 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-varpatt dbstruct run-id test-id categorypatt varpatt) @@ -3080,12 +3066,12 @@ dbstruct #f #f (lambda (dbdat 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))) - db - "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? AND variable LIKE ? ORDER BY category,variable;" test-id categorypatt varpatt) + (db:get-cache-stmth dbdat db + "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? AND variable LIKE ? ORDER BY category,variable;") test-id categorypatt varpatt) (reverse res))))) ;;====================================================================== ;; Misc. test related queries @@ -3138,12 +3124,12 @@ (lambda (dbdat db) (let ((res 0)) (sqlite3:for-each-row (lambda (num-items) (set! res num-items)) - db - "SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state NOT IN ('DELETED');" + (db:get-cache-stmth dbdat db + "SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state NOT IN ('DELETED');") run-id testname) res)))) ;;====================================================================== @@ -3229,13 +3215,13 @@ (let ((tr-res (sqlite3:with-transaction db (lambda () ;; NB// Pass the db so it is part fo the transaction - (db:test-set-state-status-db db run-id test-id state status comment) ;; this call sets the item state/status + (db:test-set-state-status-db dbdat db run-id test-id state status comment) ;; this call sets the item state/status (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item - (let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test + (let* ((state-status-counts (db:get-all-state-status-counts-for-test dbdat db run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test (state-statuses (db:roll-up-rules state-status-counts state status)) (newstate (car state-statuses)) (newstatus (cadr state-statuses))) (set! new-state-eh newstate) (set! new-status-eh newstatus) @@ -3244,11 +3230,11 @@ (map (lambda (x) (conc (with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | ")) state-status-counts))); end debug:print (if tl-test-id - (db:test-set-state-status-db db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct + (db:test-set-state-status-db dbdat db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct )))))) (mutex-unlock! *db-transaction-mutex*) (if (and test-id state status (equal? status "AUTO")) (db:test-data-rollup dbstruct run-id test-id status)) (if new-state-eh ;; moved from db:test-set-state-status @@ -3323,20 +3309,20 @@ (let* ((state-status-counts (db:get-all-state-status-counts-for-run-db db run-id)) (state-statuses (db:roll-up-rules state-status-counts #f #f )) (newstate (car state-statuses)) (newstatus (cadr state-statuses))) (if (or (not (eq? newstate curr-state)) (not (eq? newstatus curr-status))) - (db:set-run-state-status-db db run-id newstate newstatus ))))))) + (db:set-run-state-status-db dbdat db run-id newstate newstatus ))))))) (mutex-unlock! *db-transaction-mutex*) tr-res)))) (define (db:get-all-state-status-counts-for-run-db db run-id) (sqlite3:map-row (lambda (state status count) (make-dbr:counts state: state status: status count: count)) - db - "SELECT state,status,count(id) FROM tests WHERE run_id=? GROUP BY state,status;" + (db:get-cache-stmth dbdat db + "SELECT state,status,count(id) FROM tests WHERE run_id=? GROUP BY state,status;") run-id )) (define (db:get-all-state-status-counts-for-run dbstruct run-id) (db:with-db dbstruct #f #f @@ -3345,20 +3331,20 @@ ;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status* ;; ;; NOTE: This is called within a transaction ;; -(define (db:get-all-state-status-counts-for-test db run-id test-name item-path item-state-in item-status-in) - (let* ((test-info (db:get-test-info-db db run-id test-name item-path)) +(define (db:get-all-state-status-counts-for-test dbdat db run-id test-name item-path item-state-in item-status-in) + (let* ((test-info (db:get-test-info-db dbdat db run-id test-name item-path)) (item-state (or item-state-in (db:test-get-state test-info))) (item-status (or item-status-in (db:test-get-status test-info))) (other-items-count-recs (sqlite3:map-row (lambda (state status count) (make-dbr:counts state: state status: status count: count)) - db + (db:get-cache-stmth dbdat db ;; ignore current item because we have changed its value in the current transation so this select will see the old value. - "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;" + "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;") run-id test-name item-path)) ;; add current item to tally outside of sql query (match-countrec-lambda (lambda (countrec) (and (equal? (dbr:counts-state countrec) item-state) (equal? (dbr:counts-status countrec) item-status)))) @@ -3406,12 +3392,12 @@ (set! logf final_logf) (set! res (list path final_logf)) (if (directory? path) (debug:print 2 *default-log-port* "Found path: " path) (debug:print 2 *default-log-port* "No such path: " path))) ;; ) - db - "SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='' AND run_id=?;" + (db:get-cache-stmth dbdat db + "SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='' AND run_id=?;") test-name run-id) res)))) ;;====================================================================== ;; A G R E G A T E D T R A N S A C T I O N D B W R I T E S @@ -3591,11 +3577,11 @@ db:queries))) (if q (car q) #f)))) (db:with-db dbstruct run-id #f (lambda (dbdat db) - (apply sqlite3:execute db query params) + (apply sqlite3:execute (db:get-cache-stmth dbdat db query) params) #t)))) ;; get a summary of state and status counts to calculate a rollup ;; (define (db:get-state-status-summary dbstruct run-id testname) @@ -3604,12 +3590,12 @@ dbstruct run-id #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (state status count) (set! res (cons (vector state status count) res))) - db - "SELECT state,status,count(state) FROM tests WHERE run_id=? AND testname=? AND item_path='' GROUP BY state,status;" + (db:get-cache-stmth dbdat db + "SELECT state,status,count(state) FROM tests WHERE run_id=? AND testname=? AND item_path='' GROUP BY state,status;") run-id testname) res)))) (define (db:get-latest-host-load dbstruct raw-hostname) (let* ((hostname (string-substitute "\\..*$" "" raw-hostname)) @@ -3617,12 +3603,12 @@ (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (cpuload update-time) (set! res (cons cpuload update-time))) - db - "SELECT tr.cpuload, tr.update_time FROM test_rundat tr, tests t WHERE t.host=? AND tr.cpuload != -1 AND tr.test_id=t.id ORDER BY tr.update_time DESC LIMIT 1;" + (db:get-cache-stmth dbdat db + "SELECT tr.cpuload, tr.update_time FROM test_rundat tr, tests t WHERE t.host=? AND tr.cpuload != -1 AND tr.test_id=t.id ORDER BY tr.update_time DESC LIMIT 1;") hostname))) res )) (define (db:set-top-level-from-items dbstruct run-id testname) (let* ((summ (db:get-state-status-summary dbstruct run-id testname)) (find (lambda (state status) @@ -3663,23 +3649,23 @@ dbstruct #f #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (a . b) (set! keyvals (cons a b))) - db - (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id))) + (db:get-cache-stmth dbdat db + (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;")) run-id))) (if (not keyvals) '() (let ((prev-run-ids '())) (db:with-db dbstruct #f #f (lambda (dbdat db) (apply sqlite3:for-each-row (lambda (id) (set! prev-run-ids (cons id prev-run-ids))) - db - (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id))))) + (db:get-cache-stmth dbdat db + (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;")) (append keyvals (list run-id))))) ;; collect all matching tests for the runs then ;; extract the most recent test and return that. (debug:print 4 *default-log-port* "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids) (if (null? prev-run-ids) '() ;; no previous runs? return null @@ -3753,12 +3739,12 @@ #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (id itempath state status run_duration logf comment) (set! res (cons (vector id itempath state status run_duration logf comment) res))) - db - "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '' AND run_id=?;" ;; BUG! WHY NO run_id? + (db:get-cache-stmth dbdat db + "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '' AND run_id=?;") ;; BUG! WHY NO run_id? test-name run-id) res)))) ;;====================================================================== @@ -3779,12 +3765,12 @@ (lambda (tag) (hash-table-set! res tag (delete-duplicates (cons testname (hash-table-ref/default res tag '()))))) tags))) - db - "SELECT testname,tags FROM test_meta") + (db:get-cache-stmth dbdat db + "SELECT testname,tags FROM test_meta")) (hash-table->alist res))))) ;; read the record given a testname (define (db:testmeta-get-record dbstruct testname) (let ((res #f)) @@ -3794,40 +3780,40 @@ #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup) (set! res (vector id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup))) - db - "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE testname=?;" + (db:get-cache-stmth dbdat db + "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE testname=?;") testname) res)))) ;; create a new record for a given testname (define (db:testmeta-add-record dbstruct testname) (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:execute - db - "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname)))) + (db:get-cache-stmth dbdat db + "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');") testname)))) ;; update one of the testmeta fields (define (db:testmeta-update-field dbstruct testname field value) (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:execute - db - (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname)))) + (db:get-cache-stmth dbdat db + (conc "UPDATE test_meta SET " field "=? WHERE testname=?;")) value testname)))) (define (db:testmeta-get-all dbstruct) (db:with-db dbstruct #f #f (lambda (dbdat db) (let ((res '())) (sqlite3:for-each-row (lambda (a . b) (set! res (cons (apply vector a b) res))) - db - "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;") + (db:get-cache-stmth dbdat db + "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")) res)))) ;;====================================================================== ;; M I S C M A N A G E M E N T I T E M S ;;======================================================================