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

	  (db:open-db newsubdb 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







>
|
<







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 dbstruct run-id areapath: (dbr:dbstruct-areapath dbstruct) do-sync: #t)

	  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
         (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
    (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))







|
>
|







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 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
	  (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)))




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







>
>
>







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
(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 #f (db:get-subdb dbstruct 1))

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








|


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