Index: dbfile.scm ================================================================== --- dbfile.scm +++ dbfile.scm @@ -24,31 +24,57 @@ (declare (uses debugprint)) (declare (uses commonmod)) (module dbfile * - - (import scheme - chicken + +(import scheme) +(cond-expand + (chicken-4 + (import chicken data-structures extras - matchable - - (prefix sqlite3 sqlite3:) - posix typed-records - - srfi-18 - srfi-1 - srfi-69 - stack + + posix + files ports - - commonmod - debugprint ) + (define current-process-milliseconds current-milliseconds) + ) + (chicken-5 + (import chicken.base + chicken.condition + chicken.file + chicken.file.posix + chicken.format + chicken.io + chicken.pathname + chicken.port + chicken.process + chicken.process-context.posix + chicken.sort + chicken.string + chicken.time + chicken.time.posix + system-information + ) + (define file-move move-file) + (define file-write-access? file-writable?) + )) + + (import (prefix sqlite3 sqlite3:)) + (import typed-records) + (import srfi-18) + (import srfi-1) + (import srfi-69) + (import stack) + (import commonmod) + (import debugprint) + (import matchable) + ;; parameters ;; (define dbfile:testsuite-name (make-parameter #f)) (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic @@ -842,11 +868,11 @@ ;; (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)) + (start-time (current-process-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) (let* ((tablename (car tabledat)) (fields (cdr tabledat)) @@ -986,11 +1012,11 @@ (append (list todb) slave-dbs) ) ) ) tbls) - (let* ((runtime (- (current-milliseconds) start-time)) + (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. (for-each (lambda (dat) Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -25,26 +25,37 @@ (declare (uses debugprint)) (module dbmod * -(import scheme - chicken - data-structures - extras - - (prefix sqlite3 sqlite3:) - posix - typed-records - srfi-1 - srfi-18 - srfi-69 - - commonmod - dbfile - debugprint - ) +(import scheme) +(cond-expand + (chicken-4 + (import chicken + data-structures + extras + posix + ) + (define current-process-milliseconds current-milliseconds) + ) + (chicken-5 + (import chicken.base + chicken.file + chicken.sort + chicken.string + chicken.time + + ))) + +(import (prefix sqlite3 sqlite3:)) +(import typed-records) +(import srfi-1) +(import srfi-18) +(import srfi-69) +(import commonmod) +(import dbfile) +(import debugprint) ;; NOTE: This returns only the name "1.db", "main.db", not the path ;; (define (dbmod:run-id->dbfname run-id) (conc (dbfile:run-id->dbnum run-id)".db")) @@ -236,11 +247,11 @@ ;; (define (dbmod:sync-tables tbls last-update fromdb todb) (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) - (start-time (current-milliseconds)) + (start-time (current-process-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) (let* ((tablename (car tabledat)) (fields (cdr tabledat)) @@ -351,11 +362,11 @@ (sqlite3:finalize! stmth) (if (member "last_update" field-names) (db:create-trigger db tablename))) )) tbls) - (let* ((runtime (- (current-milliseconds) start-time)) + (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. (for-each (lambda (dat) @@ -417,11 +428,11 @@ " SELECT * FROM "fromdb table";")) (stmt8 (conc "UPDATE "todb table" SET ("no-id-fields-str") = (SELECT "no-id-fields-str" FROM "fromdb table" WHERE "todb table".id="fromdb table".id" (if (member "last_update" fields) (conc " AND "fromdb table".last_update > "todb table".last_update);") ");"))) - (start-ms (current-milliseconds))) + (start-ms (current-process-milliseconds))) ;; (debug:print 0 *default-log-port* "stmt8="stmt8) ;; (if (sqlite3:auto-committing? dbh) ;; (begin (mutex-lock! *db-transaction-mutex*) (sqlite3:with-transaction @@ -435,11 +446,11 @@ ;; (sqlite3:execute dbh stmt5) ;; (sqlite3:execute dbh stmt4) ;; if it worked this would be better for incremental up ;; (sqlite3:execute dbh stmt6) )) (debug:print 0 *default-log-port* "Synced table "table - " in "(- (current-milliseconds) start-ms)"ms") ;; ) + " in "(- (current-process-milliseconds) start-ms)"ms") ;; ) (mutex-unlock! *db-transaction-mutex*))) ;; (debug:print 0 *default-log-port* "Skipping sync of table "table" due to transaction in flight.")))) table-names) (sqlite3:execute dbh "DETACH auxdb;")))) @@ -508,11 +519,11 @@ ;; (conc " AND "fromdb table".last_update > "todb table".last_update);") ;; ");"))) (stmt1 (conc "SELECT MAX(last_update) FROM "table";")) ;; use the highest last_update as your time reference (stmt2 (conc "SELECT no-id-fields-str FROM "table" WHERE last_update>?;")) (stmt3 (conc "UPDATE "table" SET ("no-id-fields-str") = ("questionmarks") WHERE id=?;")) - (start-ms (current-milliseconds))) + (start-ms (current-process-milliseconds))) (debug:print 0 *default-log-port* "stmt3="stmt3) (if (sqlite3:auto-committing? dbh1) (begin (sqlite3:with-transaction dbh1 @@ -524,11 +535,11 @@ ;; (sqlite3:execute dbh stmt5) ;; (sqlite3:execute dbh stmt4) ;; if it worked this would be better for incremental up ;; (sqlite3:execute dbh stmt6) )) (debug:print 0 *default-log-port* "Synced table "table - " in "(- (current-milliseconds) start-ms)"ms")) + " in "(- (current-process-milliseconds) start-ms)"ms")) (debug:print 0 *default-log-port* "Skipping sync of table "table" due to transaction in flight.")))) table-names) (sqlite3:execute dbh1 "DETACH auxdb;"))))