| ︙ | | | ︙ | |
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;;======================================================================
;; each db entry is a pair ( db . dbfilepath )
;; NOTE: Need one dbr:dbstruct per main.db, 1.db ...
;;
(defstruct dbr:dbstruct
(dbname #f)
(tmpdbs #f)
(dbstack #f) ;; stack for tmp db handles, do not initialize with a stack
(mtdb #f)
(refndb #f)
(homehost #f) ;; not used yet
(on-homehost #f) ;; not used yet
(read-only #f)
(stmt-cache (make-hash-table))
) ;; goal is to converge on one struct for an area but for now it is too confusing
;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts
(state #f)
(status #f)
(count 0))
;;======================================================================
;; alist-of-alists
;;======================================================================
;;
;; (define (db:aa-set! dat key1 key2 val)
;; (let loop ((
|
>
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
<
<
<
<
<
<
<
|
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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
123
124
125
126
127
|
;;======================================================================
;; each db entry is a pair ( db . dbfilepath )
;; NOTE: Need one dbr:dbstruct per main.db, 1.db ...
;;
(defstruct dbr:dbstruct
(dbname #f)
(dbdats (make-hash-table)) ;; id => dbdat
;; (tmpdbs #f)
;; (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack
;; (mtdb #f)
;; (refndb #f)
(homehost #f) ;; not used yet
(on-homehost #f) ;; not used yet
(read-only #f)
;; (stmt-cache (make-hash-table))
) ;; goal is to converge on one struct for an area but for now it is too confusing
(defstruct dbr:dbdat
(db #f) ;; should rename this to oddb for on disk db
(tmpdb #f)
(dbhstack #f) ;; do not init with a stack
(last-sync 0)
(last-write (current-seconds))
(run-id #f)
(fname #f))
; Returns the dbdat for a particular dbfile inside the area
;;
(define (dbr:dbstruct-get-dbdat dbstruct dbfile)
(hash-table-ref/default (dbr:dbstruct-dbdats dbstruct) dbfile #f))
(define (dbr:dbstruct-dbdat-put! dbstruct dbfile db)
(hash-table-set! (dbr:dbstruct-dbdats dbstruct) dbfile db))
(define (db:run-id->first-num run-id)
(let* ((s (number->string run-id))
(l (string-length s)))
(substring s (- l 1) l)))
;; 1234 => 4/1234.db
;; #f => 0/main.db
;; (abandoned the idea of num/db)
;;
(define (db:run-id->path apath run-id)
(conc apath"/"(db:run-id->dbname run-id)))
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
;; (let ((firstnum (if run-id
;; (db:run-id->first-num run-id)
;; "0")))
;; (conc *toppath* "/.dbs/" ;; firstnum"/"
;; (or run-id "main")".db")))
(define (db:run-id->dbname run-id)
(if (number? run-id)
(conc ".db/" (modulo run-id 100) ".db")
(conc ".db/main.db")))
;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts
(state #f)
(status #f)
(count 0))
;;======================================================================
;; hash of hashs
;;======================================================================
(define (db:hoh-set! dat key1 key2 val)
(let* ((subhash (hash-table-ref/default dat key1 #f)))
|
| ︙ | | | ︙ | |
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(if (eq? err-status 'done)
default
(begin
(debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
(print-call-chain (current-error-port))
default)))
(apply sqlite3:first-result db stmt params)))
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
|
>
>
>
>
>
>
>
>
>
|
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(if (eq? err-status 'done)
default
(begin
(debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
(print-call-chain (current-error-port))
default)))
(apply sqlite3:first-result db stmt params)))
(define (db:generic-error-printout exn . message)
(print-call-chain (current-error-port))
(apply debug:print-error 0 *default-log-port* message)
(debug:print-error 0 *default-log-port* ;; " params: " params
", error: " ((condition-property-accessor 'exn 'message) exn)
", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
", location: " ((condition-property-accessor 'exn 'location) exn)
))
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
|
| ︙ | | | ︙ | |
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
(db:generic-error-printout exn "ERROR: database " fname
" is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
(exn ()
(db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
((condition-property-accessor 'exn 'message) exn))))))
;;======================================================================
;; K E E P F I L E D B I N dbstruct
;;======================================================================
;; (define (db:get-filedb dbstruct run-id)
;; (let ((db (vector-ref dbstruct 2)))
;; (if db
;; db
;; (let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db"))))
;; (vector-set! dbstruct 2 fdb)
;; fdb))))
;;
;; ;; Can also be used to save arbitrary strings
;; ;;
;; (define (db:save-path dbstruct path)
;; (let ((fdb (db:get-filedb dbstruct)))b
;; (filedb:register-path fdb path)))
;;
;; ;; Use to get a path. To get an arbitrary string see next define
;; ;;
;; (define (db:get-path dbstruct id)
;; (let ((fdb (db:get-filedb dbstruct)))
;; (filedb:get-path db id)))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
(db:generic-error-printout exn "ERROR: database " fname
" is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
(exn ()
(db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
((condition-property-accessor 'exn 'message) exn))))))
;; NB// #f => return dbdir only
;; (was planned to be; zeroth db with name=main.db)
;;
;; If run-id is #f return to create and retrieve the path where the db will live.
;;
(define db:dbfile-path common:get-db-tmp-area)
|
| ︙ | | | ︙ | |
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
|
(else ;;(common:on-homehost?)
(let* ((dbstructs (make-hash-table)))
(when (not *toppath*)
(debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup")
(launch:setup areapath: areapath))
(set! *dbstruct-dbs* dbstructs)
;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct))
dbstruct))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
|
|
|
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
|
(else ;;(common:on-homehost?)
(let* ((dbstructs (make-hash-table)))
(when (not *toppath*)
(debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup")
(launch:setup areapath: areapath))
(set! *dbstruct-dbs* dbstructs)
;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct))
dbstructs))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
|
| ︙ | | | ︙ | |