Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -25,10 +25,11 @@ (declare (unit dashboard-tests)) (declare (uses common)) (declare (uses db)) (declare (uses gutils)) (declare (uses ezsteps)) +(declare (uses sdb)) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") @@ -73,11 +74,11 @@ lbl) (store-label "testcomment" (iup:label "TestComment " #:expand "HORIZONTAL") (lambda (testdat) - (db:test-get-comment testdat))) + (sdb:qry 'getstr (db:test-get-comment testdat)))) (store-label "testid" (iup:label "TestId " #:expand "HORIZONTAL") (lambda (testdat) (db:test-get-id testdat))) @@ -180,15 +181,15 @@ (iup:label "" #:expand "VERTICAL"))) (apply iup:vbox ; #:expand "YES" (list ;; NOTE: Yes, the host can change! (store-label "HostName" - (iup:label (db:test-get-host testdat) #:expand "HORIZONTAL") + (iup:label (sdb:qry 'getstr (db:test-get-host testdat)) #:expand "HORIZONTAL") (lambda (testdat)(db:test-get-host testdat))) (store-label "Uname" (iup:label " " #:expand "HORIZONTAL") - (lambda (testdat)(db:test-get-uname testdat))) + (lambda (testdat)(sdb:qry 'getstr (db:test-get-uname testdat)))) (store-label "DiskFree" (iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL") (lambda (testdat)(conc (db:test-get-diskfree testdat)))) (store-label "CPULoad" (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL") Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -28,10 +28,11 @@ (declare (uses keys)) (declare (uses ods)) (declare (uses fs-transport)) (declare (uses client)) (declare (uses mt)) +(declare (uses sdb)) (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") (include "run_records.scm") @@ -60,10 +61,11 @@ #f)))) (if val (begin (debug:print-info 9 "db:set-sync, setting pragma synchronous to " val) (sqlite3:execute db (conc "PRAGMA synchronous = '" val "';")))))) +;; (sqlite3:execute db "PRAGMA synchronous = normal;")))) ;; need a default? (define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (if (not *toppath*) (if (not (setup-for-run)) (begin @@ -863,13 +865,11 @@ (let ((finalres (vector header res))) ;; (hash-table-set! *run-info-cache* run-id finalres) finalres))) (define (db:set-comment-for-run db run-id comment) - (debug:print-info 11 "db:set-comment-for-run START run-id: " run-id " comment: " comment) - (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id) - (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment)) + (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" (sdb:qry 'getid comment) run-id)) ;; does not (obviously!) removed dependent data. But why not!!? (define (db:delete-run db run-id) (common:clear-caches) ;; don't trust caches after doing any deletion ;; First set any related tests to DELETED @@ -1165,25 +1165,25 @@ (define (cdb:tests-update-run-duration serverdat test-id minutes) (cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id)) (define (cdb:tests-update-uname-host serverdat test-id uname hostname) - (cdb:client-call serverdat 'update-uname-host #t *default-numtries* uname hostname test-id)) + (cdb:client-call serverdat 'update-uname-host #t *default-numtries* (sdb:qry 'getid uname)(sdb:qry 'getid hostname) test-id)) ;; speed up for common cases with a little logic ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id ;; (define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment) (cond ((and newstate newstatus newcomment) - (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id)) + (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus (sdb:qry 'getid newcomment) test-id)) ((and newstate newstatus) (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id)) (else (if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id)) (if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id)) - (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))) + (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" (sdb:qry 'getid newcomment) test-id)))) (mt:process-triggers test-id newstate newstatus)) ;; Never used ;; (define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state) ;; (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" @@ -1345,11 +1345,11 @@ (define (db:test-set-comment db test-id comment) (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" - comment test-id)) + (sdb:qry 'getid comment) test-id)) (define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir) (cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path)) (define (cdb:test-set-rundir-by-test-id serverdat test-id rundir) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -25,10 +25,11 @@ (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) (declare (uses daemon)) (declare (uses db)) +(declare (uses sdb)) (define *db* #f) ;; this is only for the repl, do not use in general!!!! (include "common_records.scm") (include "key_records.scm") @@ -290,10 +291,11 @@ ;;====================================================================== ;; Misc setup stuff ;;====================================================================== (debug:setup) +(sdb:qry 'init #f) (if (args:get-arg "-logging")(set! *logging* #t)) (if (debug:debug-mode 3) ;; we are obviously debugging (set! open-run-close open-run-close-no-exception-handling)) @@ -1164,10 +1166,12 @@ ;; this is the socket if we are a client ;; (if (and *runremote* ;; (socket? *runremote*)) ;; (close-socket *runremote*)) + +(sdb:qry 'finalize! #f) (if (not *didsomething*) (debug:print 0 help)) ;; (if *runremote* (rpc:close-all-connections!))