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

raspberry pi side of the big sync update

parent 0e50d863
This diff is collapsed.
......@@ -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 others get merged version
(merge-n-bump current-version db table entity-type unique-id dirty version data))
;; it's changed, but has an old or same version = conflict!!??
((and (eq? dirty 1) (<= version current-version))
(list "CONFLICT" unique-id))
;; still merge, but complicated...
((and (eq? dirty 1) (< version current-version))
(msg "CONFLICT, merging")
(list "CONFLICT" unique-id)
;; bump the version number so others get merged version
(merge-n-bump current-version db table entity-type unique-id dirty version data))
;; not dirty path (avoid doing stuff here as it's probably a bug)
;; android version is newer but not changed??
;; android version is newer than existing but not changed??
((and (eq? dirty 0) (> version current-version))
(msg "MISMATCH")
(list "MISMATCH" unique-id))
;; everything matches - no change
((and (eq? dirty 0) (eq? version current-version))
(msg "NOT DIRTY, WHY SENT? (eq)")
(list "no change" unique-id))
;; need to send update
((and (eq? dirty 0) (< version current-version))
(msg "NOT DIRTY, WHY SENT? (older)")
(list "no change" unique-id))
(else
(list "WAT?" unique-id)))
(msg "WAT?")
(list "WAT?" unique-id))))
;; doesnt exist yet, so insert it
(sync-insert db table entity-type unique-id dirty version data))))
(define (entity-versions db table)
(map
(lambda (i)
(list (vector-ref i 0) (vector-ref i 1)))
(cdr (db-select
db (string-append "select unique_id, version from " table "_entity;")))))
(let ((s (db-select
db (string-append "select unique_id, version from " table "_entity;"))))
(if (null? s)
'()
(map
(lambda (i)
(list (vector-ref i 0) (vector-ref i 1)))
(cdr s)))))
(define (send-entity db table unique-id)
(let* ((entity-id (entity-id-from-unique db table unique-id))
......
......@@ -63,7 +63,18 @@
(pluto-response (scheme->txt '("ok")))))
;; http://localhost:8888/mongoose?fn=sync&table=sync&entity-type=mongoose&unique-id=dave1234&dirty=1&version=0&next:varchar=%22foo%22&blah:int=20
;; all dirty entities are sent to this function from the android in
;; general - we shouldn't care about version numbers from this
;; point locally they are dirty, and that should be it?
;;
;; * perhaps they are very old changes from a tablet that hasn't
;; been updated?
;;
;; * is this the place to flag problems?
;;
;; * sometimes this is not called for dirty entities - in the case
;; of a full db update thing
(register
(req 'sync '(table entity-type unique-id dirty version))
(lambda (req table entity-type unique-id dirty version . data)
......@@ -76,7 +87,8 @@
unique-id
(string->number dirty)
(string->number version) data)))))
;; returns a table of all entities and their corresponding versions
(register
(req 'entity-versions '(table))
(lambda (req table)
......@@ -84,6 +96,8 @@
(scheme->txt
(entity-versions db table)))))
;; returns the entity - the android requests these based on the version numbers
;; (request all ones that are newer than it's stored version)
(register
(req 'entity '(table unique-id))
(lambda (req table unique-id)
......@@ -110,9 +124,9 @@
(define (start request)
(let ((values (url-query (request-uri request))))
(msg values)
(if (not (null? values)) ; do we have some parameters?
(let ((name (assq 'fn values)))
(msg values)
(if name ; is this a well formed request?
(request-dispatch
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