684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
|
full-sel)
;; first pass implementation, just insert all changed rows
(for-each
(lambda (targdb)
(set! targdb (dbi:convert (db:dbdat-get-db targdb)))
(if (eqv? (dbi:db-dbtype targdb) 'pg)
(let* ((prep ""))
(set! prep (string-intersperse (map cadr fields) ","))
(set! prep (conc "PREPARE fullins (" prep ") AS INSERT INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) VALUES ( ")) ;;maybe add lookup in the future depending on where types are needed
(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
(same #t))
(let loop ((i 0))
(if (or (not curr)
(not (equal? (vector-ref fromrow i)(vector-ref curr i))))
(set! same #f))
(if (and same
(< i (- num-fields 1)))
(loop (+ i 1))))
(if (not same)
(begin
(apply dbi:prepare-exec stmth (vector->list fromrow))
(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
;;(begin
;; (dbi:prepare-exec stmth (vector->list fromrow))
;;(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
fromdat-lst))
))
fromdats)
(dbi:close stmth)))
|
|
>
>
>
|
|
|
|
|
>
|
|
>
>
|
|
|
>
>
>
>
>
>
>
>
>
|
|
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
|
full-sel)
;; first pass implementation, just insert all changed rows
(for-each
(lambda (targdb)
(set! targdb (dbi:convert (db:dbdat-get-db targdb)))
(if (eqv? (dbi:db-dbtype targdb) 'pg)
(let* ((prep "")
(set-stmt "")
(key (car (map car fields)))
(list-fields (map car fields)))
(set! prep (string-intersperse (map cadr fields) ","))
(set! prep (conc "PREPARE fullupdate (" prep ") AS UPDATE " tablename " SET ")) ;;maybe add lookup in the future depending on where types are needed
(let loop ((i 1))
(set! set-stmt (conc set-stmt (list-ref list-fields i) " = $" (+ i 1) ", "))
(if (< i (- (length list-fields) 2))
(loop (+ i 1))
(set! set-stmt (conc set-stmt (list-ref list-fields (+ i 1)) " = $" (+ i 2) " WHERE " key " = $1;"))))
(set! full-ins (conc prep set-stmt))))
(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
(lambda ()
(for-each ;;
(lambda (fromrow)
(let* ((a (vector-ref fromrow 0))
(curr (hash-table-ref/default todat a #f))
(same #t)
(res #f)
(len (length (vector->list fromrow))))
(let loop ((i 0))
(if (or (not curr)
(not (equal? (vector-ref fromrow i)(vector-ref curr i))))
(set! same #f))
(if (and same
(< i (- num-fields 1)))
(loop (+ i 1))))
(if (not same)
(begin
(set! res (apply dbi:prepare-exec stmth (vector->list fromrow)))
(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))
(if (and (not same) (eqv? (dbi:get-res res 'affected-rows) 0))
(let* ((prep ""))
(set! prep (string-intersperse (map cadr fields) ","))
(set! prep (conc "INSERT INTO " tablename " ( " (string-intersperse (map car fields) ",")
" ) VALUES ( " (string-intersperse (make-list len "?") ",") " );")) ;;maybe add lookup in the future depending on where types are needed
(begin
(hash-table-set! numrecs tablename (- 1 (hash-table-ref/default numrecs tablename 0)))
(apply dbi:exec db prep (vector->list fromrow))
(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))))
;;(begin
;; (dbi:prepare-exec stmth (vector->list fromrow))
;;(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
fromdat-lst))
))
fromdats)
(dbi:close stmth)))
|