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

android/assets/dbsync.scm

@@ -215,37 +215,45 @@
 ;; redundant second pass to syncronise files - independant of the
 ;; rest of the syncing system
 (define (sync-files server-list)
-  (let ((local-files (dir-list "/sdcard/symbai/files/")))
+  (let ((local-list (dir-list "/sdcard/symbai/files/")))
     ;; search for all local files in server list
-    (append
-     (foldl
-      (lambda (file r)
-        ;; send files not present
-        (if (find file server-list)
-            r (cons
-               (http-upload
-                (string-append "upload-" file)
-                "http://192.168.2.1:8889/symbai?fn=upload"
-                (string-append "/sdcard/symbai/files/" file)) r)))
-      local-list)
-     ;; search for all server files in local list
-     (foldl
-      (lambda (file r)
-        ;; request files not present
-        (if (find file local-list)
-            r (cons
-               (http-download
-                (string-append "download-" file)
-                (string-append "http://192.168.2.1:8889/files/" file)
-                (string-append "/sdcard/symbai/files/" file)) r)))
-      server-list))))
+    (dbg (crop
+          (append
+      (foldl
+       (lambda (file r)
+         ;; send files not present
+         (if (or
+              (eqv? (string-ref file 0) #\.)
+              (in-list? file server-list))
+             r (cons
+                (http-upload
+                 (string-append "upload-" file)
+                 "http://192.168.2.1:8889/symbai?fn=upload"
+                 (string-append "/sdcard/symbai/files/" file)) r)))
+       '()
+       local-list)
+      ;; search for all server files in local list
+      (foldl
+       (lambda (file r)
+         ;; request files not present
+         (if (in-list? file local-list)
+             r (cons
+                (http-download
+                 (string-append "download-" file)
+                 (string-append "http://192.168.2.1:8889/files/" file)
+                 (string-append "/sdcard/symbai/files/" file)) r)))
+       '()
+       server-list))
+     ;; restrict the number of uploads each time round
+     2))))
 
 (define (start-sync-files)
-  (http-request
-   (string-append "file-list")
-   (string-append url "fn=file-list")
-   (lambda (file-list)
-     (sync-files file-list))))
+  (list
+   (http-request
+    (string-append "file-list")
+    (string-append url "fn=file-list")
+    (lambda (file-list)
+      (dbg (sync-files file-list))))))
 
 ;; spit all dirty entities to server
 (define (spit db table entities)
@@ -353,13 +361,14 @@
    version-data))
 
 (define (mark-unlisted-entities-dirty! db table version-data)
+  (msg "mark-unlisted...")
   ;; load all local entities
   (let ((ids (all-unique-ids db table))
         (server-ids (map car version-data)))
     ;; look for each one in data
     (for-each
      (lambda (id)
-       (when ((not (find id server-ids)))
+       (when (not (in-list? id server-ids))
              (msg "can't find " id " in server data, marking dirty")
              ;; mark those not present as dirty for next spit cycle
              (update-entity-dirtify db table id)))

android/assets/lib.scm

@@ -60,6 +60,18 @@
       (else (_ (cdr in) (cons (cons (car in) (car out)) (cdr out)) (- c 1)))))
   (reverse (map reverse (_ l '(()) n))))
 
+(define (crop l n)
+  (cond
+   ((null? l) '())
+   ((zero? n) '())
+   (else (cons (car l) (crop (cdr l) (- n 1))))))
+
+(define (in-list? n l)
+  (cond
+    ((null? l) #f)
+    ((equal? n (car l)) #t)
+    (else (in-list? n (cdr l)))))
+
 (define (find n l)
   (cond
     ((null? l) #f)

eavdb/entity-get.ss

@@ -71,10 +71,9 @@
      (cond
       ((null? vd) r)
       ;; only return if dirty
-      ((zero? (cadr vd))
+      ((not (zero? (cadr vd)))
        (cons
-        (list (ktv-key kt) (ktv-type kt) (list-ref vd 0))
-        r))
+        (list (ktv-key kt) (ktv-type kt) (list-ref vd 0)) r))
       (else r)))
    db table entity-id))
 

eavdb/entity-insert.ss

@@ -28,12 +28,23 @@
 (define (insert-entity db table entity-type user ktvlist)
   (insert-entity-wholesale db table entity-type (get-unique user) 1 0 ktvlist))
 
+;; insert an entire entity
+(define (insert-entity-with-id db table id entity-type user ktvlist)
+  (insert-entity-wholesale-with-id db table id entity-type (get-unique user) 1 0 ktvlist))
+
 ;; insert an entire entity
 (define (insert-entity/get-unique db table entity-type user ktvlist)
   (let ((uid (get-unique user)))
     (insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
     uid))
 
+;; used for the app preferences
+(define (insert-entity-if-not-exists db table entity-type user entity-id ktvlist)
+  (let ((found (get-entity-type db table entity-id)))
+    (if (null? found)
+        (insert-entity-with-id db table entity-id entity-type user ktvlist)
+        #f)))
+
 (define entity-sema (make-semaphore 1))
 
 ;; all the parameters - for syncing purposes
@@ -60,3 +71,27 @@
     (semaphore-post entity-sema)
 
     id))
+
+(define (insert-entity-wholesale-with-id db table id entity-type unique-id dirty version ktvlist)
+  (semaphore-wait entity-sema)
+  (db-exec db "begin transaction")
+  (let ((id (db-insert
+             db (string-append
+                 "insert into " table "_entity values (?, ?, ?, ?, ?)")
+             id entity-type unique-id dirty version)))
+
+    ;; create the attributes if they are new, and validate them if they exist
+    (for-each
+     (lambda (ktv)
+       (find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv)))
+     ktvlist)
+    ;; add all the keys
+    (for-each
+     (lambda (ktv)
+       (insert-value db table id ktv dirty))
+     ktvlist)
+
+    (db-exec db "end transaction")
+    (semaphore-post entity-sema)
+
+    id))

eavdb/entity-sync.ss

@@ -77,7 +77,6 @@
            (list
             ;; build according to url ([table] entity-type unique-id dirty version)
             (cdr (vector->list i))
-            ;; data entries (todo - only dirty values!)
             (get-entity-plain-for-sync db table (vector-ref i 0))))
          (cdr de)))))
 

eavdb/entity-update.ss

@@ -111,13 +111,6 @@
       (update-entity db table entity-id ktvlist)
       #f))))
 
-(define (insert-entity-if-not-exists db table entity-type user entity-id ktvlist)
-  (let ((found (get-entity-type db table entity-id)))
-    (if (null? found)
-        (insert-entity db table entity-type user ktvlist)
-        #f)))
-
-
 (define (entity-update-test db table)
 
   (define e (insert-entity db table "thing" "me" (list (ktv "param1" "varchar" "bob")