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
5fb8662b
Commit
5fb8662b
authored
May 15, 2014
by
dave griffiths
Browse files
Merge branch 'master' of github.com:nebogeo/symbai
parents
82c71b57
7ad1d0ee
Changes
6
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
87 additions
and
40 deletions
+87
-40
android/assets/dbsync.scm
android/assets/dbsync.scm
+38
-29
android/assets/lib.scm
android/assets/lib.scm
+12
-0
eavdb/entity-get.ss
eavdb/entity-get.ss
+2
-3
eavdb/entity-insert.ss
eavdb/entity-insert.ss
+35
-0
eavdb/entity-sync.ss
eavdb/entity-sync.ss
+0
-1
eavdb/entity-update.ss
eavdb/entity-update.ss
+0
-7
No files found.
android/assets/dbsync.scm
View file @
5fb8662b
...
...
@@ -215,37 +215,45 @@
;; redundant second pass to syncronise files - independant of the
;; rest of the syncing system
(
define
(
sync-files
server-list
)
(
let
((
local-
files
(
dir-list
"/sdcard/symbai/files/"
)))
(
let
((
local-
list
(
dir-list
"/sdcard/symbai/files/"
)))
;; search for all local files in server list
(
dbg
(
crop
(
append
(
foldl
(
lambda
(
file
r
)
;; send files not present
(
if
(
find
file
server-list
)
(
if
(
or
(
eqv?
(
string-ref
file
0
)
#\.
)
(
in-list?
file
server-list
))
r
(
cons
(
http-upload
(
string-append
"upload-"
file
)
"http://192.168.2.1:8889/symbai?fn=upload"
(
string-append
"/sdcard/symbai/files/"
file
))
r
)))
'
()
local-list
)
;; search for all server files in local list
(
foldl
(
lambda
(
file
r
)
;; request files not present
(
if
(
f
in
d
file
local-list
)
(
if
(
in
-list?
file
local-list
)
r
(
cons
(
http-download
(
string-append
"download-"
file
)
(
string-append
"http://192.168.2.1:8889/files/"
file
)
(
string-append
"/sdcard/symbai/files/"
file
))
r
)))
server-list
))))
'
()
server-list
))
;; restrict the number of uploads each time round
2
))))
(
define
(
start-sync-files
)
(
list
(
http-request
(
string-append
"file-list"
)
(
string-append
url
"fn=file-list"
)
(
lambda
(
file-list
)
(
sync-files
file-list
))))
(
dbg
(
sync-files
file-list
))))
))
;; spit all dirty entities to server
(
define
(
spit
db
table
entities
)
...
...
@@ -353,13 +361,14 @@
version-data
))
(
define
(
mark-unlisted-entities-dirty!
db
table
version-data
)
(
msg
"mark-unlisted..."
)
;; load all local entities
(
let
((
ids
(
all-unique-ids
db
table
))
(
server-ids
(
map
car
version-data
)))
;; look for each one in data
(
for-each
(
lambda
(
id
)
(
when
(
(
not
(
f
in
d
id
server-ids
))
)
(
when
(
not
(
in
-list?
id
server-ids
))
(
msg
"can't find "
id
" in server data, marking dirty"
)
;; mark those not present as dirty for next spit cycle
(
update-entity-dirtify
db
table
id
)))
...
...
android/assets/lib.scm
View file @
5fb8662b
...
...
@@ -60,6 +60,18 @@
(
else
(
_
(
cdr
in
)
(
cons
(
cons
(
car
in
)
(
car
out
))
(
cdr
out
))
(
-
c
1
)))))
(
reverse
(
map
reverse
(
_
l
'
(())
n
))))
(
define
(
crop
l
n
)
(
cond
((
null?
l
)
'
())
((
zero?
n
)
'
())
(
else
(
cons
(
car
l
)
(
crop
(
cdr
l
)
(
-
n
1
))))))
(
define
(
in-list?
n
l
)
(
cond
((
null?
l
)
#f
)
((
equal?
n
(
car
l
))
#t
)
(
else
(
in-list?
n
(
cdr
l
)))))
(
define
(
find
n
l
)
(
cond
((
null?
l
)
#f
)
...
...
eavdb/entity-get.ss
View file @
5fb8662b
...
...
@@ -71,10 +71,9 @@
(
cond
((
null?
vd
)
r
)
;; only return if dirty
((
zero?
(
cadr
vd
))
(
(
not
(
zero?
(
cadr
vd
))
)
(
cons
(
list
(
ktv-key
kt
)
(
ktv-type
kt
)
(
list-ref
vd
0
))
r
))
(
list
(
ktv-key
kt
)
(
ktv-type
kt
)
(
list-ref
vd
0
))
r
))
(
else
r
)))
db
table
entity-id
))
...
...
eavdb/entity-insert.ss
View file @
5fb8662b
...
...
@@ -28,12 +28,23 @@
(
define
(
insert-entity
db
table
entity-type
user
ktvlist
)
(
insert-entity-wholesale
db
table
entity-type
(
get-unique
user
)
1
0
ktvlist
))
;; insert an entire entity
(
define
(
insert-entity-with-id
db
table
id
entity-type
user
ktvlist
)
(
insert-entity-wholesale-with-id
db
table
id
entity-type
(
get-unique
user
)
1
0
ktvlist
))
;; insert an entire entity
(
define
(
insert-entity/get-unique
db
table
entity-type
user
ktvlist
)
(
let
((
uid
(
get-unique
user
)))
(
insert-entity-wholesale
db
table
entity-type
uid
1
0
ktvlist
)
uid
))
;; used for the app preferences
(
define
(
insert-entity-if-not-exists
db
table
entity-type
user
entity-id
ktvlist
)
(
let
((
found
(
get-entity-type
db
table
entity-id
)))
(
if
(
null?
found
)
(
insert-entity-with-id
db
table
entity-id
entity-type
user
ktvlist
)
#f
)))
(
define
entity-sema
(
make-semaphore
1
))
;; all the parameters - for syncing purposes
...
...
@@ -60,3 +71,27 @@
(
semaphore-post
entity-sema
)
id
))
(
define
(
insert-entity-wholesale-with-id
db
table
id
entity-type
unique-id
dirty
version
ktvlist
)
(
semaphore-wait
entity-sema
)
(
db-exec
db
"begin transaction"
)
(
let
((
id
(
db-insert
db
(
string-append
"insert into "
table
"_entity values (?, ?, ?, ?, ?)"
)
id
entity-type
unique-id
dirty
version
)))
;; create the attributes if they are new, and validate them if they exist
(
for-each
(
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
dirty
))
ktvlist
)
(
db-exec
db
"end transaction"
)
(
semaphore-post
entity-sema
)
id
))
eavdb/entity-sync.ss
View file @
5fb8662b
...
...
@@ -77,7 +77,6 @@
(
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-for-sync
db
table
(
vector-ref
i
0
))))
(
cdr
de
)))))
...
...
eavdb/entity-update.ss
View file @
5fb8662b
...
...
@@ -111,13 +111,6 @@
(
update-entity
db
table
entity-id
ktvlist
)
#f
))))
(
define
(
insert-entity-if-not-exists
db
table
entity-type
user
entity-id
ktvlist
)
(
let
((
found
(
get-entity-type
db
table
entity-id
)))
(
if
(
null?
found
)
(
insert-entity
db
table
entity-type
user
ktvlist
)
#f
)))
(
define
(
entity-update-test
db
table
)
(
define
e
(
insert-entity
db
table
"thing"
"me"
(
list
(
ktv
"param1"
"varchar"
"bob"
)
...
...
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