82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
+
-
-
-
+
+
+
+
-
+
+
+
+
+
+
-
-
+
+
+
+
-
+
|
newdbstruct))))
;;======================================================================
;; The inmem one-db file per server method goes in here
;;======================================================================
(define (dbmod:with-db dbstruct run-id r/w proc params)
(let* ((use-mutex (> *api-process-request-count* 15))
(let* ((dbdat (dbmod:open-db dbstruct run-id (dbfile:db-init-proc)))
(dbh (dbr:dbdat-dbh dbdat)) ;; this will be the inmem handle
(dbfile (dbr:dbdat-dbfile dbdat)))
(apply proc dbdat dbh params)))
(let* ((res (apply proc dbdat dbh params)))
(if use-mutex (mutex-unlock! *db-with-db-mutex*))
res)))
(define (db:with-db dbstruct run-id r/w proc . params)
(dbmod:with-db dbstruct run-id r/w proc params))
(define (dbmod:open-inmem-db initproc)
(let* ((db (sqlite3:open-database ":memory:"))
(define (dbmod:open-inmem-db init-proc #!optional (dbfullname #f))
(let* ((db (if dbfullname
(dbmod:safely-open-db dbfullname init-proc #t)
(sqlite3:open-database ":memory:")))
(handler (sqlite3:make-busy-timeout 3600)))
(sqlite3:set-busy-handler! db handler)
(initproc db)
(init-proc db)
db))
(define (dbmod:open-db dbstruct run-id dbinit)
(or (dbr:dbstruct-dbdat dbstruct)
(let* ((dbdat (make-dbr:dbdat
dbfile: (dbr:dbstruct-dbfile dbstruct)
dbh: (dbr:dbstruct-inmem dbstruct)
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
-
+
-
-
-
-
-
-
-
-
|
(else
(debug:print 0 *default-log-port* "Unknown dbfile:sync-method setting: "
(dbfile:sync-method)))))
(else
(debug:print 0 *default-log-port* "Unknown dbfile:cache-method setting: "
(dbfile:cache-method))
#f)))
(define (dbmod:safely-open-db dbfullname init-proc write-access)
(dbfile:with-simple-file-lock
(conc dbfullname".lock")
(lambda ()
(let* ((db (sqlite3:open-database dbfullname))
(handler (sqlite3:make-busy-timeout 136000)))
(sqlite3:set-busy-handler! db handler)
(if write-access
(init-proc db))
db))))
;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;;
(define (dbmod:open-dbmoddb areapath run-id dbfname-in init-proc keys
#!key (dbstruct-in #f)
(syncdir 'todisk))
(let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
(dbfname (or dbfname-in (dbmod:run-id->dbfname run-id)))
(dbpath (dbmod:get-dbdir dbstruct)) ;; directory where all the .db files are kept
(dbfullname (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
(dbexists (file-exists? dbfullname))
(inmem (dbmod:open-inmem-db init-proc))
(inmem (dbmod:open-inmem-db init-proc
;; (conc "/tmp/"dbfname) ;; will create /tmp file
))
(write-access (file-write-access? dbpath))
(db (dbfile:with-simple-file-lock
(db (dbmod:safely-open-db dbfullname init-proc write-access))
(conc dbfullname".lock")
(lambda ()
(let* ((db (sqlite3:open-database dbfullname))
(handler (sqlite3:make-busy-timeout 136000)))
(sqlite3:set-busy-handler! db handler)
(if write-access
(init-proc db))
db))))
|
567
568
569
570
571
572
573
574
575
576
|
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
|
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(loop (file-exists? fullpath)
(- count 1)))
(begin
(debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.")
(if remove (system (conc "rm -rf " fullpath)))
#f)))
#t))))))
;;======================================================================
;; M E T A G E T A N D S E T V A R S
;;======================================================================
)
|