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

sync additions, not tested

parent fcad9380
......@@ -212,6 +212,40 @@
r))
'() 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
(define (spit db table entities)
(foldl
......@@ -317,6 +351,19 @@
'()
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
(define (suck-new db table)
(debug! "Requesting new entities")
......@@ -326,6 +373,9 @@
(string-append url "fn=entity-versions&table=" table)
(lambda (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
((null? new-entity-requests)
(debug! "No new data to download")
......
......@@ -184,7 +184,11 @@
(append
(list (toast "sync-cb"))
(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 '()))
(list
(delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
......@@ -1394,14 +1398,7 @@
(vert
(text-view (make-id "sync-title") "Sync database" 40 fillwrap)
(mtext 'sync-dirty "...")
(horiz
(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)))))
(mtoggle-button-scale 'sync-all (lambda (v) (set-current! 'sync-on v) '()))
(mtitle 'export-data)
(horiz
(mbutton-scale 'sync-download
......
......@@ -153,6 +153,17 @@
(vector-ref i 0))
(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
......
......@@ -41,15 +41,19 @@
entity-id))
(define (update-entity-clean db table unique-id)
;;(msg "cleaning")
;; clean entity table
(db-exec
db (string-append "update " table "_entity set dirty=? where 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)) )
;; 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)
(not (zero?
(select-first
......@@ -80,20 +84,20 @@
;; todo: BROKEN...
;; used for sync-all
(define (dirty-and-all-entities db table)
(let ((de (db-select
db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
(if (null? de)
'()
(map
(lambda (i)
(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 db table (vector-ref i 0))))
(cdr de)))))
;(define (dirty-and-all-entities db table)
; (let ((de (db-select
; db (string-append
; "select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
; (if (null? de)
; '()
; (map
; (lambda (i)
; (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 db table (vector-ref i 0))))
; (cdr de)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
......@@ -61,7 +61,6 @@
(else
(for-each
(lambda (kt)
;;(msg "cleaning" kt)
(clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
(get-attribute-ids/types db table entity-type))))))
......
......@@ -121,3 +121,9 @@
(db-exec db (string-append "update " table "_value_" (ktv-type kt)
" set dirty=0 where entity_id = ? and attribute_id = ?")
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 @@
"place-of-birth"," Place of 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-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"," ",,
"num-people-in-house"," People living in house"," ",,
......
......@@ -154,6 +154,17 @@
(pluto-response
r))))))
(register
(req 'file-list '())
(lambda ()
(syncro
(lambda ()
(msg "file-list")
(pluto-response
(scheme->txt
(dbg (directory-list "./htdocs/files/"))))))))
))
(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