Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -135,11 +135,11 @@ (define *default-log-port* (current-error-port)) (define *time-zero* (current-seconds)) ;; for the watchdog (define *default-area-tag* "local") ;; DATABASE -(define *dbstruct-db* #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this. +(define *dbstruct-dbs* #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this. ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > (define *db-stats-mutex* (make-mutex)) ;; db access (define *db-last-access* (current-seconds)) ;; last db access, used in server Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -54,36 +54,72 @@ ;; each db entry is a pair ( db . dbfilepath ) ;; NOTE: Need one dbr:dbstruct per main.db, 1.db ... ;; (defstruct dbr:dbstruct (dbname #f) - (tmpdbs #f) - (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack - (mtdb #f) - (refndb #f) + (dbdats (make-hash-table)) ;; id => dbdat + ;; (tmpdbs #f) + ;; (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack + ;; (mtdb #f) + ;; (refndb #f) (homehost #f) ;; not used yet (on-homehost #f) ;; not used yet (read-only #f) - (stmt-cache (make-hash-table)) + ;; (stmt-cache (make-hash-table)) ) ;; goal is to converge on one struct for an area but for now it is too confusing +(defstruct dbr:dbdat + (db #f) ;; should rename this to oddb for on disk db + (tmpdb #f) + (dbhstack #f) ;; do not init with a stack + (last-sync 0) + (last-write (current-seconds)) + (run-id #f) + (fname #f)) +; Returns the dbdat for a particular dbfile inside the area +;; +(define (dbr:dbstruct-get-dbdat dbstruct dbfile) + (hash-table-ref/default (dbr:dbstruct-dbdats dbstruct) dbfile #f)) + +(define (dbr:dbstruct-dbdat-put! dbstruct dbfile db) + (hash-table-set! (dbr:dbstruct-dbdats dbstruct) dbfile db)) + +(define (db:run-id->first-num run-id) + (let* ((s (number->string run-id)) + (l (string-length s))) + (substring s (- l 1) l))) + +;; 1234 => 4/1234.db +;; #f => 0/main.db +;; (abandoned the idea of num/db) +;; +(define (db:run-id->path apath run-id) + (conc apath"/"(db:run-id->dbname run-id))) + +(define (db:dbname->path apath dbname) + (conc apath"/"dbname)) + +;; (let ((firstnum (if run-id +;; (db:run-id->first-num run-id) +;; "0"))) +;; (conc *toppath* "/.dbs/" ;; firstnum"/" +;; (or run-id "main")".db"))) + +(define (db:run-id->dbname run-id) + (if (number? run-id) + (conc ".db/" (modulo run-id 100) ".db") + (conc ".db/main.db"))) + ;; record for keeping state,status and count for doing roll-ups in ;; iterated tests ;; (defstruct dbr:counts (state #f) (status #f) (count 0)) -;;====================================================================== -;; alist-of-alists -;;====================================================================== -;; -;; (define (db:aa-set! dat key1 key2 val) -;; (let loop (( - ;;====================================================================== ;; hash of hashs ;;====================================================================== @@ -131,10 +167,19 @@ (begin (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) (print-call-chain (current-error-port)) default))) (apply sqlite3:first-result db stmt params))) + +(define (db:generic-error-printout exn . message) + (print-call-chain (current-error-port)) + (apply debug:print-error 0 *default-log-port* message) + (debug:print-error 0 *default-log-port* ;; " params: " params + ", error: " ((condition-property-accessor 'exn 'message) exn) + ", arguments: " ((condition-property-accessor 'exn 'arguments) exn) + ", location: " ((condition-property-accessor 'exn 'location) exn) + )) ;; Get/open a database ;; if run-id => get run specific db ;; if #f => get main db ;; if run-id is a string treat it as a filename @@ -209,33 +254,10 @@ (exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem.")) (exn () (db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn)))))) -;;====================================================================== -;; K E E P F I L E D B I N dbstruct -;;====================================================================== - -;; (define (db:get-filedb dbstruct run-id) -;; (let ((db (vector-ref dbstruct 2))) -;; (if db -;; db -;; (let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db")))) -;; (vector-set! dbstruct 2 fdb) -;; fdb)))) -;; -;; ;; Can also be used to save arbitrary strings -;; ;; -;; (define (db:save-path dbstruct path) -;; (let ((fdb (db:get-filedb dbstruct)))b -;; (filedb:register-path fdb path))) -;; -;; ;; Use to get a path. To get an arbitrary string see next define -;; ;; -;; (define (db:get-path dbstruct id) -;; (let ((fdb (db:get-filedb dbstruct))) -;; (filedb:get-path db id))) ;; NB// #f => return dbdir only ;; (was planned to be; zeroth db with name=main.db) ;; ;; If run-id is #f return to create and retrieve the path where the db will live. @@ -422,11 +444,11 @@ (when (not *toppath*) (debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup") (launch:setup areapath: areapath)) (set! *dbstruct-dbs* dbstructs) ;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct)) - dbstruct)))) + dbstructs)))) ;; (else ;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost)) ;; (exit 1)))) ;; Open the classic megatest.db file (defaults to open in toppath)