20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
;;======================================================================
;; Database access
;;======================================================================
;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc
(use (srfi 18) extras tcp stack)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records matchable)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
|
|
|
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
;;======================================================================
;; Database access
;;======================================================================
;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc
(use (srfi 18)
extras
tcp
stack
(prefix sqlite3 sqlite3:)
srfi-1
posix
regex
regex-case
srfi-69
csv-xml
s11n
md5
message-digest
(prefix base64 base64:)
format
dot-locking
z3
typed-records
matchable)
(declare (unit db))
(declare (uses common))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
|
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
|
(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 (db:dbfile-path )) ;; path to tmp db area
(dbname (db:run-id->dbname run-id))
(dbexists (common:file-exists? dbpath))
(mtdbfname (conc *toppath* "/.db/"dbname))
(mtdbexists (common:file-exists? mtdbfname))
(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbfname) #f))
(mtdb (db:open-megatest-db mtdbfname))
;; the reference db for syncing
(refdbfname (conc dbpath "/ref_"dbname))
(refndb (db:open-megatest-db refdbfname))
;; (mtdbpath (db:dbdat-get-path mtdb))
;; the tmpdb
(tmpdbfname (conc dbpath"/"dbname)) ;; /tmp/<stuff>/.db/[main|1,2...].db
(tmpdb (db:open-megatest-db tmpdbfname)) ;; lock-create-open dbpath db:initialize-main-db))
(dbfexists (common:file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db")))
(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
|
|
|
|
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
(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 (db:dbfile-path )) ;; path to tmp db area
(dbname (db:run-id->dbname run-id))
(dbexists (common:file-exists? dbpath))
(mtdbfname (conc *toppath* "/"dbname))
(mtdbexists (common:file-exists? mtdbfname))
(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbfname) #f))
(mtdb (db:open-megatest-db mtdbfname))
;; the reference db for syncing
(refdbfname (conc dbpath "/"dbname"_ref"))
(refndb (db:open-megatest-db refdbfname))
;; (mtdbpath (db:dbdat-get-path mtdb))
;; the tmpdb
(tmpdbfname (conc dbpath"/"dbname)) ;; /tmp/<stuff>/.db/[main|1,2...].db
(tmpdb (db:open-megatest-db tmpdbfname)) ;; lock-create-open dbpath db:initialize-main-db))
(dbfexists (common:file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db")))
(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
db
"select max(lup) from ( select max(last_update) as lup from tests union select max(last_update) as lup from runs);")
last-update-time))
;))
;; set up a single db (e.g. main.db, 1.db ... etc.)
;;
(define (db:setup-db dbstructs run-id)
(let* ((dbname (db:run-id->dbname run-id))
(dbstruct (or (hash-table-ref/default dbstructs dbname #f)
(make-dbr:dbstruct))))
(db:open-db dbstruct run-id areapath: areapath do-sync: do-sync)
(hash-table-set! dbstructs dbname dbstruct)
dbstruct))
;; 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.
|
|
|
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
|
db
"select max(lup) from ( select max(last_update) as lup from tests union select max(last_update) as lup from runs);")
last-update-time))
;))
;; set up a single db (e.g. main.db, 1.db ... etc.)
;;
(define (db:setup-db dbstructs areapath run-id)
(let* ((dbname (db:run-id->dbname run-id))
(dbstruct (or (hash-table-ref/default dbstructs dbname #f)
(make-dbr:dbstruct))))
(db:open-db dbstruct run-id areapath: areapath do-sync: #t)
(hash-table-set! dbstructs dbname dbstruct)
dbstruct))
;; 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.
|