Commit f72192c4 authored by dave griffiths's avatar dave griffiths
Browse files

big sync test

parent 5948d67f
...@@ -197,7 +197,7 @@ ...@@ -197,7 +197,7 @@
;; only update if the are different ;; only update if the are different
(if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s))) (if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s)))
(begin (begin
(msg "incrementing value version in update-value") ;;(msg "incrementing value version in update-value")
(db-exec (db-exec
db (string-append "update " table "_value_" (ktv-type ktv) db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?") " set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?")
...@@ -210,9 +210,9 @@ ...@@ -210,9 +210,9 @@
db (string-append db (string-append
"select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?") "select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
entity-id (ktv-key ktv)))) entity-id (ktv-key ktv))))
(msg "update-value-from-sync" s) ;;(msg "update-value-from-sync" s)
(msg ktv) ;;(msg ktv)
(msg entity-id) ;;(msg entity-id)
(if (null? s) (if (null? s)
(insert-value db table entity-id ktv #t) (insert-value db table entity-id ktv #t)
(db-exec (db-exec
...@@ -489,7 +489,7 @@ ...@@ -489,7 +489,7 @@
entity-id (ktv-key kt))) entity-id (ktv-key kt)))
(define (clean-entity-values db table entity-id) (define (clean-entity-values db table entity-id)
(msg "clean-entity-values") ;;(msg "clean-entity-values")
(let* ((entity-type (get-entity-type db table entity-id))) (let* ((entity-type (get-entity-type db table entity-id)))
(cond (cond
((null? entity-type) ((null? entity-type)
...@@ -497,7 +497,7 @@ ...@@ -497,7 +497,7 @@
(else (else
(for-each (for-each
(lambda (kt) (lambda (kt)
(msg "cleaning" kt) ;;(msg "cleaning" kt)
(clean-value db table entity-id (list (ktv-key kt) (ktv-type kt)))) (clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
(get-attribute-ids/types db table entity-type)))))) (get-attribute-ids/types db table entity-type))))))
...@@ -564,13 +564,13 @@ ...@@ -564,13 +564,13 @@
version entity-id)) version entity-id))
(define (update-entity-clean db table unique-id) (define (update-entity-clean db table unique-id)
(msg "cleaning") ;;(msg "cleaning")
;; clean entity table ;; clean entity table
(db-exec (db-exec
db (string-append "update " table "_entity set dirty=? where unique_id = ?") db (string-append "update " table "_entity set dirty=? where unique_id = ?")
0 unique-id) 0 unique-id)
;; clean value tables for this entity ;; clean value tables for this entity
(msg "cleaning values") ;;(msg "cleaning values")
(clean-entity-values db table (entity-id-from-unique db table unique-id)) ) (clean-entity-values db table (entity-id-from-unique db table unique-id)) )
(define (get-dirty-stats db table) (define (get-dirty-stats db table)
...@@ -588,7 +588,7 @@ ...@@ -588,7 +588,7 @@
'() '()
(map (map
(lambda (i) (lambda (i)
(msg "dirty-entities") ;;(msg "dirty-entities")
(list (list
;; build according to url ([table] entity-type unique-id dirty version) ;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i)) (cdr (vector->list i))
......
...@@ -24,7 +24,6 @@ ...@@ -24,7 +24,6 @@
(define (request-args->ktvlist data) (define (request-args->ktvlist data)
(map (map
(lambda (i) (lambda (i)
(msg i)
(let ((kv (string-split (symbol->string (car i)) '(#\:)))) (let ((kv (string-split (symbol->string (car i)) '(#\:))))
(list (list
(car kv) (cadr kv) (cdr i) (string->number (list-ref kv 2))))) (car kv) (cadr kv) (cdr i) (string->number (list-ref kv 2)))))
...@@ -32,13 +31,14 @@ ...@@ -32,13 +31,14 @@
(define (sync-update db table entity-type unique-id dirty version data) (define (sync-update db table entity-type unique-id dirty version data)
(let ((entity-id (entity-id-from-unique db table unique-id)) (let ((entity-id (entity-id-from-unique db table unique-id))
(ktvlist (dbg (request-args->ktvlist data)))) (ktvlist (request-args->ktvlist data)))
(msg "sync-update" ktvlist) (msg "sync-update")
(update-to-version db table entity-id version ktvlist) (update-to-version db table entity-id version ktvlist)
(list "updated" unique-id))) (list "updated" unique-id)))
(define (sync-insert db table entity-type unique-id dirty version data) (define (sync-insert db table entity-type unique-id dirty version data)
(let ((ktvlist (dbg (request-args->ktvlist data)))) (let ((ktvlist (request-args->ktvlist data)))
(msg "inserting new")
(insert-entity-wholesale db table entity-type unique-id dirty version ktvlist) (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(list "inserted" unique-id))) (list "inserted" unique-id)))
...@@ -51,12 +51,12 @@ ...@@ -51,12 +51,12 @@
(define (merge-n-bump current-version db table entity-type unique-id dirty version data) (define (merge-n-bump current-version db table entity-type unique-id dirty version data)
(let ((entity-id (entity-id-from-unique db table unique-id))) (let ((entity-id (entity-id-from-unique db table unique-id)))
(msg "merge start:" (get-entity-version db table entity-id)) ;;(msg "merge start:" (get-entity-version db table entity-id))
(let ((r (sync-update db table entity-type unique-id dirty version data))) (let ((r (sync-update db table entity-type unique-id dirty version data)))
(msg "merge post:" (get-entity-version db table entity-id)) ;;(msg "merge post:" (get-entity-version db table entity-id))
;; must be one newer than highest in the system ;; must be one newer than highest in the system
(update-entity-version db table entity-id (+ current-version 1)) (update-entity-version db table entity-id (+ current-version 1))
(msg "merge over:" (get-entity-version db table entity-id)) ;;(msg "merge over:" (get-entity-version db table entity-id))
r))) r)))
(define (check-for-sync db table entity-type unique-id dirty version data) (define (check-for-sync db table entity-type unique-id dirty version data)
...@@ -117,6 +117,7 @@ ...@@ -117,6 +117,7 @@
(define (entity-versions db table) (define (entity-versions db table)
(let ((s (db-select (let ((s (db-select
db (string-append "select unique_id, version from " table "_entity;")))) db (string-append "select unique_id, version from " table "_entity;"))))
(msg s)
(if (null? s) (if (null? s)
'() '()
(map (map
......
...@@ -44,7 +44,7 @@ ...@@ -44,7 +44,7 @@
;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv") ;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv")
(msg (csv db "sync" "individual")) ;(msg (csv db "sync" "individual"))
(define registered-requests (define registered-requests
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment