189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
;; (abandoned the idea of num/db)
;;
(define (dbfile:run-id->path apath run-id)
(conc apath"/"(dbfile:run-id->dbname run-id)))
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
;; POTENTIAL BUG: this implementation could produce a db file if run-id is neither #f or a number
(define (dbfile:run-id->dbname run-id)
(cond
((number? run-id) (conc ".megatest/" (modulo run-id 100) ".db"))
((not run-id) (conc ".megatest/main.db"))
(else run-id)))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (dbfile:setup do-sync areapath tmppath)
(cond
|
>
>
>
>
>
>
>
>
>
<
<
|
<
|
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
;; (abandoned the idea of num/db)
;;
(define (dbfile:run-id->path apath run-id)
(conc apath"/"(dbfile:run-id->dbname run-id)))
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
(define num-run-dbs (make-parameter 2))
(define (dbfile:run-id->dbnum run-id)
(cond
((number? run-id)
(modulo run-id (num-run-dbs)))
((not run-id) "main") ;; 0 or main?
(else run-id)))
;; POTENTIAL BUG: this implementation could produce a db file if run-id is neither #f or a number
(define (dbfile:run-id->dbname run-id)
(conc ".megatest/"(dbfile:run-id->dbnum run-id)".db"))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (dbfile:setup do-sync areapath tmppath)
(cond
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
(if (stack-empty? (dbr:subdb-dbstack subdb))
#f
(begin
(stack-pop! (dbr:subdb-dbstack subdb))))))
;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
(let* ((subdb (dbfile:get-subdb dbstruct run-id)))
(stack-push! (dbr:subdb-dbstack subdb) dbdat)
dbdat))
;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
(let* ((dbname (dbfile:run-id->dbname run-id))
(areapath (dbr:dbstruct-areapath dbstruct))
|
|
|
>
>
>
>
|
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
(if (stack-empty? (dbr:subdb-dbstack subdb))
#f
(begin
(stack-pop! (dbr:subdb-dbstack subdb))))))
;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
(let* ((subdb (dbfile:get-subdb dbstruct run-id))
(dbstk (dbr:subdb-dbstack subdb))
(count (stack-count dbstk)))
(if (> count 15)
(dbfile:print-err "WARNING: stack for "run-id".db is large."))
(stack-push! dbstk dbdat)
dbdat))
;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
(let* ((dbname (dbfile:run-id->dbname run-id))
(areapath (dbr:dbstruct-areapath dbstruct))
|
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
|
(define qif-slope (make-parameter 100))
;; create a dropping near the db file in a qif dir
;; use count of such files to gate queries (queries in flight)
;;
(define (dbfile:wait-for-qif fname run-id params)
(let* ((thedir (pathname-directory fname))
(destdir (conc thedir"/qif-"run-id))
(uniqn (get-area-path-signature (conc (or run-id "main") params)))
(crumbn (conc destdir"/"(current-seconds)"-"uniqn"."(current-process-id))))
(if (not (file-exists? destdir))(create-directory (conc destdir"/attic") #t))
(let loop ((count 0))
(let* ((currlks (glob (conc destdir"/*")))
(numqrys (length currlks))
(delayval (cond ;; do a droopish curve
((> numqrys 50)
|
>
|
|
|
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
|
(define qif-slope (make-parameter 100))
;; create a dropping near the db file in a qif dir
;; use count of such files to gate queries (queries in flight)
;;
(define (dbfile:wait-for-qif fname run-id params)
(let* ((thedir (pathname-directory fname))
(dbnum (dbfile:run-id->dbnum run-id))
(destdir (conc thedir"/qif-"dbnum))
(uniqn (get-area-path-signature (conc dbnum params)))
(crumbn (conc destdir"/"(current-seconds)"-"uniqn"."(current-process-id))))
(if (not (file-exists? destdir))(create-directory (conc destdir"/attic") #t))
(let loop ((count 0))
(let* ((currlks (glob (conc destdir"/*")))
(numqrys (length currlks))
(delayval (cond ;; do a droopish curve
((> numqrys 50)
|