Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -84,41 +84,75 @@
 
 ;;======================================================================
 ;;  R E C O R D S
 ;;======================================================================
 
-;; each db entry is a pair ( db . dbfilepath )
-;; I propose this record evolves into the area record
+;; each db entry in the hash is a dbr:dbdat
+;; this record will evolve into the area record
 ;;
 (defstruct dbr:dbstruct 
-  (tmpdb       #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))
-  (locdbs      (make-hash-table)) ;; legacy junk in db_records
-  )                ;; goal is to converge on one struct for an area but for now it is too confusing
-  
-;; Returns the database for a particular run-id fron the dbstruct:localdbs
-;;
-(define (dbr:dbstruct-localdb v run-id)
-  (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))
-
-(define (dbr:dbstruct-localdb-set! v run-id db)
-  (hash-table-set! (dbr:dbstruct-locdbs v) run-id db))
+  (mtdb        #f)
+  (dbs         (make-hash-table)) ;; id => db
+  (read-only   #f)                ;; the area is read-only
+  (stmt-cache  (make-hash-table)))
+
+(defstruct dbr:dbdat
+  (db          #f)
+  (inmem       #f)
+  (last-sync   0)
+  (run-id      #f)
+  (fname       #f))
+  
+;; Returns the database for a particular run-id fron dbstruct-dbs
+;;
+(define (dbr:dbstruct-db v run-id)
+  (hash-table-ref/default (dbr:dbstruct-dbs v) run-id #f))
+
+(define (dbr:dbstruct-db-set! v run-id db)
+  (hash-table-set! (dbr:dbstruct-dbs v) run-id db))
+
+(define (db:run-id->first-num run-id)
+  (let* ((s (number->string run-id))
+	 (l (string-length s)))
+    (substring s (- l 1) l)))
+
+(define (db:run-id->path run-id)
+  (let ((firstnum (db:run-id->first-num run-id)))
+    (conc *toppath* "/.dbs/"firstnum"/"run-id".db")))
 
 ;; record for keeping state,status and count for doing roll-ups in
 ;; iterated tests
 ;;
 (defstruct dbr:counts
   (state #f)
   (status #f)
   (count  0)) 
 
+;; Get/open a database
+;;    if run-id => get run specific db
+;;    if #f     => get main db
+;;    if db already open - return inmem
+;;    if db not open, open inmem, rundb and sync then return inmem
+;;    inuse gets set automatically for rundb's
+;;
+(define (db:get-db dbstruct run-id)
+  (let* ((db    (dbr:dbstruct-db dbstruct run-id))
+	 (newdb (if db
+		    #f
+		    (db:open-megatest-db path: (db:run-id->path run-id)))))
+    (if db
+	db
+	(let* 
+    (db:open-db dbstruct run-id)))
+
+;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
+(define (db:dbdat-get-db dbdat)
+  (dbr:dbdat-db dbdat))
+
+(define (db:dbdat-get-path dbdat)
+  (dbr:dbdat-fname dbdat))
+
 ;;======================================================================
 ;; alist-of-alists
 ;;======================================================================
 ;; 
 ;; (define (db:aa-set! dat key1 key2 val)
@@ -125,11 +159,10 @@
 ;;   (let loop ((
 
 ;;======================================================================
 ;; hash of hashs
 ;;======================================================================
-
 
 (define (db:hoh-set! dat key1 key2 val)
   (let* ((subhash (hash-table-ref/default dat key1 #f)))
     (if subhash
 	(hash-table-set! subhash key2 val)
@@ -147,15 +180,10 @@
 	 (stmth             (db:hoh-get stmt-cache db stmt)))
     (or stmth
 	(let* ((newstmth (sqlite3:prepare db stmt)))
 	  (db:hoh-set! stmt-cache db stmt newstmth)
 	  newstmth))))
-
-;;======================================================================
-;; Pulled from db.scm
-;;======================================================================
-
 
 ;;======================================================================
 ;; SQLITE3 HELPERS
 ;;======================================================================
 
@@ -179,37 +207,10 @@
 	   (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)))
 
-;; Get/open a database
-;;    if run-id => get run specific db
-;;    if #f     => get main db
-;;    if db already open - return inmem
-;;    if db not open, open inmem, rundb and sync then return inmem
-;;    inuse gets set automatically for rundb's
-;;
-(define (db:get-db dbstruct) ;;  run-id) 
-  (if (stack? (dbr:dbstruct-dbstack dbstruct))
-      (if (stack-empty? (dbr:dbstruct-dbstack dbstruct))
-          (let ((newdb (db:open-megatest-db path: (common:get-db-tmp-area))))
-            ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
-            newdb)
-          (stack-pop! (dbr:dbstruct-dbstack dbstruct)))
-      (db:open-db dbstruct)))
-
-;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
-(define (db:dbdat-get-db dbdat)
-  (if (pair? dbdat)
-      (car dbdat)
-      dbdat))
-
-(define (db:dbdat-get-path dbdat)
-  (if (pair? dbdat)
-      (cdr dbdat)
-      #f))
-
 (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)
@@ -224,11 +225,11 @@
   (let* ((have-struct (dbr:dbstruct? dbstruct))
          (dbdat     (if have-struct 
 			(db:get-db dbstruct)
 			#f))
 	 (db        (if have-struct
-			(db:dbdat-get-db dbdat)
+			(db:dbdat-get-db dbdat run-id)
 			dbstruct))
 	 (fname     (db:dbdat-get-path dbdat))
 	 (use-mutex (> *api-process-request-count* 25))) ;; was 25
     (if (and use-mutex
 	     (common:low-noise-print 120 "over-50-parallel-api-requests"))
@@ -251,11 +252,11 @@
 	  (db:generic-error-printout exn "ERROR: database " fname
 				     " is locked. Try copying to another location, remove original and copy back."))
      (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))))))
+				     ((condition-property-accessor 'exn 'message) exn))))))
       
 ;;======================================================================
 ;; K E E P   F I L E D B   I N   dbstruct
 ;;======================================================================
 
@@ -306,23 +307,23 @@
            (if (not readyexists)
                (common:simple-file-lock-and-wait lockfname))
            (let ((db      (sqlite3:open-database fname)))
              (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
              (sqlite3:execute db "PRAGMA synchronous = 0;")
-             (if (and (configf:lookup *configdat* "setup" "tmp_mode") (string-match "^/tmp/.*" fname))
+             #;(if (and (configf:lookup *configdat* "setup" "tmp_mode") (string-match "^/tmp/.*" fname))
                  (begin
                    ;;(print "DEBUG: Setting tmp_mode for " fname) 
                    (sqlite3:execute db (configf:lookup *configdat* "setup" "tmp_mode"))
                    )
                  )  
-             (if (and (configf:lookup *configdat* "setup" "nfs_mode") (not (string-match "^/tmp/.*" fname)))
+             #;(if (and (configf:lookup *configdat* "setup" "nfs_mode") (not (string-match "^/tmp/.*" fname)))
                  (begin
                    ;;(print "DEBUG: Setting nfs_mode for " fname)
                    (sqlite3:execute db (configf:lookup *configdat* "setup" "nfs_mode"))
                    )
                  )  
-             (if (and (not (or (configf:lookup *configdat* "setup" "tmp_mode") (configf:lookup *configdat* "setup" "nfs_mode")))  
+             #;(if (and (not (or (configf:lookup *configdat* "setup" "tmp_mode") (configf:lookup *configdat* "setup" "nfs_mode")))  
                       (configf:lookup *configdat* "setup" "use-wal")
                       (string-match "^/tmp/.*" fname)) ;; this is a file in /tmp
                  (sqlite3:execute db "PRAGMA journal_mode=WAL;")
                  (debug:print 2 *default-log-port* "Creating " fname " in NON-WAL mode."))
              (if (not file-exists)
@@ -359,50 +360,37 @@
 	)))
 
 
 ;; 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 #!key (areapath #f)(do-sync #t)) ;; TODO: actually use areapath
-  (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct
-    (if (stack? tmpdb-stack)
-	(db:get-db tmpdb-stack) ;; 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       (common:get-db-tmp-area ))      ;; path to tmp db area
-               (dbexists     (common:file-exists? dbpath))
-	       (tmpdbfname   (conc dbpath "/megatest.db"))
-	       (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
-               (mtdbexists   (common:file-exists? (conc *toppath* "/megatest.db")))
-							 
-               (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db"))   #f))
-	        		 (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) 
-               (mtdb         (db:open-megatest-db))
-               (mtdbpath     (db:dbdat-get-path mtdb))
-               (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
-               (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
-               (write-access (file-writable? mtdbpath))
-	       ;(mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath)   #f)) ; moving this before db:open-megatest-db is called. if wal mode is on -WAL and -shm file get created with causing the  tmpdbmodtime timestamp always greater than mtdbmodtime
-	       ;(tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) 
-					;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced
-          ;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f))    
-          ;(fmt (file-modification-time tmpdbfname))
-	       (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
+(define (db:open-db dbstruct run-id)
+  (let* ((max-stale-tmp (configf:lookup-number *configdat* "server" "filling-db-max-stale-seconds" default: 10))
+	 (dbpath       (common:get-db-tmp-area ))      ;; path to tmp db area
+	 (dbexists     (common:file-exists? dbpath))
+	 (tmpdbfname   (conc dbpath "/megatest.db"))
+	 (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
+	 (mtdbexists   (common:file-exists? (conc *toppath* "/megatest.db")))
+	 
+	 (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db"))   #f))
+	 (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) 
+	 (mtdb         (db:open-megatest-db))
+	 (mtdbpath     (db:dbdat-get-path mtdb))
+	 (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
+	 (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
+	 (write-access (file-writable? mtdbpath))
+	 (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
 
           (when write-access
             (sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger")
             (sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))
           
-         ;(print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db"))
-	        ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
-          (if (and dbexists (not write-access))
+	  (if (and dbexists (not write-access))
               (begin
                 (set! *db-write-access* #f)
                 (dbr:dbstruct-read-only-set! dbstruct #t)))
           (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
           (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
-          (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
-          (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
-          (dbr:dbstruct-refndb-set! dbstruct refndb)
           (if (and  (or (not dbfexists)
 			(and modtimedelta
 			     (> modtimedelta max-stale-tmp))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
 		    do-sync)
 	      (begin
@@ -460,14 +448,14 @@
 ;;   NOTE: returns a dbdat not a dbstruct!
 ;;
 
 ;;(define (db:reopen-megatest-db
 
-(define (db:open-megatest-db #!key (path #f)(name #f))
-  (let* ((dbdir        (or path *toppath*))
-         (dbpath       (conc  dbdir "/" (or name "megatest.db")))
-	 (dbexists     (common:file-exists? dbpath))
+(define (db:open-megatest-db fname)
+  (let* ((dbexists     (if (equal? fname ":inmem:")
+			   #f
+			   (common:file-exists? dbpath)))
 	 (db           (db:lock-create-open dbpath
 					    (lambda (db)
                                               (db:initialize-main-db db)
 					      ;;(db:initialize-run-id-db db)
 					      )))