| ︙ | | |
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
-
+
-
+
|
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (dbfile:open-sqlite3-db dbpath init-proc)
(let* ((dbexists (file-exists? dbpath))
(write-access (file-write-access? dbpath))
(db (dbfile:cautious-open-database dbpath))) #;(sqlite3:open-database dbpath)
(db (dbfile:cautious-open-database dbpath init-proc))) #;(sqlite3:open-database dbpath)
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
(init-proc db)
;; (init-proc db)
(make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))
(define (dbfile:print-and-exit . params)
(with-output-to-port
(current-error-port)
(lambda ()
(apply print params)))
|
| ︙ | | |
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
|
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
-
+
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
|
;;======================================================================
;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (dbfile:cautious-open-database fname #!optional (tries-left 5))
(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 10))
(let* ((lock-file (conc fname".lock"))
(retry (lambda ()
(thread-sleep! 1.1)
(if (> tries-left 0)
(dbfile:cautious-open-database fname (- tries-left 1))))))
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: Five attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (not (dbfile:simple-file-lock lock-file))
(begin
(dbfile:print-err "INFO: lock file "lock-file" exists, trying again in 3 seconds.")
(thread-sleep! 3)
(dbfile:cautious-open-database fname (- tries-left 1)))
(let ((result (condition-case
(sqlite3:open-database fname)
(dbfile:print-err "INFO: lock file "lock-file" exists, trying again in 1 second.")
(thread-sleep! 1)
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((db (sqlite3:open-database fname)))
(if (and init-proc (not db-exists))
(init-proc db))
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.")
(retry))
(exn (busy)
|
| ︙ | | |
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
|
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(if *no-sync-db*
*no-sync-db*
(begin
(if (not (file-exists? dbpath))
(create-directory dbpath #t))
(let* ((dbname (conc dbpath "/no-sync.db"))
(db-exists (file-exists? dbname))
(db (dbfile:cautious-open-database dbname))) ;; (sqlite3:open-database dbname)))
(init-proc (lambda (db)
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
(if (not db-exists)
(begin
(sqlite3:execute db "PRAGMA synchronous = 0;")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
#;(sqlite3:execute db "PRAGMA journal_mode=WAL;")))
|
| ︙ | | |
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
|
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
|
-
+
|
(let ((key-string (conc (get-host-name) "-" (current-process-id)))
(oup (open-output-file fname)))
(with-output-to-port
oup
(lambda ()
(print key-string)))
(close-output-port oup)
#;(with-output-to-file fname
#;(with-output-to-file fname ;; bizarre. with-output-to-file does not seem to be cleaning up after itself.
(lambda ()
(print key-string)))
(thread-sleep! 0.25)
(if (file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
|
| ︙ | | |