75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
;; called in rmt.scm nfs-transport-handler
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath #!key (tmpadj ""))
(assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
(if dbstruct
dbstruct
(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk tmpadj: tmpadj)))
(hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
newdbstruct))))
;;======================================================================
;; The cachedb one-db file per server method goes in here
;;======================================================================
|
|
|
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
;; called in rmt.scm nfs-transport-handler
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath #!key (tmpadj ""))
(assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
(if dbstruct
dbstruct
(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'todisk)))
(hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
newdbstruct))))
;;======================================================================
;; The cachedb one-db file per server method goes in here
;;======================================================================
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, will try "count" more times.")
(thread-sleep! 1)
(loop (- count 1)))
(begin
(debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, giving up.")
(exit 1))))
(exn ()
(dbfile:print-err exn "ERROR: Unknown error with database for run-id "run-id", message: "
((condition-property-accessor 'exn 'message) exn))
(exit 2))))))
(if use-mutex (mutex-unlock! *db-with-db-mutex*))
res)))
(define (db:with-db dbstruct run-id w/r proc . params)
(dbmod:with-db dbstruct run-id w/r proc params))
|
|
>
|
>
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
(debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, will try "count" more times.")
(thread-sleep! 1)
(loop (- count 1)))
(begin
(debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, giving up.")
(exit 1))))
(exn ()
(dbfile:print-err exn "ERROR: Unknown error with db for run-id "
run-id", message: "
((condition-property-accessor 'exn 'message) exn)
", details: "(condition->list exn))
(exit 2))))))
(if use-mutex (mutex-unlock! *db-with-db-mutex*))
res)))
(define (db:with-db dbstruct run-id w/r proc . params)
(dbmod:with-db dbstruct run-id w/r proc params))
|
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
|
;; for each table
;; insert into dest.<table> select * from src.<table> where last_update>last_update
;; done
(debug:print 2 *default-log-port* "Attaching "destdbfile" as auxdb")
(handle-exceptions
exn
(begin
(debug:print 0 "ATTACH failed, exiting. exn="(condition->list exn))
(exit 1))
(sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;")))
(for-each
(lambda (table)
(let* ((dummy (debug:print 2 *default-log-port* "Doing table " table))
(tbldat (alist-ref table tables equal?))
(fields (map car tbldat))
|
|
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
|
;; for each table
;; insert into dest.<table> select * from src.<table> where last_update>last_update
;; done
(debug:print 2 *default-log-port* "Attaching "destdbfile" as auxdb")
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "ATTACH failed, exiting. exn="(condition->list exn))
(exit 1))
(sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;")))
(for-each
(lambda (table)
(let* ((dummy (debug:print 2 *default-log-port* "Doing table " table))
(tbldat (alist-ref table tables equal?))
(fields (map car tbldat))
|