Commit 0dae8d5a authored by Dave Griffiths's avatar Dave Griffiths
Browse files

started file syncing

parent da350072
...@@ -157,7 +157,7 @@ ...@@ -157,7 +157,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing code ;; syncing code
(define url "http://192.168.2.1:8888/symbai?") (define url "http://192.168.2.1:8889/symbai?")
(define (build-url-from-ktv ktv) (define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv))) (string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
...@@ -179,6 +179,19 @@ ...@@ -179,6 +179,19 @@
"&version=" (number->string (list-ref (car e) 3)) "&version=" (number->string (list-ref (car e) 3))
(build-url-from-ktvlist (cadr e)))) (build-url-from-ktvlist (cadr e))))
;; todo fix all hardcoded paths here
(define (send-files ktvlist)
(foldl
(lambda (ktv r)
(if (equal? (ktv-type ktv) "file")
(cons (http-upload
(string-append "upload-" (ktv-value ktv))
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))
r)
r))
'() ktvlist))
;; spit all dirty entities to server ;; spit all dirty entities to server
(define (spit db table entities) (define (spit db table entities)
(foldl (foldl
...@@ -193,13 +206,17 @@ ...@@ -193,13 +206,17 @@
(cond (cond
((or (equal? (car v) "inserted") (equal? (car v) "match")) ((or (equal? (car v) "inserted") (equal? (car v) "match"))
(update-entity-clean db table (cadr v)) (update-entity-clean db table (cadr v))
(debug! (string-append "Uploaded " (car (car e))))) (append
(send-files e)
(debug! (string-append "Uploaded " (car (car e))))))
((equal? (car v) "no change") ((equal? (car v) "no change")
(debug! (string-append "No change for " (car (car e))))) (debug! (string-append "No change for " (car (car e)))))
((equal? (car v) "updated") ((equal? (car v) "updated")
;; send new files hereish ;; send new files hereish
(update-entity-clean db table (cadr v)) (update-entity-clean db table (cadr v))
(debug! (string-append "Updated changed " (car (car e))))) (append
(send-files e)
(debug! (string-append "Updated changed " (car (car e)))))
(else (else
(debug! (string-append (debug! (string-append
"Problem uploading " "Problem uploading "
...@@ -210,6 +227,19 @@ ...@@ -210,6 +227,19 @@
'() '()
entities)) entities))
;; todo fix all hardcoded paths here
(define (request-files ktvlist)
(foldl
(lambda (ktv r)
(if (equal? (ktv-type ktv) "file")
(cons (http-download
(string-append "download-" (ktv-value ktv))
(string-append "http://192.168.2.1:8889/files/" (ktv-value ktv))
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))
r)
r))
'() ktvlist))
(define (suck-entity-from-server db table unique-id exists) (define (suck-entity-from-server db table unique-id exists)
;; ask for the current version ;; ask for the current version
(http-request (http-request
...@@ -219,7 +249,6 @@ ...@@ -219,7 +249,6 @@
;; check "sync-insert" in sync.ss raspberry pi-side for the contents of 'entity' ;; check "sync-insert" in sync.ss raspberry pi-side for the contents of 'entity'
(let ((entity (list-ref data 0)) (let ((entity (list-ref data 0))
(ktvlist (list-ref data 1))) (ktvlist (list-ref data 1)))
;; request updated files hereish
(if (not exists) (if (not exists)
(insert-entity-wholesale (insert-entity-wholesale
db table db table
...@@ -233,6 +262,7 @@ ...@@ -233,6 +262,7 @@
(list-ref entity 2) ktvlist)) (list-ref entity 2) ktvlist))
(debug! (string-append (if exists "Got new: " "Updated: ") (ktv-get ktvlist "name"))) (debug! (string-append (if exists "Got new: " "Updated: ") (ktv-get ktvlist "name")))
(list (list
(request-files ktvlist)
(update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty))))))) (update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty)))))))
;; repeatedly read version and request updates ;; repeatedly read version and request updates
......
...@@ -473,6 +473,7 @@ ...@@ -473,6 +473,7 @@
(define (network-connect name ssid fn) (list "network-connect" 0 "network-connect" name fn ssid)) (define (network-connect name ssid fn) (list "network-connect" 0 "network-connect" name fn ssid))
(define (http-request name url fn) (list "http-request" 0 "http-request" name fn url)) (define (http-request name url fn) (list "http-request" 0 "http-request" name fn url))
(define (http-download name url filename) (list "http-download" 0 "http-download" name filename url)) (define (http-download name url filename) (list "http-download" 0 "http-download" name filename url))
(define (http-upload name url filename) (list "http-upload" 0 "http-upload" name filename url))
(define (send-mail to subject body attachments) (list "send-mail" 0 "send-mail" to subject body attachments)) (define (send-mail to subject body attachments) (list "send-mail" 0 "send-mail" to subject body attachments))
(define (take-photo filename code) (list "take-photo" 0 "take-photo" filename code)) (define (take-photo filename code) (list "take-photo" 0 "take-photo" filename code))
(define (walk-draggable name id fn) (list "walk-draggable" 0 "walk-draggable" name fn id)) (define (walk-draggable name id fn) (list "walk-draggable" 0 "walk-draggable" name fn id))
......
...@@ -590,6 +590,21 @@ ...@@ -590,6 +590,21 @@
(mbutton-scale 'sync (lambda () (list)))) (mbutton-scale 'sync (lambda () (list))))
(mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list))) (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
(mbutton 'test-upload (lambda ()
(list
(network-connect
"network"
"mongoose-web"
(lambda (state)
(msg state)
(if (equal? state "Connected")
(list
(http-upload
"test-upload"
"http://192.168.2.1:8889/symbai?fn=upload"
"/sdcard/symbai/photo.jpg"))
'()))
))))
(build-list-widget (build-list-widget
db "sync" "village" "village" db "sync" "village" "village"
(list (list
......
...@@ -36,7 +36,8 @@ ...@@ -36,7 +36,8 @@
(db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))")) (db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))"))
(db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer)")) (db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer)"))
(db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer)")) (db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer)"))
(db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer)"))) (db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer)"))
(db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar, dirty integer)")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
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