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
a4d30533
Commit
a4d30533
authored
May 02, 2014
by
dave griffiths
Browse files
testing tweaks
parent
d233c023
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
71 additions
and
40 deletions
+71
-40
eavdb/entity-insert.ss
eavdb/entity-insert.ss
+3
-3
eavdb/entity-sync.ss
eavdb/entity-sync.ss
+1
-1
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 @
a4d30533
...
...
@@ -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-sync.ss
View file @
a4d30533
...
...
@@ -70,7 +70,7 @@
;; build according to url ([table] entity-type unique-id dirty version)
(
cdr
(
vector->list
i
))
;; data entries (todo - only dirty values!)
(
dbg
(
get-entity-plain-for-sync
db
table
(
vector-ref
i
0
))))
)
(
get-entity-plain-for-sync
db
table
(
vector-ref
i
0
))))
(
cdr
de
)))))
;; todo: BROKEN...
...
...
eavdb/entity-update.ss
View file @
a4d30533
...
...
@@ -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 @
a4d30533
...
...
@@ -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