203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
(exn (io-error) (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
(exn (corrupt) (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
(exn (busy) (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
(exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
)))
(define (db:initialize-main-db dbdat keys)
(assert *configinfo* "Attempt to initialize main db before configs are properly processed")
;; (if (not *configinfo*)(launch:setup)) ;; added because Elena was getting stack dump because *configinfo* below was #f.
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys:make-key/field-string keys)) ;;; configdat))
(db (db:dbdat-get-db dbdat)))
(for-each (lambda (key)
(let ((keyn key))
(if (member (string-downcase keyn)
|
|
|
|
|
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
(exn (io-error) (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
(exn (corrupt) (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
(exn (busy) (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
(exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
)))
(define (db:initialize-main-db dbdat)
(assert *db-keys* "Attempt to initialize main db before configs are properly processed")
;; (if (not *configinfo*)(launch:setup)) ;; added because Elena was getting stack dump because *configinfo* below was #f.
(let* ((keys *db-keys*)
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys:make-key/field-string keys)) ;;; configdat))
(db (db:dbdat-get-db dbdat)))
(for-each (lambda (key)
(let ((keyn key))
(if (member (string-downcase keyn)
|
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
;(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) ; moving this before db:open-megatest-db is called. if wal mode is on -WAL and -shm file get created with causing the tmpdbmodtime timestamp always greater than mtdbmodtime
;(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced
;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f))
;(fmt (file-modification-time tmpdbfname))
(modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
(when write-access
(sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger")
(sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))
;(print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
|
>
|
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
|
;(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) ; moving this before db:open-megatest-db is called. if wal mode is on -WAL and -shm file get created with causing the tmpdbmodtime timestamp always greater than mtdbmodtime
;(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced
;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f))
;(fmt (file-modification-time tmpdbfname))
(modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
(assert (sqlite3:database? (car mtdb)) "ERROR: in db:open-db and mtdb does not contain database!")
(when write-access
(sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger")
(sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))
;(print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
|