Skip to content

GitLab

Commit a3c63db9 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

big syncing changes, partially complete

parent 37bd7a16
Hide whitespace changes
Inline Side-by-side
Showing with 224 additions and 97 deletions
android/assets/dbsync.scm
View file @ a3c63db9
......@@ -75,13 +75,23 @@
(get-current 'entity-values '())
(ktv key type value))))
;; internal version for checking version numbers are propagating properly
;; this is for automatically added ktv data (and adds 0 version)
;; rather than from the ui (which adds -999 by default)
(define (entity-add-value-create! key type value)
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv-create key type value))))
(define (entity-set! ktv-list)
(set-current! 'entity-values ktv-list))
(define (entity-get-value key)
(ktv-get (get-current 'entity-values '()) key))
;; version to check the entity has the key
(define (entity-set-value! key type value)
(msg "entity-set-value!")
......@@ -110,11 +120,11 @@
(table (get-current 'table #f))
(type (get-current 'entity-type #f)))
;; standard bits
(entity-add-value! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value! "time" "varchar" (date-time->string (date-time)))
(entity-add-value! "lat" "real" (car (get-current 'location '(0 0))))
(entity-add-value! "lon" "real" (cadr (get-current 'location '(0 0))))
(entity-add-value! "deleted" "int" 0)
(entity-add-value-create! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value-create! "time" "varchar" (date-time->string (date-time)))
(entity-add-value-create! "lat" "real" (car (get-current 'location '(0 0))))
(entity-add-value-create! "lon" "real" (cadr (get-current 'location '(0 0))))
(entity-add-value-create! "deleted" "int" 0)
(let ((values (get-current 'entity-values '())))
(cond
((not (null? values))
......@@ -165,7 +175,7 @@
(msg "url")
(define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) ":" (number->string (ktv-version ktv)) "=" (stringify-value-url ktv)))
(define (build-url-from-ktvlist ktvlist)
(foldl
......@@ -201,13 +211,12 @@
r))
'() ktvlist))
(msg "spit")
;; spit all dirty entities to server
(define (spit db table entities)
(msg "running spit")
(foldl
(lambda (e r)
(msg (car (car e)))
(debug! (string-append "Sending a " (car (car e)) " to Raspberry Pi"))
(append
(list
......@@ -272,6 +281,8 @@
(ktvlist (list-ref data 1))
(unique-id (list-ref entity 1))
(exists (entity-exists? db table unique-id)))
(msg "from server...:")
(msg ktvlist)
;; need to check exists again here, due to delays back and forth
(if (not exists)
(insert-entity-wholesale
......@@ -537,7 +548,7 @@
((eq? widget-type 'image-view)
(let ((image-name (entity-get-value key)))
(msg "updating image widget to: " image-name)
(if (or (not image-name) (equal? image-name "none"))
(if (image-invalid? image-name)
(update-widget widget-type (get-symbol-id id-symbol) 'image "face")
(update-widget widget-type (get-symbol-id id-symbol) 'external-image
(string-append dirname "files/" image-name)))))
......@@ -584,8 +595,8 @@
(define (do-gps display-id key-prepend)
(let ((loc (get-current 'location '(0 0))))
(entity-add-value! (string-append key-prepend "-lat") "real" (car loc))
(entity-add-value! (string-append key-prepend "-lon") "real" (cadr loc))
(entity-add-value-create! (string-append key-prepend "-lat") "real" (car loc))
(entity-add-value-create! (string-append key-prepend "-lon") "real" (cadr loc))
(list
(update-widget
'text-view
......@@ -623,7 +634,7 @@
40 (layout 100 'wrap-content 1 'centre 5)
(lambda ()
(entity-init! db table entity-type ktv-default)
(entity-add-value! "parent" "varchar" (parent-fn))
(entity-add-value-create! "parent" "varchar" (parent-fn))
(entity-record-values!)
(list (update-list-widget db table entity-type edit-activity (parent-fn))))))
(linear-layout
......
android/assets/eavdb.scm
View file @ a3c63db9
......@@ -31,18 +31,40 @@
(define (setup db table)
(db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))"))
(db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer)"))
(db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer)"))
(db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer)"))
(db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer)")))
(db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; basic key/type/value structure
(define (ktv key type value) (list key type value))
;; used for all data internally, and maps to the eavdb types
(define (ktv key type value) (list key type value -999))
(define (ktv-with-version key type value version) (list key type value version))
(define (ktv-create key type value) (list key type value 0))
(define ktv-key car)
(define ktv-type cadr)
(define ktv-value caddr)
(define (ktv-version ktv) (list-ref ktv 3))
(define (ktv-eq? a b)
(and
(equal? (ktv-key a) (ktv-key b))
(equal? (ktv-type a) (ktv-type b))
(cond
((or
(equal? (ktv-type a) "int")
(equal? (ktv-type a) "real"))
(eqv? (ktv-value a) (ktv-value b)))
((or
(equal? (ktv-type a) "varchar")
(equal? (ktv-type a) "file"))
(equal? (ktv-value a) (ktv-value b)))
(else
(msg "unsupported ktv type in ktv-eq?: " (ktv-type a))
#f))))
;; stringify based on type (for url)
(define (stringify-value ktv)
......@@ -64,6 +86,7 @@
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helper to return first instance from a select
(define (select-first db str . args)
......@@ -104,11 +127,11 @@
type))))))
;; low level insert of a ktv
(define (insert-value db table entity-id ktv)
(define (insert-value db table entity-id ktv dirty)
;; use type to dispatch insert to correct value table
(db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
" values (null, ?, ?, ?, 0)")
entity-id (ktv-key ktv) (ktv-value ktv)))
" values (null, ?, ?, ?, ?, ?)")
entity-id (ktv-key ktv) (ktv-value ktv) dirty (ktv-version ktv)))
(define (get-unique user)
(let ((t (time-of-day)))
......@@ -139,23 +162,46 @@
;; add all the keys
(for-each
(lambda (ktv)
(insert-value db table id ktv))
(insert-value db table id ktv dirty))
ktvlist)
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
;; creates the value if it doesn't already exist, updates it otherwise if it's different
(define (update-value db table entity-id ktv)
(if (null? (select-first
db (string-append
"select * from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
entity-id (ktv-key ktv)))
(insert-value db table entity-id ktv)
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=? where entity_id = ? and attribute_id = ?")
(ktv-value ktv) entity-id (ktv-key ktv))))
(msg "update-value")
(let ((s (select-first
db (string-append
"select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
entity-id (ktv-key ktv))))
(if (null? s)
(insert-value db table entity-id ktv #t)
;; only update if they are different
(if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s)))
(begin
(msg "incrementing value version in update-value")
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?")
(ktv-value ktv) entity-id (ktv-key ktv)))
'())))) ;;(msg "values for" (ktv-key ktv) "are the same (" (ktv-value ktv) "==" s ")")))))
;; don't make dirty or update version here
(define (update-value-from-sync db table entity-id ktv version)
(let ((s (select-first
db (string-append
"select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
entity-id (ktv-key ktv))))
(msg "uvfs")
(msg (ktv-value ktv))
(msg s)
(if (null? s)
(insert-value db table entity-id ktv #t)
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=0, version=? where entity_id = ? and attribute_id = ?")
(ktv-value ktv) entity-id (ktv-key ktv) (ktv-version ktv)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
......@@ -188,22 +234,56 @@
(vector-ref row 3))) ;; type
(cdr s)))))
;; get the value given an entity type, a attribute type and it's key (= attriute_id)
;; get the value, dirty and version given an entity type, a attribute type and it's key (= attriute_id)
(define (get-value db table entity-id kt)
(select-first
db (string-append "select value from " table "_value_" (ktv-type kt)
" where entity_id = ? and attribute_id = ?")
entity-id (ktv-key kt)))
(let ((s (db-select
db (string-append "select value, dirty, version from " table "_value_" (ktv-type kt)
" where entity_id = ? and attribute_id = ?")
entity-id (ktv-key kt))))
(if (null? s) '()
(list (vector-ref (cadr s) 0)
(vector-ref (cadr s) 1)
(vector-ref (cadr s) 2)))))
;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id)
(msg "get-entity-plain")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(map
(lambda (kt)
(list (ktv-key kt) (ktv-type kt) (get-value db table entity-id kt)))
(let ((vdv (get-value db table entity-id kt)))
(msg vdv)
(if (null? vdv)
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
(list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)))))
(get-attribute-ids/types db table entity-type))))))
;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(foldl
(lambda (kt r)
(msg "kt is" kt)
(let ((vdv (get-value db table entity-id kt)))
(cond
((null? vdv)
(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
r)
;; only return if dirty
((not (zero? (cadr vdv)))
(msg "value-dirty-version found" vdv)
(cons
(list (ktv-key kt) (ktv-type kt) (list-ref vdv 0) (list-ref vdv 2))
r))
(else r))))
'()
(get-attribute-ids/types db table entity-type))))))
;; get an entire entity, as a list of key/value pairs (includes entity id)
......@@ -376,16 +456,39 @@
;; update an entire entity (version incl), via a (possibly partial) list of key/value pairs
(define (update-to-version db table entity-id version ktvlist)
(update-entity-values db table entity-id ktvlist)
;; not dirty
(update-entity-values db table entity-id ktvlist #f)
(update-entity-version db table entity-id version))
;; auto update version
(define (update-entity db table entity-id ktvlist)
(msg "update-entity")
;; dirty
(update-entity-changed db table entity-id)
(update-entity-values db table entity-id ktvlist))
(update-entity-values db table entity-id ktvlist #t))
(define (clean-value db table entity-id kt)
(db-exec db (string-append "update " table "_value_" (ktv-type kt)
" set dirty=0 where entity_id = ? and attribute_id = ?")
entity-id (ktv-key kt)))
(define (clean-entity-values db table entity-id)
(msg "clean-entity-values")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type)
(msg "clean-entity-values: entity" entity-id "not found!") '())
(else
(for-each
(lambda (kt)
(msg "cleaning" kt)
(clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
(get-attribute-ids/types db table entity-type))))))
;; update an entity, via a (possibly partial) list of key/value pairs
(define (update-entity-values db table entity-id ktvlist)
;; if dirty is not true, this is coming from a sync
(define (update-entity-values db table entity-id ktvlist dirty)
(msg "update-entity-values")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
......@@ -398,7 +501,10 @@
ktvlist)
(for-each
(lambda (ktv)
(update-value db table entity-id ktv))
(when (not (equal? (ktv-key ktv) "unique_id"))
(if dirty
(update-value db table entity-id ktv)
(update-value-from-sync db table entity-id ktv))))
ktvlist)))))
;; update or create an entire entity if it doesn't exist
......@@ -434,8 +540,8 @@
(define (update-entity-changed db table entity-id)
(db-exec
db (string-append
"update " table "_entity set dirty=?, version=? where entity_id = ?")
1 (+ 1 (get-entity-version db table entity-id)) entity-id))
"update " table "_entity set dirty=?, version=version+1 where entity_id = ?")
1 entity-id))
(define (update-entity-version db table entity-id version)
(db-exec
......@@ -444,9 +550,14 @@
1 version entity-id))
(define (update-entity-clean db table unique-id)
(msg "cleaning")
;; clean entity table
(db-exec
db (string-append "update " table "_entity set dirty=? where unique_id = ?")
0 unique-id))
0 unique-id)
;; clean value tables for this entity
(msg "cleaning values")
(clean-entity-values db table (entity-id-from-unique db table unique-id)) )
(define (get-dirty-stats db table)
(list
......@@ -455,6 +566,8 @@
(select-first
db (string-append "select count(entity_id) from " table "_entity;"))))
(define (dirty-entities db table)
(let ((de (db-select
db (string-append
......@@ -463,13 +576,16 @@
'()
(map
(lambda (i)
(msg "dirty-entities")
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
;; data entries (todo - only dirty values!)
(get-entity-plain db table (vector-ref i 0))))
(dbg (get-entity-plain-for-sync db table (vector-ref i 0)))))
(cdr de)))))
;; todo: BROKEN...
;; used for sync-all
(define (dirty-and-all-entities db table)
(let ((de (db-select
db (string-append
......@@ -481,7 +597,7 @@
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
;; data entries (todo - only dirty values!)
;; data entries (todo - only dirty values!)???????????
(get-entity-plain db table (vector-ref i 0))))
(cdr de)))))
......
android/assets/starwisp.scm
View file @ a3c63db9
......@@ -529,10 +529,10 @@
(build-list-widget
db "sync" 'villages "village" "village" (lambda () #f)
(list
(ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "block" "varchar" "")
(ktv "district" "varchar" "test")
(ktv "car" "int" 0))))
(ktv-create "name" "varchar" (mtext-lookup 'default-village-name))
(ktv-create "block" "varchar" "")
(ktv-create "district" "varchar" "test")
(ktv-create "car" "int" 0))))
(lambda (activity arg)
(set-current! 'activity-title "Main screen")
......@@ -622,12 +622,12 @@
(build-list-widget
db "sync" 'households "household" "household" (lambda () (get-current 'village #f))
(list
(ktv "name" "varchar" (mtext-lookup 'default-household-name))
(ktv "num-pots" "int" 0)
(ktv "house-lat" "real" 0) ;; get from current location?
(ktv "house-lon" "real" 0)
(ktv "toilet-lat" "real" 0)
(ktv "toilet-lon" "real" 0))))
(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))))
(lambda (activity arg)
(set-current! 'activity-title "Household List")
(activity-layout activity))
......@@ -664,44 +664,44 @@
db "sync" 'individuals "individual" "individual"
(lambda () (get-current 'household #f))
(list
(ktv "name" "varchar" (mtext-lookup 'default-individual-name))
(ktv "family" "varchar" (mtext-lookup 'default-family-name))
(ktv "photo-id" "varchar" (mtext-lookup 'default-photo-id))
(ktv "photo" "file" "none")
(ktv "tribe" "varchar" "none")
(ktv "subtribe" "varchar" "none")
(ktv "age" "int" 0)
(ktv "gender" "varchar" "Female")
(ktv "education" "varchar" "none")
(ktv "head-of-house" "varchar" "none")
(ktv "marital-status" "varchar" "none")
(ktv "times-married" "int" 0)
(ktv "id-spouse" "varchar" "none")
(ktv "children-living" "int" 0)
(ktv "children-dead" "int" 0)
(ktv "children-together" "int" 0)
(ktv "children-apart" "int" 0)
(ktv "residence-after-marriage" "varchar" "none")
(ktv "num-siblings" "int" 0)
(ktv "birth-order" "int" 0)
(ktv "length-time" "int" 0)
(ktv "place-of-birth" "varchar" "none")
(ktv "num-residence-changes" "int" 0)
(ktv "village-visits-month" "int" 0)
(ktv "village-visits-year" "int" 0)
(ktv "occupation" "varchar" "none")
(ktv "contribute" "int" 0)
(ktv "own-land" "int" 0)
(ktv "rent-land" "int" 0)
(ktv "hire-land" "int" 0)
(ktv "house-type" "varchar" "none")
(ktv "loan" "int" 0)
(ktv "earning" "int" 0)
(ktv "radio" "int" 0)
(ktv "tv" "int" 0)
(ktv "mobile" "int" 0)
(ktv "visit-market" "int" 0)
(ktv "town-sell" "int" 0)
(ktv-create "name" "varchar" (mtext-lookup 'default-individual-name))
(ktv-create "family" "varchar" (mtext-lookup 'default-family-name))
(ktv-create "photo-id" "varchar" (mtext-lookup 'default-photo-id))
(ktv-create "photo" "file" "none")
(ktv-create "tribe" "varchar" "none")
(ktv-create "subtribe" "varchar" "none")
(ktv-create "age" "int" 0)
(ktv-create "gender" "varchar" "Female")
(ktv-create "education" "varchar" "none")
(ktv-create "head-of-house" "varchar" "none")
(ktv-create "marital-status" "varchar" "none")
(ktv-create "times-married" "int" 0)
(ktv-create "id-spouse" "varchar" "none")
(ktv-create "children-living" "int" 0)
(ktv-create "children-dead" "int" 0)
(ktv-create "children-together" "int" 0)
(ktv-create "children-apart" "int" 0)
(ktv-create "residence-after-marriage" "varchar" "none")
(ktv-create "num-siblings" "int" 0)
(ktv-create "birth-order" "int" 0)
(ktv-create "length-time" "int" 0)
(ktv-create "place-of-birth" "varchar" "none")
(ktv-create "num-residence-changes" "int" 0)
(ktv-create "village-visits-month" "int" 0)
(ktv-create "village-visits-year" "int" 0)
(ktv-create "occupation" "varchar" "none")
(ktv-create "contribute" "int" 0)
(ktv-create "own-land" "int" 0)
(ktv-create "rent-land" "int" 0)
(ktv-create "hire-land" "int" 0)
(ktv-create "house-type" "varchar" "none")
(ktv-create "loan" "int" 0)
(ktv-create "earning" "int" 0)
(ktv-create "radio" "int" 0)
(ktv-create "tv" "int" 0)
(ktv-create "mobile" "int" 0)
(ktv-create "visit-market" "int" 0)
(ktv-create "town-sell" "int" 0)
))
(delete-button))
......
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