Commit 526b6b82 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

big sync fixed

parent 9cbd5a22
...@@ -334,7 +334,9 @@ ...@@ -334,7 +334,9 @@
(get-entity-id db table unique-id)))) (get-entity-id db table unique-id))))
;; if we don't have this entity or the version on the server is newer ;; if we don't have this entity or the version on the server is newer
(if (or (not exists) old) (if (and (or (not exists) old)
;; limit this to 5 a time
(< (length r) 5))
(cons (suck-entity-from-server db table unique-id) r) (cons (suck-entity-from-server db table unique-id) r)
r))) r)))
'() '()
...@@ -723,3 +725,197 @@ ...@@ -723,3 +725,197 @@
(list (finish-activity 1))) (list (finish-activity 1)))
(else (else
(list))))))))) (list)))))))))
(define vowel (map symbol->string (list 'a 'e 'i 'o 'u)))
(define consonant (map symbol->string (list 'b 'c 'd 'f 'g 'h 'j 'k 'l 'm 'n 'p 'q 'r 's 't 'v 'w 'x 'y 'z)))
(define (word-gen)
(define (_ s vowel-prob)
(cond
((zero? s) '())
((< (random) vowel-prob)
(cons (choose vowel) (_ (- s 1) (/ vowel-prob 2))))
(else
(cons (choose consonant) (_ (- s 1) (* vowel-prob 2))))))
(apply string-append (_ (+ 3 (random-int 8)) 0.5)))
(define (simpsons-village db table default-ktvlist)
(entity-create! db table "village"
(ktvlist-merge
default-ktvlist
(list
(ktv "name" "varchar" (word-gen))
(ktv "block" "varchar" (word-gen))
(ktv "district" "varchar" (word-gen))
(ktv "car" "int" (random-int 2))))))
(define (simpsons-household db table parent default-ktvlist)
(entity-create! db table "household"
(ktvlist-merge
default-ktvlist
(list
(ktv "name" "varchar" (word-gen))
(ktv "num-pots" "int" (random-int 10))
(ktv "parent" "varchar" parent)))))
(define (simpsons-individual db table parent default-ktvlist)
(let ((n (random-int 1000)))
(entity-create! db table "individual"
(ktvlist-merge
default-ktvlist
(append
(list (ktv "parent" "varchar" parent))
(choose
(list
(list
(ktv-create "name" "varchar"
(string-append "Abe-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "abe.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Akira-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "akira.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Apu-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "apu.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Barney-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "barney.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Bart-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "bartsimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Billy-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "billy.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Carl-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "carl.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Cletus-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "cletus.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "ComicBookGuy-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "comicbookguy.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Homer-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "homersimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Jasper-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "jasper.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Kent-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "kentbrockman.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Kodos-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "kodos.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Lenny-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "lenny.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Lisa-" (number->string n)))
(ktv-create "gender" "varchar" "Female")
(ktv-create "photo" "file" "lisasimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Marge-" (number->string n)))
(ktv-create "gender" "varchar" "Female")
(ktv-create "photo" "file" "margesimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Martin-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "martinprince.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Milhouse-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "milhouse.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "MrBurns-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "mrburns.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Ned-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "nedflanders.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Nelson-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "nelson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Otto-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "otto.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Ralph-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "ralphwiggum.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Santaslittlehelper-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "santaslittlehelper.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "SideshowBob-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "sideshowbob.jpg")))))))))
(define (looper! n fn)
(when (not (zero? n))
(fn n)
(looper! (- n 1) fn)))
(msg (random-int 100))
(define (build-test! db table village-ktvlist household-ktvlist individual-ktvlist)
(looper!
3
(lambda (i)
(msg "making village" i)
(let ((village (simpsons-village db table village-ktvlist)))
(looper!
8
(lambda (i)
(alog "household")
(msg "making household" i)
(let ((household (simpsons-household db table village household-ktvlist)))
(looper!
(random-int 30)
(lambda (i)
(msg "making individual" i)
(simpsons-individual db table household individual-ktvlist))))))))))
...@@ -185,7 +185,6 @@ ...@@ -185,7 +185,6 @@
;; update the value given an entity type, a attribute type and it's key (= attriute_id) ;; update the value given an entity type, a attribute type and it's key (= attriute_id)
;; creates the value if it doesn't already exist, updates it otherwise if it's different ;; creates the value if it doesn't already exist, updates it otherwise if it's different
(define (update-value db table entity-id ktv) (define (update-value db table entity-id ktv)
(msg "update-value")
(let ((s (select-first (let ((s (select-first
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 = ?")
...@@ -195,7 +194,6 @@ ...@@ -195,7 +194,6 @@
;; only update if they are different ;; only update if they 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")
(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 = ?")
...@@ -211,7 +209,7 @@ ...@@ -211,7 +209,7 @@
(if (null? s) (if (null? s)
(insert-value db table entity-id ktv #t) (insert-value db table entity-id ktv #t)
(begin (begin
(msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv)) ;;(msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv))
(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=0, version=? where entity_id = ? and attribute_id = ?") " set value=?, dirty=0, version=? where entity_id = ? and attribute_id = ?")
...@@ -270,7 +268,7 @@ ...@@ -270,7 +268,7 @@
(let ((vdv (get-value db table entity-id kt))) (let ((vdv (get-value db table entity-id kt)))
(if (null? vdv) (if (null? vdv)
(begin (begin
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt)) ;;(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r) r)
(cons (list (ktv-key kt) (ktv-type kt) (cons (list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)) r)))) (list-ref vdv 0) (list-ref vdv 2)) r))))
...@@ -279,23 +277,19 @@ ...@@ -279,23 +277,19 @@
;; get an entire entity, as a list of key/value pairs, only dirty values ;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id) (define (get-entity-plain-for-sync db table entity-id)
(msg "gepfs")
(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) (msg "entity" entity-id "not found!") '()) ((null? entity-type) (msg "entity" entity-id "not found!") '())
(else (else
(foldl (foldl
(lambda (kt r) (lambda (kt r)
(msg kt)
(let ((vdv (get-value db table entity-id kt))) (let ((vdv (get-value db table entity-id kt)))
(msg vdv)
(cond (cond
((null? vdv) ((null? vdv)
(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt)) ;;(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
r) r)
;; only return if dirty ;; only return if dirty
((not (zero? (cadr vdv))) ((not (zero? (cadr vdv)))
(msg "value-dirty-version found" vdv)
(cons (cons
(list (ktv-key kt) (ktv-type kt) (list-ref vdv 0) (list-ref vdv 2)) (list (ktv-key kt) (ktv-type kt) (list-ref vdv 0) (list-ref vdv 2))
r)) r))
...@@ -310,6 +304,24 @@ ...@@ -310,6 +304,24 @@
(list "unique_id" "varchar" unique-id) (list "unique_id" "varchar" unique-id)
(get-entity-plain db table entity-id)))) (get-entity-plain db table entity-id))))
;; like get-entity-plain, but only look for specific key/types - for speed
(define (get-entity-only db table entity-id kt-list)
(let ((unique-id (get-unique-id db table entity-id)))
(cons
(list "unique_id" "varchar" unique-id)
(foldl
(lambda (kt r)
(let ((vdv (get-value db table entity-id kt)))
(if (null? vdv)
(begin
;;(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r)
(cons (list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)) r))))
'()
kt-list))))
(define (all-entities db table type) (define (all-entities db table type)
(let ((s (db-select (let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e " db (string-append "select e.entity_id from " table "_entity as e "
...@@ -468,6 +480,13 @@ ...@@ -468,6 +480,13 @@
(get-entity db table i)) (get-entity db table i))
(filter-entities db table type filter))) (filter-entities db table type filter)))
;; only return name and photo
(define (db-filter-only db table type filter kt-list)
(map
(lambda (i)
(get-entity-only db table i kt-list))
(filter-entities db table type filter)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
...@@ -479,7 +498,6 @@ ...@@ -479,7 +498,6 @@
;; auto update version ;; auto update version
(define (update-entity db table entity-id ktvlist) (define (update-entity db table entity-id ktvlist)
(msg "update-entity")
;; dirty ;; dirty
(update-entity-changed db table entity-id) (update-entity-changed db table entity-id)
(update-entity-values db table entity-id ktvlist #t)) (update-entity-values db table entity-id ktvlist #t))
...@@ -490,7 +508,6 @@ ...@@ -490,7 +508,6 @@
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")
(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)
...@@ -498,14 +515,13 @@ ...@@ -498,14 +515,13 @@
(else (else
(for-each (for-each
(lambda (kt) (lambda (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))))))
;; update an entity, via a (possibly partial) list of key/value pairs ;; update an entity, via a (possibly partial) list of key/value pairs
;; if dirty is not true, this is coming from a sync ;; if dirty is not true, this is coming from a sync
(define (update-entity-values db table entity-id ktvlist dirty) (define (update-entity-values db table entity-id ktvlist dirty)
(msg "update-entity-values") ;;(msg "update-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) (msg "entity" entity-id "not found!") '()) ((null? entity-type) (msg "entity" entity-id "not found!") '())
...@@ -568,15 +584,21 @@ ...@@ -568,15 +584,21 @@
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 (have-dirty? db table)
(not (zero?
(select-first
db (string-append "select count(entity_id) from " table "_entity where dirty=1")))))
(define (get-dirty-stats db table) (define (get-dirty-stats db table)
(list (list
(select-first (select-first
...@@ -589,17 +611,18 @@ ...@@ -589,17 +611,18 @@
(define (dirty-entities db table) (define (dirty-entities db table)
(let ((de (db-select (let ((de (db-select
db (string-append db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;")))) "select entity_id, entity_type, unique_id, dirty, version from "
table "_entity where dirty=1 limit 5;"))))
(msg de)
(if (null? de) (if (null? de)
'() '()
(map (map
(lambda (i) (lambda (i)
(msg "dirty-entities") (msg "dirty:" (vector-ref i 2))
(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))
;; data entries (todo - only dirty values!) (get-entity-plain-for-sync db table (vector-ref i 0))))
(dbg (get-entity-plain-for-sync db table (vector-ref i 0)))))
(cdr de))))) (cdr de)))))
;; todo: BROKEN... ;; todo: BROKEN...
......
...@@ -269,6 +269,9 @@ ...@@ -269,6 +269,9 @@
(define random (define random
(random-maker 19781116)) ;; another arbitrarily chosen birthday (random-maker 19781116)) ;; another arbitrarily chosen birthday
(define (random-int n)
(abs (random n)))
(define rndf random) (define rndf random)
(define (rndvec) (vector (rndf) (rndf) (rndf))) (define (rndvec) (vector (rndf) (rndf) (rndf)))
......
...@@ -303,9 +303,24 @@ ...@@ -303,9 +303,24 @@
(list 'weekly (list "Weekly")) (list 'weekly (list "Weekly"))
(list 'monthly (list "Monthly")) (list 'monthly (list "Monthly"))
(list 'less (list "Less")) (list 'less (list "Less"))
)) ))
(define village-ktvlist
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-village-name))
(ktv-create "block" "varchar" "")
(ktv-create "district" "varchar" "test")
(ktv-create "car" "int" 0)))
(define household-ktvlist
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-household-name))
(ktv-create "num-pots" "int" 0)
(ktv-create "house-lat" "real" 0) ;; get from current location?
(ktv-create "house-lon" "real" 0)
(ktv-create "toilet-lat" "real" 0)
(ktv-create "toilet-lon" "real" 0)))
(define individual-ktvlist (define individual-ktvlist
(list (list
(ktv-create "name" "varchar" (mtext-lookup 'default-individual-name)) (ktv-create "name" "varchar" (mtext-lookup 'default-individual-name))
...@@ -371,10 +386,10 @@ ...@@ -371,10 +386,10 @@
(append (append
(list (toast "sync-cb")) (list (toast "sync-cb"))
(upload-dirty db) (upload-dirty db)
(suck-new db "sync"))))) (if (have-dirty? db "sync") '() (suck-new db "sync"))))))
(else '())) (else '()))
(list (list
(delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb) (delayed "debug-timer" (+ 30000 (random 5000)) debug-timer-cb)
(update-debug)))) (update-debug))))
...@@ -544,40 +559,61 @@ ...@@ -544,40 +559,61 @@
(define (update-individual-filter) (define (update-individual-filter)
(update-widget (let ((search (db-filter-only db "sync" "individual" (filter-get)
'linear-layout (get-id "choose-pics") 'contents (list
(grid-ify (list "photo" "file")
(map (list "name" "varchar")))))
(lambda (e) (update-widget
(let* ((id (ktv-get e "unique_id")) 'linear-layout (get-id "choose-pics") 'contents
(image-name (ktv-get e "photo")) (grid-ify
(image (if (image-invalid? image-name) (map
"face" (string-append "/sdcard/symbai/files/" image-name)))) (lambda (e)
(if (equal? image "face") (let* ((id (ktv-get e "unique_id"))
(image-name (ktv-get e "photo"))
(image (if (image-invalid? image-name)
"face" (string-append "/sdcard/symbai/files/" image-name))))
(cond
((> (length search) 50)
(button (button
(make-id (string-append "chooser-" id)) (make-id (string-append "chooser-" id))
(ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5) (ktv-get e "name") 30 (layout (car button-size) (/ (cadr button-size) 3) 1 'centre 5)
(lambda () (lambda ()
(set-current! 'choose-result id) (set-current! 'choose-result id)
(list (finish-activity 0)))) (list (finish-activity 0)))))
(image-button
((equal? image "face")
(button
(make-id (string-append "chooser-" id)) (make-id (string-append "chooser-" id))
image (layout (car button-size) (cadr button-size) 1 'centre 5) (ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda () (lambda ()
(set-current! 'choose-result id) (set-current! 'choose-result id)
(list (finish-activity 0))))))) (list (finish-activity 0)))))
(db-filter db "sync" "individual" (filter-get)))
3)))
(define (image-from-unique-id db table unique-id) (else
(vert
(image-button
(make-id (string-append "chooser-" id))
image (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0))))
(text-view 0 (ktv-get e "name") 20 (layout 'wrap-content 'wrap-content -1 'centre 0)))