76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
) ;; goal is to converge on one struct for an area but for now it is too confusing
;; need to keep dbhandles and cached statements together
(defstruct dbr:dbdat
(dbfile #f)
(dbh #f)
(stmt-cache (make-hash-table))
(read-only #f))
(define *dbstruct-dbs* #f)
(define *db-access-mutex* (make-mutex))
(define *no-sync-db* #f)
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex* (make-mutex))
(define *max-api-process-requests* 0)
|
|
>
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
) ;; goal is to converge on one struct for an area but for now it is too confusing
;; need to keep dbhandles and cached statements together
(defstruct dbr:dbdat
(dbfile #f)
(dbh #f)
(stmt-cache (make-hash-table))
(read-only #f)
(birth-sec (current-seconds)))
(define *dbstruct-dbs* #f)
(define *db-access-mutex* (make-mutex))
(define *no-sync-db* #f)
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex* (make-mutex))
(define *max-api-process-requests* 0)
|
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
#f
(begin
(set! *dbfile:num-handles-in-use* (+ *dbfile:num-handles-in-use* 1))
(stack-pop! (dbr:subdb-dbstack subdb))))))
;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
(let* ((subdb (dbfile:get-subdb dbstruct run-id)))
(set! *dbfile:num-handles-in-use* (- *dbfile:num-handles-in-use* 1))
(stack-push! (dbr:subdb-dbstack subdb) dbdat)))
;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
(let* ((dbname (dbfile:run-id->dbname run-id))
(areapath (dbr:dbstruct-areapath dbstruct))
(tmppath (dbr:dbstruct-tmppath dbstruct))
|
|
>
>
>
>
>
>
>
|
|
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
#f
(begin
(set! *dbfile:num-handles-in-use* (+ *dbfile:num-handles-in-use* 1))
(stack-pop! (dbr:subdb-dbstack subdb))))))
;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
(let* ((subdb (dbfile:get-subdb dbstruct run-id))
(age (- (current-seconds)(dbr:dbdat-birth-sec dbdat))))
(if (> age 30) ;; just testing - discard and close after 30 sec
(begin
;; (map sqlite3:finalize! (hash-table-values (dbr:dbdat-stmt-cache dbdat)))
;; (sqlite3:finalize! (dbr:dbdat-dbh dbdat))
(dbfile:print-err "INFO: Discarded dbdat over 30 sec old ("age"s)"))
(begin
(set! *dbfile:num-handles-in-use* (- *dbfile:num-handles-in-use* 1))
(stack-push! (dbr:subdb-dbstack subdb) dbdat)))))
;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
(let* ((dbname (dbfile:run-id->dbname run-id))
(areapath (dbr:dbstruct-areapath dbstruct))
(tmppath (dbr:dbstruct-tmppath dbstruct))
|
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
|
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
(dbfile:brute-force-salvage-db fname)))
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((nosyncdb *no-sync-db*)
(lockname (conc fname ".lock"))
(db (begin
(dbfile:simple-file-lock-and-wait lockname expire-time: 5)
(if nosyncdb (db:no-sync-get-lock nosyncdb fname))
(sqlite3:open-database fname))))
(if (and init-proc (not db-exists))
(init-proc db))
(if nosyncdb (db:no-sync-del! nosyncdb fname))
(dbfile:simple-file-release-lock lockname)
db)
(exn (io-error)
(dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.")
(retry))
(exn (corrupt)
(dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.")
|
>
|
|
>
>
|
>
>
|
|
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
|
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
(dbfile:brute-force-salvage-db fname)))
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((is-no-sync (substring-index "no-sync.db" fname))
(nosyncdb *no-sync-db*)
(lockname (conc fname ".lock"))
(db (begin
(dbfile:simple-file-lock-and-wait lockname expire-time: 5)
(if (and (not is-no-sync)
nosyncdb)
(db:no-sync-get-lock nosyncdb fname))
(sqlite3:open-database fname))))
(if (and init-proc (not db-exists))
(init-proc db))
(if (and (not is-no-sync)
nosyncdb)
(db:no-sync-del! nosyncdb fname))
(dbfile:simple-file-release-lock lockname)
db)
(exn (io-error)
(dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.")
(retry))
(exn (corrupt)
(dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.")
|
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
|
(condition-case
`(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname))
(exn (io-error) (dbfile:print-err "ERROR: i/o error with no-sync db. Check permissions, disk space etc. and try again."))
(exn (corrupt) (dbfile:print-err "ERROR: database no-sync db is corrupt. Repair it to proceed."))
(exn (busy) (dbfile:print-err "ERROR: database no-sync db is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(dbfile:print-err "ERROR: database no-sync db has some permissions problem."))
(exn (done)
(let ((lock-time (current-seconds)))
;; (debug:print-info 2 *default-log-port* "db:no-sync-get-lock keyname=" keyname ", lock-time=" lock-time ", exn=" exn)
(sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
`(#t . ,lock-time)))
(exn ()
(dbfile:print-err "ERROR: Unknown error with database no-sync db message: exn="(condition->list exn)", \n" ((condition-property-accessor 'exn 'message) exn))
`(#f . ,(current-seconds)))))))
(define (db:no-sync-get-lock-timeout db keyname timeout)
(let* ((lockdat (db:no-sync-get-lock db keyname)))
(match lockdat
((#f . lock-time)
(if (> (- (current-seconds) (if (string? lock-time)(string->number lock-time)lock-time)) timeout)
|
|
|
|
>
|
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
|
(condition-case
`(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname))
(exn (io-error) (dbfile:print-err "ERROR: i/o error with no-sync db. Check permissions, disk space etc. and try again."))
(exn (corrupt) (dbfile:print-err "ERROR: database no-sync db is corrupt. Repair it to proceed."))
(exn (busy) (dbfile:print-err "ERROR: database no-sync db is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(dbfile:print-err "ERROR: database no-sync db has some permissions problem."))
(exn () ;; (status done) ;; I don't know how to detect status done but no data!
(let ((lock-time (current-seconds)))
;; (debug:print-info 2 *default-log-port* "db:no-sync-get-lock keyname=" keyname ", lock-time=" lock-time ", exn=" exn)
(sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
`(#t . ,lock-time)))
#;(exn ()
(dbfile:print-err "ERROR: Unknown error with database no-sync db message: exn="(condition->list exn)", \n"
((condition-property-accessor 'exn 'message) exn))
`(#f . ,(current-seconds)))))))
(define (db:no-sync-get-lock-timeout db keyname timeout)
(let* ((lockdat (db:no-sync-get-lock db keyname)))
(match lockdat
((#f . lock-time)
(if (> (- (current-seconds) (if (string? lock-time)(string->number lock-time)lock-time)) timeout)
|