Commit 7ad1d0ee authored by Dave Griffiths's avatar Dave Griffiths
Browse files

sync tests complete

parent 0bdf3cb9
...@@ -217,30 +217,35 @@ ...@@ -217,30 +217,35 @@
(define (sync-files server-list) (define (sync-files server-list)
(let ((local-list (dir-list "/sdcard/symbai/files/"))) (let ((local-list (dir-list "/sdcard/symbai/files/")))
;; search for all local files in server list ;; search for all local files in server list
(append (dbg (crop
(foldl (append
(lambda (file r) (foldl
;; send files not present (lambda (file r)
(if (in-list? file server-list) ;; send files not present
r (cons (if (or
(http-upload (eqv? (string-ref file 0) #\.)
(string-append "upload-" file) (in-list? file server-list))
"http://192.168.2.1:8889/symbai?fn=upload" r (cons
(string-append "/sdcard/symbai/files/" file)) r))) (http-upload
'() (string-append "upload-" file)
local-list) "http://192.168.2.1:8889/symbai?fn=upload"
;; search for all server files in local list (string-append "/sdcard/symbai/files/" file)) r)))
(foldl '()
(lambda (file r) local-list)
;; request files not present ;; search for all server files in local list
(if (in-list? file local-list) (foldl
r (cons (lambda (file r)
(http-download ;; request files not present
(string-append "download-" file) (if (in-list? file local-list)
(string-append "http://192.168.2.1:8889/files/" file) r (cons
(string-append "/sdcard/symbai/files/" file)) r))) (http-download
'() (string-append "download-" file)
server-list)))) (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) (define (start-sync-files)
(list (list
...@@ -248,7 +253,7 @@ ...@@ -248,7 +253,7 @@
(string-append "file-list") (string-append "file-list")
(string-append url "fn=file-list") (string-append url "fn=file-list")
(lambda (file-list) (lambda (file-list)
(sync-files file-list))))) (dbg (sync-files file-list))))))
;; spit all dirty entities to server ;; spit all dirty entities to server
(define (spit db table entities) (define (spit db table entities)
......
...@@ -60,6 +60,12 @@ ...@@ -60,6 +60,12 @@
(else (_ (cdr in) (cons (cons (car in) (car out)) (cdr out)) (- c 1))))) (else (_ (cdr in) (cons (cons (car in) (car out)) (cdr out)) (- c 1)))))
(reverse (map reverse (_ l '(()) n)))) (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) (define (in-list? n l)
(cond (cond
((null? l) #f) ((null? l) #f)
......
...@@ -28,12 +28,23 @@ ...@@ -28,12 +28,23 @@
(define (insert-entity db table entity-type user ktvlist) (define (insert-entity db table entity-type user ktvlist)
(insert-entity-wholesale db table entity-type (get-unique user) 1 0 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 ;; insert an entire entity
(define (insert-entity/get-unique db table entity-type user ktvlist) (define (insert-entity/get-unique db table entity-type user ktvlist)
(let ((uid (get-unique user))) (let ((uid (get-unique user)))
(insert-entity-wholesale db table entity-type uid 1 0 ktvlist) (insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
uid)) 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)) (define entity-sema (make-semaphore 1))
;; all the parameters - for syncing purposes ;; all the parameters - for syncing purposes
...@@ -60,3 +71,27 @@ ...@@ -60,3 +71,27 @@
(semaphore-post entity-sema) (semaphore-post entity-sema)
id)) 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))
...@@ -111,13 +111,6 @@ ...@@ -111,13 +111,6 @@
(update-entity db table entity-id ktvlist) (update-entity db table entity-id ktvlist)
#f)))) #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 (entity-update-test db table)
(define e (insert-entity db table "thing" "me" (list (ktv "param1" "varchar" "bob") (define e (insert-entity db table "thing" "me" (list (ktv "param1" "varchar" "bob")
......
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