@@ -140,11 +140,11 @@ (dbfile:setup do-sync *toppath*)) ;; looks up subdb and returns it, if not found then set up ;; and then return it. ;; -(define (db:get-db dbstruct run-id) +#;(define (db:get-db dbstruct run-id) (let* ((res (dbfile:get-subdb dbstruct run-id))) (if res res (let* ((newsubdb (make-dbr:subdb))) (dbfile:set-subdb dbstruct run-id newsubdb) @@ -187,11 +187,11 @@ ;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no ;; (define (db:with-db dbstruct run-id r/w proc . params) (let* ((have-struct (dbr:dbstruct? dbstruct)) (dbdat (if have-struct ;; this stuff just allows us to call with a db handle directly - (db:get-db dbstruct run-id) + (db:get-subdb dbstruct run-id) #f)) (db (if have-struct ;; this stuff just allows us to call with a db handle directly (dbr:dbdat-dbh dbdat) dbstruct)) (fname (if dbdat @@ -242,11 +242,11 @@ ;; returns: db existed-prior-to-opening ;; RA => Returns a db handler; sets the lock if opened in writable mode ;; ;; (define *db-open-mutex* (make-mutex)) ;; -(define (db:lock-create-open fname initproc) +#;(define (db:lock-create-open fname initproc) (let* ((parent-dir (or (pathname-directory fname)(current-directory))) ;; no parent? go local (raw-fname (pathname-file fname)) (dir-writable (file-write-access? parent-dir)) (file-exists (common:file-exists? fname)) (file-write (if file-exists @@ -313,15 +313,15 @@ (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn)))) ))) ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; -(define (db:open-db dbstruct run-id #!key (areapath #f)(do-sync #t)) +#;(define (db:open-db dbstruct run-id #!key (areapath #f)(do-sync #t)) (let* ((subdb (dbfile:get-subdb dbstruct run-id)) (tmpdb-stack (dbr:subdb-dbstack subdb))) (if (stack? tmpdb-stack) - (db:get-db tmpdb-stack run-id) ;; get previously opened db (will create new db handle if all in the stack are already used + (db:get-subdb tmpdb-stack run-id) ;; get previously opened db (will create new db handle if all in the stack are already used (let* ((max-stale-tmp (configf:lookup-number *configdat* "server" "filling-db-max-stale-seconds" default: 10)) (dbpath (db:dbfile-path)) ;; path to tmp db area (dbname (db:run-id->dbname run-id)) (dbexists (common:file-exists? dbpath)) (mtdbfname (conc *toppath* "/"dbname)) @@ -415,11 +415,11 @@ ;; sync run to disk if touched ;; (define (db:sync-touched dbstruct run-id #!key (force-sync #f)) (let* ((subdb (dbfile:get-subdb dbstruct run-id)) - (tmpdb (db:get-db dbstruct run-id)) + (tmpdb (db:get-subdb dbstruct run-id)) (mtdb (dbr:subdb-mtdb subdb)) (refndb (dbr:subdb-refndb subdb)) (start-t (current-seconds))) (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id) (mutex-lock! *db-multi-sync-mutex*) @@ -1094,11 +1094,11 @@ (res '())) (for-each (lambda (subdb) (let* ((dbname (db:run-id->dbname run-id)) (mtdb (dbr:subdb-mtdb subdb)) - (tmpdb (db:get-db dbstruct run-id)) + (tmpdb (db:get-subdb dbstruct run-id)) (refndb (dbr:subdb-refndb subdb)) (newres (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb))) (stack-push! (dbr:subdb-dbstack subdb) tmpdb) (set! res (cons newres res)))) subdbs) @@ -1511,11 +1511,11 @@ ;; dneeded is minimum space needed, scan for existing archives that ;; are on disks with adequate space and already have this test/itempath ;; archived ;; (define (db:archive-get-allocations dbstruct testname itempath dneeded) - (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db + (let* ((dbdat (db:get-subdb dbstruct #f)) ;; archive tables are in main.db (db (dbr:dbdat-dbh dbdat)) (res '()) (blocks '())) ;; a block is an archive chunck that can be added too if there is space (sqlite3:for-each-row (lambda (id archive-disk-id disk-path last-du last-du-time) @@ -1543,11 +1543,11 @@ ;; returns id of the record, register a disk allocated to archiving and record it's last known ;; available space ;; (define (db:archive-register-disk dbstruct bdisk-name bdisk-path df) - (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db + (let* ((dbdat (db:get-subdb dbstruct #f)) ;; archive tables are in main.db (db (dbr:dbdat-dbh dbdat)) (res #f)) (sqlite3:for-each-row (lambda (id) (set! res id)) @@ -1573,11 +1573,11 @@ ;; record an archive path created on a given archive disk (identified by it's bdisk-id) ;; if path starts with / then it is full, otherwise it is relative to the archive disk ;; preference is to store the relative path. ;; (define (db:archive-register-block-name dbstruct bdisk-id archive-path #!key (du #f)) - (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db + (let* ((dbdat (db:get-subdb dbstruct #f)) ;; archive tables are in main.db (db (dbr:dbdat-dbh dbdat)) (res #f)) ;; first look to see if this path is already registered (sqlite3:for-each-row (lambda (id) @@ -1626,11 +1626,11 @@ "SELECT id,archive_disk_id,disk_path,last_du,last_du_time,creation_time FROM archive_blocks WHERE id=?;" archive-block-id) res)))) ;; (define (db:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey) -;; (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db +;; (let* ((dbdat (db:get-subdb dbstruct #f)) ;; archive tables are in main.db ;; (db (dbr:dbdat-dbh dbdat)) ;; (res '()) ;; (blocks '())) ;; a block is an archive chunck that can be added too if there is space ;; (sqlite3:for-each-row #f) @@ -3895,11 +3895,11 @@ (else msg))) ;; rpc ;; ; This is to be the big daddy call NOPE: Replaced by db:set-state-status-and-roll-up-items ;; ; ;; define (db:test-set-state-status dbstruct run-id test-id state status msg) -;; (let ((dbdat (db:get-db dbstruct run-id))) +;; (let ((dbdat (db:get-subdb dbstruct run-id))) ;; (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) ;; (db:general-call dbdat 'set-test-start-time (list test-id))) ;; ;; (if msg ;; ;; (db:general-call dbdat 'state-status-msg (list state status msg test-id)) ;; ;; (db:general-call dbdat 'state-status (list state status test-id))) @@ -4834,11 +4834,11 @@ (assert #f "FATAL: call to db:extract-ods-file which is not ported yet.") (let* ((keysstr (string-intersperse (map car keypatt-alist) ",")) (keyqry (string-intersperse (map (lambda (p)(conc (car p) " LIKE ? ")) keypatt-alist) " AND ")) (numkeys (length keypatt-alist)) (test-ids '()) - (dbdat (db:get-db dbstruct)) + (dbdat (db:get-subdb dbstruct)) (db (dbr:dbdat-dbh dbdat)) (windows (and pathmod (substring-index "\\" pathmod))) (tempdir (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id))) (runsheader (append (list "Run Id" "Runname") ; 0 1 (map car keypatt-alist) ; + N = length keypatt-alist