| ︙ | | | ︙ | |
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
|
(define (db:all-db-sync dbstruct)
(let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
(data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/.megatest/*.db")))
(sync-durations (make-hash-table))
(no-sync-db (db:open-no-sync-db)))
(for-each
(lambda (file) ;; tmp db file
(debug:print-info 3 *default-log-port* "file: " file)
(let* ((fname (conc (pathname-file file) ".db")) ;; fname is tmp db file
(wal-file (conc file "-wal"))
(shm-file (conc file "-shm"))
(fulln (conc *toppath*"/.megatest/"fname)) ;; fulln is nfs db name
(wal-time (if (file-exists? wal-file)
(file-modification-time wal-file)
0))
(shm-time (if (file-exists? shm-file)
(file-modification-time shm-file)
0))
|
|
|
|
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
|
(define (db:all-db-sync dbstruct)
(let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
(data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/" *dbdir* "/*.db")))
(sync-durations (make-hash-table))
(no-sync-db (db:open-no-sync-db)))
(for-each
(lambda (file) ;; tmp db file
(debug:print-info 3 *default-log-port* "file: " file)
(let* ((fname (conc (pathname-file file) ".db")) ;; fname is tmp db file
(wal-file (conc file "-wal"))
(shm-file (conc file "-shm"))
(fulln (conc *toppath*"/" *dbdir* "/"fname)) ;; fulln is nfs db name
(wal-time (if (file-exists? wal-file)
(file-modification-time wal-file)
0))
(shm-time (if (file-exists? shm-file)
(file-modification-time shm-file)
0))
|
| ︙ | | | ︙ | |
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
(tmp-area (common:get-db-tmp-area))
(old2new (member 'old2new options))
(dejunk (member 'dejunk options))
(killservers (member 'killservers options))
(servers (server:get-list *toppath*))
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
(if killservers
(begin
(for-each
|
|
|
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
(tmp-area (common:get-db-tmp-area))
(old2new (member 'old2new options))
(dejunk (member 'dejunk options))
(killservers (member 'killservers options))
(servers (server:get-list *toppath*))
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (if old2new (glob (conc *toppath* "/" *dbdir* "/*.db")) (glob (conc tmp-area "/" *dbdir* "/*.db"))))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
(if killservers
(begin
(for-each
|
| ︙ | | | ︙ | |
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
)
(for-each
(lambda (srcfile)
(debug:print-info 3 *default-log-port* "file: " srcfile)
(let* ((fname (conc (pathname-file srcfile) ".db"))
(basename (pathname-file srcfile))
(run-id (if (string= basename "main") #f (string->number basename)))
(destfile (conc dest-area "/.megatest/" fname))
(dest-directory (conc dest-area "/.megatest/"))
(dummy (debug:print-info 2 *default-log-port* "destfile = " destfile))
(dummy2 (debug:print-info 2 *default-log-port* "dejunk = " dejunk))
;; TODO: time1 and time2 need to take into account -wal and -shm files
(time1 (file-modification-time srcfile))
(time2 (if (file-exists? destfile)
(begin
(debug:print-info 2 *default-log-port* "destfile " destfile " exists")
|
|
|
|
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
)
(for-each
(lambda (srcfile)
(debug:print-info 3 *default-log-port* "file: " srcfile)
(let* ((fname (conc (pathname-file srcfile) ".db"))
(basename (pathname-file srcfile))
(run-id (if (string= basename "main") #f (string->number basename)))
(destfile (conc dest-area "/" *dbdir* "/" fname))
(dest-directory (conc dest-area "/" *dbdir* "/"))
(dummy (debug:print-info 2 *default-log-port* "destfile = " destfile))
(dummy2 (debug:print-info 2 *default-log-port* "dejunk = " dejunk))
;; TODO: time1 and time2 need to take into account -wal and -shm files
(time1 (file-modification-time srcfile))
(time2 (if (file-exists? destfile)
(begin
(debug:print-info 2 *default-log-port* "destfile " destfile " exists")
|
| ︙ | | | ︙ | |
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
|
(define (db:get-changed-run-ids since-time)
(let* ((dbdir (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
(alldbs (glob (conc dbdir "/.megatest/[0-9]*.db*")))
(changed (filter (lambda (dbfile)
(> (file-modification-time dbfile) since-time))
alldbs)))
(delete-duplicates
(map (lambda (dbfile)
(let* ((res (string-match ".*\\/(\\d\\d)\\.db*" dbfile)))
(if res
|
|
|
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
|
(define (db:get-changed-run-ids since-time)
(let* ((dbdir (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
(alldbs (glob (conc dbdir "/" *dbdir* "/[0-9]*.db*")))
(changed (filter (lambda (dbfile)
(> (file-modification-time dbfile) since-time))
alldbs)))
(delete-duplicates
(map (lambda (dbfile)
(let* ((res (string-match ".*\\/(\\d\\d)\\.db*" dbfile)))
(if res
|
| ︙ | | | ︙ | |
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
|
#f
))))
;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
(let* ((tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/.megatest/*.db")))
(sync-durations (make-hash-table)))
;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
(for-each
(lambda (file)
(let* ((fname (conc (pathname-file file) ".db"))
(fulln (conc *toppath*"/.megatest/"fname))
(time1 (if (file-exists? file)
(file-modification-time file)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
1)))
(time2 (if (file-exists? fulln)
(file-modification-time fulln)
|
|
|
|
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
|
#f
))))
;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
(let* ((tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/" *dbdir* "/*.db")))
(sync-durations (make-hash-table)))
;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
(for-each
(lambda (file)
(let* ((fname (conc (pathname-file file) ".db"))
(fulln (conc *toppath*"/" *dbdir* "/"fname))
(time1 (if (file-exists? file)
(file-modification-time file)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
1)))
(time2 (if (file-exists? fulln)
(file-modification-time fulln)
|
| ︙ | | | ︙ | |