Commit 494cb5e3 authored by Dave Griffiths's avatar Dave Griffiths

Merge branch 'master' of github.com:nebogeo/symbai

parents f37d1a62 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))
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment