Megatest

Check-in [eabf8b78ac]
Login
Overview
Comment:Cleaned up db:get-subdb a bit, still not right
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.7001-multi-db-02
Files: files | file ages | folders
SHA1: eabf8b78acae173ce3394d8fe2c91ca85c4aa343
User & Date: matt on 2022-03-21 21:03:40
Other Links: branch diff | manifest | tags
Context
2022-03-23
20:11
wip check-in: 9c306cdd3f user: matt tags: v1.7001-multi-db-02
2022-03-21
21:03
Cleaned up db:get-subdb a bit, still not right check-in: eabf8b78ac user: matt tags: v1.7001-multi-db-02
2022-03-20
21:51
fixed params to db:setup check-in: f48837ca86 user: matt tags: v1.7001-multi-db-02
Changes

Modified db.scm from [f56a3b83fd] to [14f049015a].

143
144
145
146
147
148
149

150

151
152
153
154
155
156
157
158
143
144
145
146
147
148
149
150

151

152
153
154
155
156
157
158







+
-
+
-







;; and then return it.
;;
(define (db:get-subdb 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)
	  (db:open-db newsubdb run-id areapath: (dbr:dbstruct-areapath dbstruct) do-sync: #t)
	  (db:open-db dbstruct run-id areapath: (dbr:dbstruct-areapath dbstruct) do-sync: #t)
	  (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->key run-id) newsubdb)
	  newsubdb))))

;; 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
;;    if db already open - return inmem
311
312
313
314
315
316
317
318
319



320
321
322
323
324
325
326
311
312
313
314
315
316
317


318
319
320
321
322
323
324
325
326
327







-
-
+
+
+







         (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
         (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
         (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 subdb run-id #!key (areapath #f)(do-sync #t)) ;; TODO: actually use areapath
  (let* ((tmpdb-stack (dbr:subdb-dbstack subdb))) ;; RA => Returns the first reference in dbstruct
(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
        (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))

Modified dbfile.scm from [cdcbf765ba] to [5c7a6a4fdd].

184
185
186
187
188
189
190



191
192
193
194
195
196
197
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200







+
+
+







	  (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->key run-id) newsubdb)
	  newsubdb))))

(define (dbfile:get-subdb dbstruct run-id)
  (let* ((dbfname (db:run-id->dbname run-id)))
    (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f)))

(define (dbfile:set-subdb dbstruct run-id subdb)
  (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (db:run-id->dbname run-id) subdb))

;; 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
;;    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

Modified tests/simplerun/thebeginning.scm from [615a80af65] to [cba7c153c1].

1
2
3
4
5
6
7
8
9

10
11
12

1
2
3
4
5
6
7
8

9
10
11

12








-
+


-
+
(use trace test)
(import dbfile)
(trace-call-sites #t)

(test #f #t (dbr:dbstruct? (db:setup #t)))
(define dbstruct *dbstruct-dbs*)
(test #f #f (dbfile:get-subdb dbstruct #f)) ;; get main.db (never opened yet)
(test #f #f (dbfile:get-subdb dbstruct 1))  ;; get 1.db

(test #f #t (hash-table? (dbr:dbstruct-subdbs dbstruct) ))
(test #f #f (db:get-subdb dbstruct 1))

(test #f #f (stack? (dbr:subdb-dbstack subdb)))
;; (test #f #f (stack? (dbr:subdb-dbstack subdb)))