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

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

parents f37d1a62 a4d30533
...@@ -34,11 +34,11 @@ ...@@ -34,11 +34,11 @@
(insert-entity-wholesale db table entity-type uid 1 0 ktvlist) (insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
uid)) uid))
(define sema (make-semaphore 1)) (define entity-sema (make-semaphore 1))
;; all the parameters - for syncing purposes ;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist) (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") (db-exec db "begin transaction")
(let ((id (db-insert (let ((id (db-insert
db (string-append db (string-append
...@@ -57,6 +57,6 @@ ...@@ -57,6 +57,6 @@
ktvlist) ktvlist)
(db-exec db "end transaction") (db-exec db "end transaction")
(semaphore-post sema) (semaphore-post entity-sema)
id)) id))
...@@ -68,6 +68,8 @@ ...@@ -68,6 +68,8 @@
;; update an entity, via a (possibly partial) list of key/value pairs ;; update an entity, via a (possibly partial) list of key/value pairs
;; if dirty is not true, this is coming from a sync ;; if dirty is not true, this is coming from a sync
(define (update-entity-values db table entity-id ktvlist dirty) (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))) (let* ((entity-type (get-entity-type db table entity-id)))
(cond (cond
((null? entity-type) (msg "entity" entity-id "not found!") '()) ((null? entity-type) (msg "entity" entity-id "not found!") '())
...@@ -83,7 +85,9 @@ ...@@ -83,7 +85,9 @@
(if dirty (if dirty
(update-value db table entity-id ktv) (update-value db table entity-id ktv)
(update-value-from-sync 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 ;; update or create an entire entity if it doesn't exist
;; will return the new entity id if it's created ;; will return the new entity id if it's created
......
...@@ -49,25 +49,37 @@ ...@@ -49,25 +49,37 @@
;(msg (csv db "sync" "individual")) ;(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 (define registered-requests
(list (list
(register
(req 'ping '())
(lambda (req)
(pluto-response (scheme->txt '("hello")))))
(register (register
(req 'upload '()) (req 'upload '())
(lambda (req) (lambda (req)
(match (bindings-assq #"binary" (request-bindings/raw req)) (syncro
((struct binding:file (id filename headers content)) (lambda ()
(with-output-to-file (msg "upload")
(string-append "files/" (bytes->string/utf-8 filename)) #:exists 'replace (match (bindings-assq #"binary" (request-bindings/raw req))
(lambda () ((struct binding:file (id filename headers content))
(write-bytes content))))) (with-output-to-file
(pluto-response (scheme->txt '("ok"))))) (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 ;; 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 @@ ...@@ -85,55 +97,70 @@
(register (register
(req 'sync '(table entity-type unique-id dirty version)) (req 'sync '(table entity-type unique-id dirty version))
(lambda (req table entity-type unique-id dirty version . data) (lambda (req table entity-type unique-id dirty version . data)
(pluto-response (syncro
(scheme->txt (lambda ()
(check-for-sync (msg "sync")
db (pluto-response
table (scheme->txt
entity-type (check-for-sync
unique-id db
(string->number dirty) table
(string->number version) data))))) entity-type
unique-id
(string->number dirty)
(string->number version) data)))))))
;; returns a table of all entities and their corresponding versions ;; returns a table of all entities and their corresponding versions
(register (register
(req 'entity-versions '(table)) (req 'entity-versions '(table))
(lambda (req table) (lambda (req table)
(pluto-response (syncro
(scheme->txt (lambda ()
(entity-versions db table))))) (msg "entity-versions")
(pluto-response
(scheme->txt
(entity-versions db table)))))))
;; returns the entity - the android requests these based on the version numbers ;; returns the entity - the android requests these based on the version numbers
;; (request all ones that are newer than it's stored version) ;; (request all ones that are newer than it's stored version)
(register (register
(req 'entity '(table unique-id)) (req 'entity '(table unique-id))
(lambda (req table unique-id) (lambda (req table unique-id)
(pluto-response (syncro
(scheme->txt (lambda ()
(send-entity db table unique-id))))) (msg "entity")
(pluto-response
(scheme->txt
(send-entity db table unique-id)))))))
(register (register
(req 'entity-types '(table)) (req 'entity-types '(table))
(lambda (req table) (lambda (req table)
(pluto-response (syncro
(scheme->txt (lambda ()
(get-all-entity-types db table))))) (msg "entity-types")
(pluto-response
(scheme->txt
(get-all-entity-types db table)))))))
(register (register
(req 'entity-csv '(table type)) (req 'entity-csv '(table type))
(lambda (req table type) (lambda (req table type)
(let ((r (csv db table type))) (syncro
(msg "--------------------------------------- csv request for" type "[" r "]") (lambda ()
(pluto-response (msg "entity-csv")
r)))) (let ((r (csv db table type)))
(msg "--------------------------------------- csv request for" type "[" r "]")
(pluto-response
r))))))
)) ))
(define (start request) (define (start request)
(let ((values (url-query (request-uri request)))) (let ((values (url-query (request-uri request))))
(msg values)
(if (not (null? values)) ; do we have some parameters? (if (not (null? values)) ; do we have some parameters?
(let ((name (assq 'fn values))) (let ((name (assq 'fn values)))
(msg "request incoming:" name)
(if name ; is this a well formed request? (if name ; is this a well formed request?
(request-dispatch (request-dispatch
registered-requests 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