1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
|
(begin
(db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) #f tmpdb mtdb)))
(hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
(debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date"))))
dbfiles))
data-synced))
;; Sync all changed db's
;;
(define (db:tmp->megatest.db-sync dbstruct run-id last-update)
(let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
(res '()))
(for-each
(lambda (subdb)
(let* ((mtdb (dbr:subdb-mtdbdat subdb))
(tmpdb (db:get-subdb dbstruct run-id))
(refndb (dbr:subdb-refndb subdb))
(newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
;; BUG: verify this is really needed
(dbfile:add-dbdat dbstruct run-id tmpdb)
(set! res (cons newres res))))
subdbs)
res))
;;;; run-ids
;; if #f use *db-local-sync* : or 'local-sync-flags
;; if #t use timestamps : or 'timestamps
;;
;; NB// no-sync-db is the db handle, not a flag!
;;
(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f))
(let* ((start-time (current-seconds))
(last-full-update (if no-sync-db
(db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
0))
(full-sync-needed (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
(last-update (if full-sync-needed
0
(if no-sync-db
(db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
(sync-needed (> (- start-time last-update) 6))
(res (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
full-sync-needed)
(begin
(if no-sync-db
(begin
(if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
(db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
(db:tmp->megatest.db-sync dbstruct last-update))
0))
(sync-time (- (current-seconds) start-time)))
(debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
(if (common:low-noise-print 30 "sync new to old")
(if sync-needed
(debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
(debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
res))
(define (db:initialize-main-db db #!key (launch-setup #f))
(when (not *configinfo*)
(if launch-setup
(launch-setup) ;; added because Elena was getting stack dump because *configinfo* below was #f.
(assert #f "db:initialize-main-db called and needs launch:setup but was not given it")))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
|
(begin
(db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) #f tmpdb mtdb)))
(hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
(debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date"))))
dbfiles))
data-synced))
;; ;; Sync all changed db's
;; ;;
;; (define (db:tmp->megatest.db-sync dbstruct run-id last-update)
;; (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
;; (res '()))
;; (for-each
;; (lambda (subdb)
;; (let* ((mtdb (dbr:subdb-mtdbdat subdb))
;; (tmpdb (db:get-subdb dbstruct run-id))
;; (refndb (dbr:subdb-refndb subdb))
;; (newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
;; ;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
;; ;; BUG: verify this is really needed
;; (dbfile:add-dbdat dbstruct run-id tmpdb)
;; (set! res (cons newres res))))
;; subdbs)
;; res))
;;;; run-ids
;; if #f use *db-local-sync* : or 'local-sync-flags
;; if #t use timestamps : or 'timestamps
;;
;; NB// no-sync-db is the db handle, not a flag!
;;
;; (define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f))
;; (let* ((start-time (current-seconds))
;; (last-full-update (if no-sync-db
;; (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
;; 0))
;; (full-sync-needed (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
;; (last-update (if full-sync-needed
;; 0
;; (if no-sync-db
;; (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
;; 0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
;; (sync-needed (> (- start-time last-update) 6))
;; (res (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
;; full-sync-needed)
;; (begin
;; (if no-sync-db
;; (begin
;; (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
;; (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
;; (db:tmp->megatest.db-sync dbstruct run-id last-update))
;; 0))
;; (sync-time (- (current-seconds) start-time)))
;; (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;; (if (common:low-noise-print 30 "sync new to old")
;; (if sync-needed
;; (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;; (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
;; res))
(define (db:initialize-main-db db #!key (launch-setup #f))
(when (not *configinfo*)
(if launch-setup
(launch-setup) ;; added because Elena was getting stack dump because *configinfo* below was #f.
(assert #f "db:initialize-main-db called and needs launch:setup but was not given it")))
|