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
nebogeo
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
Showing
3 changed files
with
365 additions
and
90 deletions
+365
-90
web/scripts/eavdb.ss
web/scripts/eavdb.ss
+294
-67
web/scripts/sync.ss
web/scripts/sync.ss
+54
-20
web/server.scm
web/server.scm
+17
-3
No files found.
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