Commit 5fb8662b authored by dave griffiths's avatar dave griffiths

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

parents 82c71b57 7ad1d0ee
......@@ -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)))
......
......@@ -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)
......
......@@ -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))
......
......@@ -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))
......@@ -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)))))
......
......@@ -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")
......
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