71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
(read-only #f)
(subdbs (make-hash-table))
;;
;; for the inmem approach (see dbmod.scm)
;; this is one db per server
(inmem #f) ;; handle for the in memory copy
(dbfile #f) ;; path to the db file on disk
(ondiskdb #f) ;; handle for the on-disk file
(dbdat #f) ;; create a dbdat for the downstream calls such as db:with-db
(last-update 0)
(sync-proc #f)
)
;; NOTE: Need one dbr:subdb per main.db, 1.db ...
|
>
|
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(read-only #f)
(subdbs (make-hash-table))
;;
;; for the inmem approach (see dbmod.scm)
;; this is one db per server
(inmem #f) ;; handle for the in memory copy
(dbfile #f) ;; path to the db file on disk
(dbfname #f) ;; short name of db file on disk (used to validate accessing correct db)
(ondiskdb #f) ;; handle for the on-disk file
(dbdat #f) ;; create a dbdat for the downstream calls such as db:with-db
(last-update 0)
(sync-proc #f)
)
;; NOTE: Need one dbr:subdb per main.db, 1.db ...
|
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
(define *db-with-db-mutex* (make-mutex))
(define *max-api-process-requests* 0)
(define *api-process-request-count* 0)
(define *db-write-access* #t)
(define *db-last-sync* 0) ;; last time the sync to megatest.db happened
(define *db-multi-sync-mutex* (make-mutex)) ;; protect access to *db-sync-in-progress*, *db-last-sync*
(define *db-last-access* (current-seconds))
(define (db:generic-error-printout exn . message)
(print-call-chain (current-error-port))
(apply dbfile:print-err message)
(dbfile:print-err
", error: " ((condition-property-accessor 'exn 'message) exn)
", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
|
>
>
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(define *db-with-db-mutex* (make-mutex))
(define *max-api-process-requests* 0)
(define *api-process-request-count* 0)
(define *db-write-access* #t)
(define *db-last-sync* 0) ;; last time the sync to megatest.db happened
(define *db-multi-sync-mutex* (make-mutex)) ;; protect access to *db-sync-in-progress*, *db-last-sync*
(define *db-last-access* (current-seconds))
(define *db-transaction-mutex* (make-mutex))
(define (db:generic-error-printout exn . message)
(print-call-chain (current-error-port))
(apply dbfile:print-err message)
(dbfile:print-err
", error: " ((condition-property-accessor 'exn 'message) exn)
", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
|
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
|
(define (dbfile:with-simple-file-lock fname proc #!key (expire-time 300))
(let ((gotlock (dbfile:simple-file-lock-and-wait fname expire-time: expire-time)))
(if gotlock
(let ((res (proc)))
(dbfile:simple-file-release-lock fname)
res)
(assert #t "FATAL: simple file lock never got a lock."))))
(define (db:get-cache-stmth dbdat db stmt)
(let* (;; (dbdat (dbfile:get-dbdat dbstruct run-id))
(stmt-cache (dbr:dbdat-stmt-cache dbdat))
;; (stmth (db:hoh-get stmt-cache db stmt))
(stmth (hash-table-ref/default stmt-cache stmt #f)))
(or stmth
(let* ((newstmth (sqlite3:prepare db stmt)))
;; (db:hoh-set! stmt-cache db stmt newstmth)
(hash-table-set! stmt-cache stmt newstmth)
newstmth))))
)
|
|
>
>
>
|
|
|
|
|
|
|
|
|
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
|
(define (dbfile:with-simple-file-lock fname proc #!key (expire-time 300))
(let ((gotlock (dbfile:simple-file-lock-and-wait fname expire-time: expire-time)))
(if gotlock
(let ((res (proc)))
(dbfile:simple-file-release-lock fname)
res)
(assert #t "FATAL: simple file lock never got a lock."))))
(define *get-cache-stmth-mutex* (make-mutex))
(define (db:get-cache-stmth dbdat db stmt)
(mutex-lock! *get-cache-stmth-mutex*)
(let* (;; (dbdat (dbfile:get-dbdat dbstruct run-id))
(stmt-cache (dbr:dbdat-stmt-cache dbdat))
;; (stmth (db:hoh-get stmt-cache db stmt))
(stmth (hash-table-ref/default stmt-cache stmt #f))
(result (or stmth
(let* ((newstmth (sqlite3:prepare db stmt)))
;; (db:hoh-set! stmt-cache db stmt newstmth)
(hash-table-set! stmt-cache stmt newstmth)
newstmth))))
(mutex-unlock! *get-cache-stmth-mutex*)
result))
)
|