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

raspberry pi side of the big sync update

parent 0e50d863
......@@ -34,18 +34,39 @@
(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, 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-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)
......@@ -67,6 +88,7 @@
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helper to return first instance from a select
(define (select-first db str . args)
......@@ -107,11 +129,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) (if dirty 1 0) (ktv-version ktv)))
(define (get-unique user)
(let ((t (time)))
......@@ -144,11 +166,10 @@
(lambda (ktv)
(find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv)))
ktvlist)
;; add all the keys
(for-each
(lambda (ktv)
(insert-value db table id ktv))
(insert-value db table id ktv dirty))
ktvlist)
(db-exec db "end transaction")
......@@ -156,18 +177,41 @@
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))))
(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 the 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)
(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 "update-value-from-sync" s)
(msg ktv)
(msg entity-id)
(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) (ktv-version ktv) entity-id (ktv-key ktv)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
......@@ -200,12 +244,16 @@
(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)
......@@ -215,7 +263,33 @@
(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)))
(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)
(let ((vdv (get-value db table entity-id kt)))
(cond
((null? vdv)
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r)
;; only return if dirty
((zero? (cadr 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)
......@@ -227,8 +301,108 @@
(define (all-entities db table type)
(let ((s (db-select
db (string-append "select entity_id from " table "_entity where entity_type = ?")
type)))
db (string-append "select e.entity_id from " table "_entity as e "
"join " table "_value_varchar "
" as n on n.entity_id = e.entity_id and n.attribute_id = ?"
"left join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = ? "
"where e.entity_type = ? "
"and (d.value='NULL' or d.value is NULL or d.value = 0) "
"order by n.value")
"name" "deleted" type)))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (all-entities-with-parent db table type parent)
(let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e "
"join " table "_value_varchar "
" as n on n.entity_id = e.entity_id and n.attribute_id = ?"
"join " table "_value_varchar "
" as p on p.entity_id = e.entity_id and p.attribute_id = ?"
"left join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = ? "
"where e.entity_type = ? and "
"p.value = ? and "
"(d.value='NULL' or d.value is NULL or d.value = 0) "
"order by n.value")
"name" "parent" "deleted" type parent)))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
;; filter is list of (attribute-key type op arg) e.g. ("gender" "varchar" "=" "Female")
;; note: only one filter per key..
(define (make-filter k t o a) (list k t o a))
(define (filter-key f) (list-ref f 0))
(define (filter-type f) (list-ref f 1))
(define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3))
(define (merge-filter f fl)
(cond
((null? fl) (list f))
((equal? (filter-key (car fl)) (filter-key f))
(cons f (cdr fl)))
(else (cons (car fl) (merge-filter f (cdr fl))))))
(define (delete-filter key fl)
(cond
((null? fl) '())
((equal? (filter-key (car fl)) key)
(cdr fl))
(else (cons (car fl) (delete-filter key (cdr fl))))))
(define (build-query table filter)
(string-append
(foldl
(lambda (i r)
(let ((var (string-append (filter-key i) "_var")))
;; add a query chunk
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
var ".value " (filter-op i) " ? ")))
;; boilerplate query start
(string-append
"select e.entity_id from " table "_entity as e "
;; order by name
"join " table "_value_varchar "
"as n on n.entity_id = e.entity_id and n.attribute_id = 'name' "
;; ignore deleted
"join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 ")
filter)
"where e.entity_type = ? order by n.value"))
(define (build-args filter)
(map
(lambda (i)
(filter-arg i))
filter))
(define (filter-entities db table type filter)
(let ((s (apply
db-select
(dbg (append
(list db (build-query table filter))
(build-args filter)
(list type))))))
(msg (db-status db))
(if (null? s)
'()
(map
......@@ -236,6 +410,7 @@
(vector-ref i 0))
(cdr s)))))
(define (validate db)
;; check attribute for duplicate entity-id/attribute-ids
0)
......@@ -250,6 +425,13 @@
(ktv-value (car ktv-list)))
(else (ktv-get (cdr ktv-list) key))))
(define (ktv-get-type ktv-list key)
(cond
((null? ktv-list) #f)
((equal? (ktv-key (car ktv-list)) key)
(ktv-type (car ktv-list)))
(else (ktv-get-type (cdr ktv-list) key))))
(define (ktv-set ktv-list ktv)
(cond
((null? ktv-list) (list ktv))
......@@ -263,30 +445,54 @@
(get-entity db table i))
(all-entities db table type)))
(define (db-all-where db table type clause)
(foldl
(lambda (i r)
(let ((e (get-entity db table i)))
(if (equal? (ktv-get e (car clause)) (cadr clause))
(cons e r) r)))
'()
(all-entities db table type)))
(define (db-with-parent db table type parent)
(map
(lambda (i)
(get-entity db table i))
(all-entities-with-parent db table type parent)))
(define (db-filter db table type filter)
(map
(lambda (i)
(get-entity db table i))
(filter-entities db table type filter)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
;; 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)
;; 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)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
......@@ -299,7 +505,9 @@
ktvlist)
(for-each
(lambda (ktv)
(update-value db table entity-id ktv))
(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
......@@ -335,19 +543,24 @@
(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
db (string-append
"update " table "_entity set dirty=?, version=? where entity_id = ?")
1 version entity-id))
"update " table "_entity set dirty=0, version=? where entity_id = ?")
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
......@@ -364,13 +577,32 @@
'()
(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!)
(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
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
(if (null? de)
'()
(map
(lambda (i)
(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))))
(cdr de)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing
......@@ -433,15 +665,11 @@
"select entity_id from " table "_entity where unique_id = ?")
unique-id))
(define (get-entity-by-unique db table unique-id)
(get-entity db table (get-entity-id db table unique-id)))
(define (get-entity-name db table unique-id)
(let ((e (get-entity-id db table unique-id)))
(if (null? e)
unique-id
(let ((r (ktv-get (get-entity db table e) "name")))
(if (null? r)
(begin ;(msg "no name for" unique-id "found")
unique-id)
r)))))
(ktv-get (get-entity-by-unique db table unique-id) "name"))
(define (get-entity-names db table id-list)
(foldl
......@@ -457,7 +685,7 @@
(lambda (kt r)
(if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
(string-append r ", \"" (ktv-key kt) "\"")))
"\"id\""
"id, "
(get-attribute-ids/types db table entity-type)))
(define (csv db table entity-type)
......@@ -471,29 +699,27 @@
(cond
((equal? (ktv-key ktv) "unique_id") r)
((null? (ktv-value ktv))
;;(msg "value not found in csv for " (ktv-key ktv))
(msg "value not found in csv for " (ktv-key ktv))
r)
;; dereferences lists of ids
((and
(> (string-length (ktv-key ktv)) 8)
(equal? (substring (ktv-key ktv) 0 8) "id-list-"))
(string-append r ", \"" (get-entity-names db "sync" (string-split (ktv-value ktv) '(#\,))) "\""))
;; look for unique ids and dereference them
;; look for unique ids and dereference them
((and
(> (string-length (ktv-key ktv)) 3)
(equal? (substring (ktv-key ktv) 0 3) "id-"))
(string-append r ", \"" (get-entity-name db "sync" (ktv-value ktv)) "\""))
(else
(string-append r ", \"" (stringify-value-url ktv) "\""))))
(string-append "\"" (vector-ref res 1) "\"") ;; unique_id
(vector-ref res 1) ;; unique_id
entity))))
(csv-titles db table entity-type)
(let ((r (db-select
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type)))
(if (null? r) r (cdr r)))))
(cdr (db-select
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
(define (db-open db-name)
(cond
......@@ -509,9 +735,6 @@
db))))
(define (unit-tests)
;; db
(msg "testing db")
......@@ -562,7 +785,9 @@
(define e (insert-entity db table "thing" "me" (list (ktv "param1" "varchar" "bob")
(ktv "param2" "int" 30)
(ktv "param3" "real" 3.141))))
(ktv "param3" "real" 3.141)
(ktv "name" "varchar" "name")
(ktv "deleted" "int" 0))))
(asserteq "eav ent type" (get-entity-type db table e) "thing")
......@@ -579,6 +804,8 @@
(assert "all-entities" (> (length (all-entities db table "thing")) 0))
(msg "hello")
(update-entity db table e (list (ktv "param1" "varchar" "wotzit")
(ktv "param2" "int" 1)))
......
......@@ -27,12 +27,13 @@
(msg i)
(let ((kv (string-split (symbol->string (car i)) '(#\:))))
(list
(car kv) (cadr kv) (cdr i))))
(car kv) (cadr kv) (cdr i) (string->number (list-ref kv 2)))))
data))
(define (sync-update db table entity-type unique-id dirty version data)
(let ((entity-id (entity-id-from-unique db table unique-id))
(ktvlist (dbg (request-args->ktvlist data))))
(msg "sync-update" ktvlist)
(update-to-version db table entity-id version ktvlist)
(list "updated" unique-id)))
......@@ -48,47 +49,80 @@
(list table entity-type entity-id unique-id current-version)
(get-entity db table entity-id))))
(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)))
(msg "merge start:" (get-entity-version db table entity-id))
(let ((r (sync-update db table entity-type unique-id dirty version data)))
(msg "merge post:" (get-entity-version db table entity-id))
;; must be one newer than highest in the system
(update-entity-version db table entity-id (+ current-version 1))
(msg "merge over:" (get-entity-version db table entity-id))
r)))
(define (check-for-sync db table entity-type unique-id dirty version data)
(let ((current-version (entity-version-from-unique db table unique-id)))
(if (not (null? current-version))
(begin (msg "versions" version "vs previous " current-version)
;; if it exists
(cond
;; everything matches - no change
((and (eq? dirty 0) (eq? version current-version))
(list "no change" unique-id))
;; dirty but matches, should be ok (timeout causes this)
((and (eq? dirty 1) (eq? version current-version))
(list "match" unique-id))
;; dirty path - basically merge it whatever...
;; need to update existing data, newer version from android
((and (eq? dirty 1) (> version current-version) )
(sync-update db table entity-type unique-id dirty version data))
(msg "NEWER - merging...")
;; bump the version as this is a new entity post-merge
(merge-n-bump version db table entity-type unique-id dirty version data))
;; need to send update
((and (eq? dirty 0) (< version current-version))
(send-version db table entity-type unique-id current-version))
;; dirty but matches, should be ok (timeout causes this)
((and (eq? dirty 1) (eq? version current-version))
(msg "MATCHES, merging...")
;;(list "match" unique-id))
;; bump the version number so other