Megatest

Diff
Login

Differences From Artifact [ff07e9b5e3]:

To Artifact [7617a09c16]:


71
72
73
74
75
76
77

78
79
80
81
82
83
84
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
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
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)))
    (or stmth
	(let* ((newstmth (sqlite3:prepare db stmt)))
	  ;; (db:hoh-set! stmt-cache db stmt newstmth)
	  (hash-table-set! stmt-cache stmt newstmth)
	  newstmth))))


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

)