Megatest

Diff
Login

Differences From Artifact [81910a6906]:

To Artifact [a601d0637e]:


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)