Megatest

Check-in [3c8cc5078c]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70001-multi-db-rebased
Files: files | file ages | folders
SHA1: 3c8cc5078c2700f095d8f27494790c7dd61c638c
User & Date: matt on 2022-03-02 19:46:54
Other Links: branch diff | manifest | tags
Context
2022-03-02
20:46
Broke out stuff from db.scm that is used for db file management into dbfile.scm check-in: 77c71d1c14 user: matt tags: v1.70001-multi-db-rebased
19:46
wip check-in: 3c8cc5078c user: matt tags: v1.70001-multi-db-rebased
2022-02-27
20:21
wip check-in: 45bc17bcaf user: matt tags: v1.70001-multi-db-rebased
Changes

Modified common.scm from [b30cfc533e] to [cf6013c9c1].

133
134
135
136
137
138
139
140

141
142
143
144
145
146
147
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+







;; (define *alt-log-file* #f)  ;; used by -log
(define *common:denoise*    (make-hash-table)) ;; for low noise printing
(define *default-log-port*  (current-error-port))
(define *time-zero* (current-seconds)) ;; for the watchdog
(define *default-area-tag* "local")

;; DATABASE
(define *dbstruct-db*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
(define *dbstruct-dbs*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
;; db stats
(define *db-stats*            (make-hash-table)) ;; hash of vectors < count duration-total >
(define *db-stats-mutex*      (make-mutex))
;; db access
(define *db-last-access*      (current-seconds)) ;; last db access, used in server
(define *db-write-access*     #t)
;; db sync

Modified db.scm from [dea5f62aee] to [087864cb5c].

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

;;======================================================================
;; alist-of-alists
;;======================================================================
;; 
;; (define (db:aa-set! dat key1 key2 val)
;;   (let loop ((

;;======================================================================
;; 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
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
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))))))
      
;;======================================================================
;; 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)))

;; 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
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))
      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!