| ︙ | | |
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
+
+
|
(if (args:get-arg "-server")
(if (configf:get-section *configdat* "ext-sync")
(let* ((dblist (configf:get-section *configdat* "ext-sync"))
(res '())
(cfgdb #f))
(for-each (lambda (dbitem)
(let* ((stringsplit (string-split (cadr dbitem)))
(dbtype (car stringsplit))
(dbpath (cadr stringsplit)))
(set! cfgdb (dbi:open (string->symbol dbtype) (cons (cons 'dbname dbpath) '()) ))
(dbtype (string->symbol (car stringsplit)))
(dbinfo '())
(cred '()))
(for-each
(lambda (x)
(if (not (eqv? (string->symbol x) dbtype))
(let* ((pair (string-split x ":")))
(if (not (eqv? pair '()))
(set! dbinfo (cons (cons (string->symbol (car pair)) (cadr pair)) dbinfo))))))
stringsplit)
(set! cfgdb (dbi:open dbtype dbinfo))
(db:initialize-main-db cfgdb)
(db:initialize-run-id-db cfgdb)
(set! res (cons (cons cfgdb dbpath) res))))
(dbr:dbstruct-slave-dbs-set! dbstruct res))))
(dbr:dbstruct-slave-dbs-set! dbstruct res)
)))
;; (mutex-unlock! *rundb-mutex*)
(if (and (not dbfexists)
write-access) ;; *db-write-access*) ;; did not have a prior db and do have write access
(begin
(debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data from " (db:dbdat-get-path mtdb))
(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb))
|
| ︙ | | |
544
545
546
547
548
549
550
551
552
553
554
555
556
557
|
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
+
|
;; db's are dbdat's
;;
;; if last-update specified ("field-name" . time-in-seconds)
;; then sync only records where field-name >= time-in-seconds
;; IFF field-name exists
;;
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
(print "Slave-dbs: " slave-dbs)
(set! todb (cons (dbi:convert (db:dbdat-get-db todb)) (db:dbdat-get-path todb)))
(set! fromdb (cons (dbi:convert (db:dbdat-get-db fromdb)) (db:dbdat-get-path fromdb)))
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
|
| ︙ | | |
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
|
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
|
-
+
+
|
(num->field (apply vector (map car fields)))
(full-sel (conc "SELECT " (string-intersperse (map car fields) ",")
" FROM " tablename (if use-last-update ;; apply last-update criteria
(conc " " (car last-update) ">=" (cdr last-update))
"")
";"))
(full-ins (conc "INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) "
" VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );"))
|
| ︙ | | |
646
647
648
649
650
651
652
653
654
655
656
657
658
659
|
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(db:dbdat-get-db todb)
full-sel)
;; first pass implementation, just insert all changed rows
(for-each
(lambda (targdb)
(if (eqv? (dbi:db-dbtype (db:dbdat-get-db targdb)) 'pgd)
(let* ((prep ""))
(for-each
(lambda (row)
(set! tabletypes (cons (cons (string->symbol (vector-ref row 1)) (vector-ref row 2)) tabletypes)))
(dbi:pull-metadata (db:dbdat-get-db fromdb) tablename))
(set! prep (string-intersperse (map (lambda (x) (alist-ref (string->symbol (car x)) tabletypes)) fields) ","))
(set! prep (conc "PREPARE full-ins (" prep ") AS INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) VALUES ( "))
(let loop ((i 1))
(set! prep (conc prep "$" i ","))
(if (< i (- num-fields 1))
(loop (+ i 1))
(set! prep (conc prep "$" (+ i 1) ")"))))
(set! full-ins prep)))
(let* ((db (dbi:convert (db:dbdat-get-db targdb)))
(stmth (dbi:prepare db full-ins)))
;; (db:delay-if-busy targdb) ;; NO WAITING
(for-each
(lambda (fromdat-lst)
(dbi:with-transaction
db
|
| ︙ | | |