Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
nebogeo
symbai
Commits
494cb5e3
Commit
494cb5e3
authored
May 02, 2014
by
Dave Griffiths
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' of github.com:nebogeo/symbai
parents
f37d1a62
a4d30533
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
70 additions
and
39 deletions
+70
-39
eavdb/entity-insert.ss
eavdb/entity-insert.ss
+3
-3
eavdb/entity-update.ss
eavdb/entity-update.ss
+5
-1
web/server.scm
web/server.scm
+62
-35
No files found.
eavdb/entity-insert.ss
View file @
494cb5e3
...
...
@@ -34,11 +34,11 @@
(
insert-entity-wholesale
db
table
entity-type
uid
1
0
ktvlist
)
uid
))
(
define
sema
(
make-semaphore
1
))
(
define
entity-
sema
(
make-semaphore
1
))
;; all the parameters - for syncing purposes
(
define
(
insert-entity-wholesale
db
table
entity-type
unique-id
dirty
version
ktvlist
)
(
semaphore-wait
sema
)
(
semaphore-wait
entity-
sema
)
(
db-exec
db
"begin transaction"
)
(
let
((
id
(
db-insert
db
(
string-append
...
...
@@ -57,6 +57,6 @@
ktvlist
)
(
db-exec
db
"end transaction"
)
(
semaphore-post
sema
)
(
semaphore-post
entity-
sema
)
id
))
eavdb/entity-update.ss
View file @
494cb5e3
...
...
@@ -68,6 +68,8 @@
;; update an entity, via a (possibly partial) list of key/value pairs
;; if dirty is not true, this is coming from a sync
(
define
(
update-entity-values
db
table
entity-id
ktvlist
dirty
)
(
semaphore-wait
entity-sema
)
(
db-exec
db
"begin transaction"
)
(
let*
((
entity-type
(
get-entity-type
db
table
entity-id
)))
(
cond
((
null?
entity-type
)
(
msg
"entity"
entity-id
"not found!"
)
'
())
...
...
@@ -83,7 +85,9 @@
(
if
dirty
(
update-value
db
table
entity-id
ktv
)
(
update-value-from-sync
db
table
entity-id
ktv
)))
ktvlist
)))))
ktvlist
))))
(
db-exec
db
"end transaction"
)
(
semaphore-post
entity-sema
))
;; update or create an entire entity if it doesn't exist
;; will return the new entity id if it's created
...
...
web/server.scm
View file @
494cb5e3
...
...
@@ -49,25 +49,37 @@
;(msg (csv db "sync" "individual"))
(
define
sema
(
make-semaphore
1
))
(
define
(
syncro
fn
)
(
fn
))
; (msg "s-start")
; (if (semaphore-try-wait? sema)
; (let ((r (fn)))
; (msg "s-end")
; (semaphore-post sema)
; r)
; (begin
; (msg "couldn't get lock")
; (pluto-response (scheme->txt '("fail"))))))
(
define
registered-requests
(
list
(
register
(
req
'ping
'
())
(
lambda
(
req
)
(
pluto-response
(
scheme->txt
'
(
"hello"
)))))
(
register
(
req
'upload
'
())
(
lambda
(
req
)
(
match
(
bindings-assq
#
"binary"
(
request-bindings/raw
req
))
((
struct
binding:file
(
id
filename
headers
content
))
(
with-output-to-file
(
string-append
"files/"
(
bytes->string/utf-8
filename
))
#
:exists
'replace
(
lambda
()
(
write-bytes
content
)))))
(
pluto-response
(
scheme->txt
'
(
"ok"
)))))
(
syncro
(
lambda
()
(
msg
"upload"
)
(
match
(
bindings-assq
#
"binary"
(
request-bindings/raw
req
))
((
struct
binding:file
(
id
filename
headers
content
))
(
with-output-to-file
(
string-append
"files/"
(
bytes->string/utf-8
filename
))
#
:exists
'replace
(
lambda
()
(
write-bytes
content
)))))
(
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
...
...
@@ -85,55 +97,70 @@
(
register
(
req
'sync
'
(
table
entity-type
unique-id
dirty
version
))
(
lambda
(
req
table
entity-type
unique-id
dirty
version
.
data
)
(
pluto-response
(
scheme->txt
(
check-for-sync
db
table
entity-type
unique-id
(
string->number
dirty
)
(
string->number
version
)
data
)))))
(
syncro
(
lambda
()
(
msg
"sync"
)
(
pluto-response
(
scheme->txt
(
check-for-sync
db
table
entity-type
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
)
(
pluto-response
(
scheme->txt
(
entity-versions
db
table
)))))
(
syncro
(
lambda
()
(
msg
"entity-versions"
)
(
pluto-response
(
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
)
(
pluto-response
(
scheme->txt
(
send-entity
db
table
unique-id
)))))
(
syncro
(
lambda
()
(
msg
"entity"
)
(
pluto-response
(
scheme->txt
(
send-entity
db
table
unique-id
)))))))
(
register
(
req
'entity-types
'
(
table
))
(
lambda
(
req
table
)
(
pluto-response
(
scheme->txt
(
get-all-entity-types
db
table
)))))
(
syncro
(
lambda
()
(
msg
"entity-types"
)
(
pluto-response
(
scheme->txt
(
get-all-entity-types
db
table
)))))))
(
register
(
req
'entity-csv
'
(
table
type
))
(
lambda
(
req
table
type
)
(
let
((
r
(
csv
db
table
type
)))
(
msg
"--------------------------------------- csv request for"
type
"["
r
"]"
)
(
pluto-response
r
))))
(
syncro
(
lambda
()
(
msg
"entity-csv"
)
(
let
((
r
(
csv
db
table
type
)))
(
msg
"--------------------------------------- csv request for"
type
"["
r
"]"
)
(
pluto-response
r
))))))
))
(
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
"request incoming:"
name
)
(
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