Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
citizen-science
symbai
Commits
d7ef0456
Commit
d7ef0456
authored
Apr 14, 2014
by
dave griffiths
Browse files
raspberry pi side of the big sync update
parent
0e50d863
Changes
3
Expand all
Hide whitespace changes
Inline
Side-by-side
web/scripts/eavdb.ss
View file @
d7ef0456
This diff is collapsed.
Click to expand it.
web/scripts/sync.ss
View file @
d7ef0456
...
...
@@ -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
))
...
...
web/server.scm
View file @
d7ef0456
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment