testing tweaks

eavdb/entity-insert.ss

@@ -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

@@ -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

@@ -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

@@ -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