Commit 8dd940f8 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

sync additions, not tested

parent fcad9380
...@@ -212,6 +212,40 @@ ...@@ -212,6 +212,40 @@
r)) r))
'() ktvlist)) '() ktvlist))
;; 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/")))
;; 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))))
(define (start-sync-files)
(http-request
(string-append "file-list")
(string-append "http://192.168.2.1:8889/")
;; spit all dirty entities to server ;; spit all dirty entities to server
(define (spit db table entities) (define (spit db table entities)
(foldl (foldl
...@@ -317,6 +351,19 @@ ...@@ -317,6 +351,19 @@
'() '()
version-data)) version-data))
(define (mark-unlisted-entities-dirty! db table version-data)
;; 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)))
(msg "can't find " id " in server data, marking dirty")
;; mark those not present as dirty for next spit cycle
(update-entity-dirty db table id)))
ids)))
;; repeatedly read version and request updates ;; repeatedly read version and request updates
(define (suck-new db table) (define (suck-new db table)
(debug! "Requesting new entities") (debug! "Requesting new entities")
...@@ -326,6 +373,9 @@ ...@@ -326,6 +373,9 @@
(string-append url "fn=entity-versions&table=" table) (string-append url "fn=entity-versions&table=" table)
(lambda (data) (lambda (data)
(let ((new-entity-requests (build-entity-requests db table data))) (let ((new-entity-requests (build-entity-requests db table data)))
(alog "suck-new: marking dirty")
(mark-unlisted-entities-dirty! db table data)
(alog "suck-new: done marking dirty")
(cond (cond
((null? new-entity-requests) ((null? new-entity-requests)
(debug! "No new data to download") (debug! "No new data to download")
......
...@@ -184,7 +184,11 @@ ...@@ -184,7 +184,11 @@
(append (append
(list (toast "sync-cb")) (list (toast "sync-cb"))
(upload-dirty db) (upload-dirty db)
(if (have-dirty? db "sync") '() (suck-new db "sync")))))) ;; important - don't receive until all are sent...
(if (have-dirty? db "sync") '()
(append
(suck-new db "sync")
(start-sync-files)))))))
(else '())) (else '()))
(list (list
(delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb) (delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
...@@ -1394,14 +1398,7 @@ ...@@ -1394,14 +1398,7 @@
(vert (vert
(text-view (make-id "sync-title") "Sync database" 40 fillwrap) (text-view (make-id "sync-title") "Sync database" 40 fillwrap)
(mtext 'sync-dirty "...") (mtext 'sync-dirty "...")
(horiz (mtoggle-button-scale 'sync-all (lambda (v) (set-current! 'sync-on v) '()))
(mtoggle-button-scale 'sync-all (lambda (v) (set-current! 'sync-on v) '()))
(mbutton-scale 'sync-syncall
(lambda ()
(let ((r (append
(spit db "sync" (dirty-and-all-entities db "sync"))
(spit db "stream" (dirty-and-all-entities db "stream")))))
(cons (toast "Uploading data...") r)))))
(mtitle 'export-data) (mtitle 'export-data)
(horiz (horiz
(mbutton-scale 'sync-download (mbutton-scale 'sync-download
......
...@@ -153,6 +153,17 @@ ...@@ -153,6 +153,17 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (cdr s)))))
(define (all-unique-ids db table)
(let ((s (db-select
db (string-append "select e.unique_id from " table "_entity as e "))))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doing things with unique ids ;; doing things with unique ids
......
...@@ -41,15 +41,19 @@ ...@@ -41,15 +41,19 @@
entity-id)) entity-id))
(define (update-entity-clean db table unique-id) (define (update-entity-clean db table unique-id)
;;(msg "cleaning")
;; clean entity table
(db-exec (db-exec
db (string-append "update " table "_entity set dirty=? where unique_id = ?") db (string-append "update " table "_entity set dirty=? where unique_id = ?")
0 unique-id) 0 unique-id)
;; clean value tables for this entity
;;(msg "cleaning values")
(clean-entity-values db table (entity-id-from-unique db table unique-id)) ) (clean-entity-values db table (entity-id-from-unique db table unique-id)) )
;; for when remote entities don't exist for whatever reason
(define (update-entity-dirty db table unique-id)
(db-exec
db (string-append "update " table "_entity set dirty=? where unique_id = ?")
1 unique-id)
;; simpler path than cleaning - should use the same as this???
(dirty-all-values db table (entity-id-from-unique db table unique-id)))
(define (have-dirty? db table) (define (have-dirty? db table)
(not (zero? (not (zero?
(select-first (select-first
...@@ -80,20 +84,20 @@ ...@@ -80,20 +84,20 @@
;; todo: BROKEN... ;; todo: BROKEN...
;; used for sync-all ;; used for sync-all
(define (dirty-and-all-entities db table) ;(define (dirty-and-all-entities db table)
(let ((de (db-select ; (let ((de (db-select
db (string-append ; db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity")))) ; "select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
(if (null? de) ; (if (null? de)
'() ; '()
(map ; (map
(lambda (i) ; (lambda (i)
(list ; (list
;; build according to url ([table] entity-type unique-id dirty version) ; ;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i)) ; (cdr (vector->list i))
;; data entries (todo - only dirty values!)??????????? ; ;; data entries (todo - only dirty values!)???????????
(get-entity-plain db table (vector-ref i 0)))) ; (get-entity-plain db table (vector-ref i 0))))
(cdr de))))) ; (cdr de)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
...@@ -61,7 +61,6 @@ ...@@ -61,7 +61,6 @@
(else (else
(for-each (for-each
(lambda (kt) (lambda (kt)
;;(msg "cleaning" kt)
(clean-value db table entity-id (list (ktv-key kt) (ktv-type kt)))) (clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
(get-attribute-ids/types db table entity-type)))))) (get-attribute-ids/types db table entity-type))))))
......
...@@ -121,3 +121,9 @@ ...@@ -121,3 +121,9 @@
(db-exec db (string-append "update " table "_value_" (ktv-type kt) (db-exec db (string-append "update " table "_value_" (ktv-type kt)
" set dirty=0 where entity_id = ? and attribute_id = ?") " set dirty=0 where entity_id = ? and attribute_id = ?")
entity-id (ktv-key kt))) entity-id (ktv-key kt)))
;; simpler path than cleaning - should use the same as this???
(define (dirty-all-values db table entity-id)
(db-exec db (string-append "update " table "_value_" (ktv-type kt)
" set dirty=1 where entity_id = ?")
entity-id))
...@@ -157,7 +157,7 @@ ...@@ -157,7 +157,7 @@
"place-of-birth"," Place of birth"," ",, "place-of-birth"," Place of birth"," ",,
"num-residence-changes"," Number of time place of residence changed since birth"," ",, "num-residence-changes"," Number of time place of residence changed since birth"," ",,
"village-visits-month"," Number of times you have visited another village in the last month"," ",, "village-visits-month"," Number of times you have visited another village in the last month"," ",,
"village-visits-year"," Number of times you have visited another village in the last year (i.e. betwen last summer and this summer)"," ",, "village-visits-year"," Number of times you have visited another village in the last year (i.e. between last summer and this summer)"," ",,
"occupation"," Occupation"," ",, "occupation"," Occupation"," ",,
"occupation"," Occupation"," ",, "occupation"," Occupation"," ",,
"num-people-in-house"," People living in house"," ",, "num-people-in-house"," People living in house"," ",,
......
...@@ -154,6 +154,17 @@ ...@@ -154,6 +154,17 @@
(pluto-response (pluto-response
r)))))) r))))))
(register
(req 'file-list '())
(lambda ()
(syncro
(lambda ()
(msg "file-list")
(pluto-response
(scheme->txt
(dbg (directory-list "./htdocs/files/"))))))))
)) ))
(define (start request) (define (start request)
......
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