Overview
| Comment: | added update on conflict insert for pg, synced with latest v1.63 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.63-configdbsync |
| Files: | files | file ages | folders |
| SHA1: |
ad8b9df6401e41007a5d09df8f379132 |
| User & Date: | srehman on 2017-01-30 12:23:17 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-02-03
| ||
| 14:25 | added sync of megatest.db to config dbs check-in: ae352678af user: srehman tags: v1.63-configdbsync | |
|
2017-01-30
| ||
| 12:23 | added update on conflict insert for pg, synced with latest v1.63 check-in: ad8b9df640 user: srehman tags: v1.63-configdbsync | |
|
2017-01-26
| ||
| 13:46 | preparations to add update on conflict insert for pg check-in: f2e2f9ce97 user: srehman tags: v1.63-configdbsync | |
|
2017-01-25
| ||
| 17:11 | made yougest-db error message more useful check-in: e58c0e3fb7 user: bjbarcla tags: v1.63 | |
Changes
Modified dashboard.scm from [ff388ff4d0] to [29cdcf21f3].
| ︙ | ︙ | |||
2708 2709 2710 2711 2712 2713 2714 | ;; Force creation of the db in case it isn't already there. (tasks:open-db) (define (dashboard:get-youngest-run-db-mod-time dbdir) (handle-exceptions exn (begin | | | 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 |
;; Force creation of the db in case it isn't already there.
(tasks:open-db)
(define (dashboard:get-youngest-run-db-mod-time dbdir)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir)
(current-seconds)) ;; something went wrong - just print an error and return current-seconds
(common:max (map (lambda (filen)
(file-modification-time filen))
(glob (conc dbdir "/*.db*"))))))
(define (dashboard:monitor-changed? commondat tabdat)
(let* ((run-update-time (current-seconds))
|
| ︙ | ︙ |
Modified db.scm from [defed83112] to [3917c44888].
| ︙ | ︙ | |||
684 685 686 687 688 689 690 |
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)
| | > > > | | | | | > | | > > | | | > > > > > > > > > | | 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)))
|
| ︙ | ︙ |