| ︙ | | | ︙ | |
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
(declare (unit dbfile))
;; (declare (uses debugprint))
(declare (uses commonmod))
(module dbfile
*
(import scheme
chicken
data-structures
extras
matchable)
(import (prefix sqlite3 sqlite3:)
posix typed-records srfi-18 srfi-1
srfi-69
stack
files
ports
commonmod
)
|
|
>
>
>
>
>
>
|
>
>
>
>
>
>
>
|
|
|
<
|
>
|
>
>
|
|
>
|
|
|
|
|
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(declare (unit dbfile))
;; (declare (uses debugprint))
(declare (uses commonmod))
(module dbfile
*
(import
scheme
chicken.base
chicken.condition
chicken.file
chicken.file.posix
chicken.io
chicken.port
chicken.process
chicken.process-context.posix
chicken.sort
chicken.time
chicken.string
;; data-structures
;; extras
matchable
(prefix sqlite3 sqlite3:)
;; posix
typed-records
srfi-18
srfi-1
srfi-69
stack
system-information
;; files
;; ports
commonmod
)
;; (import debugprint)
;;======================================================================
;; R E C O R D S
;;======================================================================
|
| ︙ | | | ︙ | |
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
;; 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 init-proc))) #;(sqlite3:open-database dbpath)
(dbfile:inc-db-open dbpath)
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))
;; (init-proc db)
(make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))
|
|
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
;; 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-writable? dbpath))
(db (dbfile:cautious-open-database dbpath init-proc))) #;(sqlite3:open-database dbpath)
(dbfile:inc-db-open dbpath)
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))
;; (init-proc db)
(make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))
|
| ︙ | | | ︙ | |
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
|
(let* ((busy-file (conc fname"-journal"))
(delay-time (* (- 51 tries-left) 1.1))
(retry (lambda ()
(thread-sleep! delay-time)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname)
(file-exists? busy-file))
(begin
(dbfile:print-err "INFO: dbfile:cautious-open-database: journal file " busy-file " exists, trying again in few seconds.")
(thread-sleep! 1)
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
|
|
|
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
(let* ((busy-file (conc fname"-journal"))
(delay-time (* (- 51 tries-left) 1.1))
(retry (lambda ()
(thread-sleep! delay-time)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-writable? fname)
(file-exists? busy-file))
(begin
(dbfile:print-err "INFO: dbfile:cautious-open-database: journal file " busy-file " exists, trying again in few seconds.")
(thread-sleep! 1)
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
|
| ︙ | | | ︙ | |
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
|
((not (sqlite3:database? (dbr:dbdat-dbh fromdb)))
(dbfile:print-err "db:sync-tables called with fromdb not a database " fromdb)
-3)
((not (sqlite3:database? (dbr:dbdat-dbh todb)))
(dbfile:print-err "db:sync-tables called with todb not a database " todb)
-4)
((not (file-write-access? (dbr:dbdat-dbfile todb)))
(dbfile:print-err "db:sync-tables called with todb not a read-only database " todb)
-5)
((not (null? (let ((readonly-slave-dbs
(filter
(lambda (dbdat)
(not (file-write-access? (dbr:dbdat-dbfile todb))))
slave-dbs)))
(for-each
(lambda (bad-dbdat)
(dbfile:print-err "db:sync-tables called with todb not a read-only database " bad-dbdat))
readonly-slave-dbs)
readonly-slave-dbs))) -6)
(else
;; (dbfile:print-err "db:sync-tables: args are good")
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-milliseconds))
(tot-count 0))
(for-each ;; table
(lambda (tabledat)
(let* ((tablename (car tabledat))
(fields (cdr tabledat))
(has-last-update (member "last_update" fields))
(use-last-update (cond
|
|
|
|
|
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
|
((not (sqlite3:database? (dbr:dbdat-dbh fromdb)))
(dbfile:print-err "db:sync-tables called with fromdb not a database " fromdb)
-3)
((not (sqlite3:database? (dbr:dbdat-dbh todb)))
(dbfile:print-err "db:sync-tables called with todb not a database " todb)
-4)
((not (file-writable? (dbr:dbdat-dbfile todb)))
(dbfile:print-err "db:sync-tables called with todb not a read-only database " todb)
-5)
((not (null? (let ((readonly-slave-dbs
(filter
(lambda (dbdat)
(not (file-writable? (dbr:dbdat-dbfile todb))))
slave-dbs)))
(for-each
(lambda (bad-dbdat)
(dbfile:print-err "db:sync-tables called with todb not a read-only database " bad-dbdat))
readonly-slave-dbs)
readonly-slave-dbs))) -6)
(else
;; (dbfile:print-err "db:sync-tables: args are good")
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-process-milliseconds))
(tot-count 0))
(for-each ;; table
(lambda (tabledat)
(let* ((tablename (car tabledat))
(fields (cdr tabledat))
(has-last-update (member "last_update" fields))
(use-last-update (cond
|
| ︙ | | | ︙ | |
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
|
(if (member "last_update" field-names)
(db:create-trigger db tablename))))
(append (list todb) slave-dbs)
)
)
)
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(should-print (or ;; (debug:debug-mode 12)
(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
(if should-print (dbfile:print-err "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
|
|
|
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
|
(if (member "last_update" field-names)
(db:create-trigger db tablename))))
(append (list todb) slave-dbs)
)
)
)
tbls)
(let* ((runtime (- (current-process-milliseconds) start-time))
(should-print (or ;; (debug:debug-mode 12)
(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
(if should-print (dbfile:print-err "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
|
| ︙ | | | ︙ | |