Commit 2c7e9d8d authored by Dave Griffiths's avatar Dave Griffiths
Browse files

syncing updates

parent 789b4b23
......@@ -42,7 +42,7 @@
(define ktv-type cadr)
(define ktv-value caddr)
;; stringify based on type
;; stringify based on type (for sql)
(define (stringify-value ktv)
(cond
((null? (ktv-value ktv)) "NULL")
......@@ -52,6 +52,17 @@
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;; stringify based on type (for url)
(define (stringify-value-url ktv)
(cond
((null? (ktv-value ktv)) "NULL")
((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
(else
(if (not (string? (ktv-value ktv)))
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;; helper to return first instance from a select
(define (select-first db str)
(let ((s (db-select db str)))
......@@ -108,13 +119,18 @@
;; insert an entire entity
(define (insert-entity db table entity-type user ktvlist)
(insert-entity-with-unique db table entity-type (get-unique user) ktvlist))
(insert-entity-with-wholesale db table entity-type (get-unique user) "1" "0" ktvlist))
(define (insert-entity-with-unique db table entity-type unique-id ktvlist)
;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(msg table entity-type ktvlist)
(let ((id (db-insert
db (string-append
"insert into " table "_entity values (null, '" (sqls entity-type) "', '" unique-id "', 1, 0)"))))
"insert into " table "_entity values (null, '"
(sqls entity-type) "', '"
unique-id "', "
dirty ", "
version ")"))))
;; create the attributes if they are new, and validate them if they exist
(for-each
(lambda (ktv)
......@@ -155,11 +171,11 @@
"version='" (number->string version) "'"
" where entity_id = " (number->string entity-id) ";")))
(define (update-entity-clean db table entity-id)
(define (update-entity-clean db table unique-id)
(db-exec
db (string-append "update " table "_entity "
"set dirty='0' "
" where entity_id = " (number->string entity-id) ";")))
" where unique_id = '" unique-id "';")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
......@@ -191,6 +207,18 @@
" and attribute_id = '" (sqls (ktv-key kt)) "'")))
;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(map
(lambda (kt)
(list (ktv-key kt) (ktv-type kt) (get-value db table entity-id kt)))
(get-attribute-ids/types db table entity-type))))))
;; get an entire entity, as a list of key/value pairs (includes entity id)
(define (get-entity db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
......@@ -329,3 +357,16 @@
(get-entity db table (string->number (vector-ref i 0)))))
(cdr (db-select
db (string-append "select * from " table "_entity where dirty=1;")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doing things with unique ids
(define (entity-id-from-unique db table unique-id)
(select-first
db (string-append "select entity_id from " table "_entity where unique_id = "
unique-id)))
(define (entity-version-from-unique db table unique-id)
(select-first
db (string-append "select version from " table "_entity where unique_id = "
unique-id)))
......@@ -32,6 +32,7 @@
(display (db-status db))(newline)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
......@@ -60,6 +61,106 @@
(define (get-current key)
(store-get store key))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing code
(define url "http://192.168.2.1:8888/mongoose?")
(define (dirty-entities db table)
(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 (string->number (vector-ref i 0)))))
(cdr (db-select
db (string-append "select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;")))))
(define (get-entity-id db table unique-id)
(select-first db (string-append "select entity_id from " table "_entity where unique_id = '" unique-id "';")))
(define (get-entity-version db table unique-id)
(select-first db (string-append "select version from " table "_entity where unique_id = '" unique-id "';")))
(define (entity-exists? db table unique-id)
(not (null? (select-first db (string-append "select * from " table "_entity where unique_id = '" unique-id "';")))))
(define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
(define (build-url-from-ktvlist ktvlist)
(foldl
(lambda (ktv r)
(string-append r (build-url-from-ktv ktv)))
"" ktvlist))
(define (build-url-from-entity table e)
(string-append
url
"fn=sync"
"&table=" table
"&entity-type=" (list-ref (car e) 0)
"&unique-id=" (list-ref (car e) 1)
"&dirty=" (list-ref (car e) 2)
"&version=" (list-ref (car e) 3)
(build-url-from-ktvlist (cadr e))))
;; spit all dirty entities to server
(define (spit-dirty db table)
(map
(lambda (e)
(http-request
(string-append "req-" (list-ref (car e) 1))
(build-url-from-entity table e)
(lambda (v)
(display v)(newline)
(if (equal? (car v) "inserted")
(update-entity-clean db table (cadr v))
(display "somefink went wrong")(newline)))))
(dirty-entities db table)))
;; repeatedly read version and request updates
(define (get-new-entities db table)
(list
(http-request
"new-entities-req"
(dbg (string-append url "fn=entity-versions&table=" table))
(lambda (data)
(msg data)
(for-each
(lambda (i)
(let ((unique-id (car i))
(version (cadr i))
(exists (entity-exists? db table unique-id))
(old (> version (get-entity-version db table unique-id))))
;; if we don't have this entity or the version on the server is newer
(when (or (not exists) old)
(msg "sending for new version")
;; ask for the current version
(http-request
(string-append unique-id "-update-new")
(string-append url "fn=entity&table=" table "&unique-id=" unique-id)
(lambda (data)
(msg data)
;; check "sync-insert" in sync.ss raspberry pi-side for the contents of 'entity'
(let ((entity (list-ref data 1))
(ktvlist (list-ref data 2)))
(if (not exists)
(insert-entity-wholesale
db table
(list-ref entity 0) ;; entity-type
(list-ref entity 1) ;; unique-id
"0"
(list-ref entity 2) ;; version
ktvlist)
(update-to-version
db table (get-entity-id db table unique-id)
(list-ref entity 4) ktvlist))))))))
data)))))
;;(display (get-new-entities db "local"))(newline)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (mbutton id title fn)
......@@ -573,12 +674,12 @@
(msg state)
(list
(update-widget 'text-view (get-id "sync-connect") 'text state)))))))
(mbutton "sync-sync" "Sync"
(mbutton "sync-sync" "Push"
(lambda ()
(list
(http-request "myreq" "http://192.168.2.1:8888/mongoose?function_name=ping"
(lambda (v)
(msg "got" v)))))))
(spit-dirty db "sync")))
(mbutton "sync-pull" "Pull"
(lambda ()
(dbg (get-new-entities db "sync")))))
(text-view (make-id "sync-console") "..." 15 (layout 300 'wrap-content 1 'left))
(mbutton "main-send" "Done" (lambda () (list (finish-activity 2)))))
......
......@@ -47,7 +47,7 @@
(define ktv-type cadr)
(define ktv-value caddr)
;; stringify based on type
;; stringify based on type (for sql)
(define (stringify-value ktv)
(cond
((null? (ktv-value ktv)) "NULL")
......@@ -57,6 +57,16 @@
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;; stringify based on type (for url)
(define (stringify-value-url ktv)
(cond
((null? (ktv-value ktv)) "NULL")
((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
(else
(if (not (string? (ktv-value ktv)))
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;; helper to return first instance from a select
(define (select-first db str)
(let ((s (db-select db str)))
......@@ -113,13 +123,18 @@
;; insert an entire entity
(define (insert-entity db table entity-type user ktvlist)
(insert-entity-with-unique db table entity-type (get-unique user) ktvlist))
(insert-entity-with-wholesale db table entity-type (get-unique user) "1" "0" ktvlist))
(define (insert-entity-with-unique db table entity-type unique-id ktvlist)
;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(msg table entity-type ktvlist)
(let ((id (db-insert
db (string-append
"insert into " table "_entity values (null, '" (sqls entity-type) "', '" unique-id "', 1, 0)"))))
"insert into " table "_entity values (null, '"
(sqls entity-type) "', '"
unique-id "', "
dirty ", "
version ")"))))
;; create the attributes if they are new, and validate them if they exist
(for-each
(lambda (ktv)
......@@ -160,11 +175,11 @@
" where entity_id = " (number->string entity-id) ";")))
(define (update-entity-clean db table entity-id)
(define (update-entity-clean db table unique-id)
(db-exec
db (string-append "update " table "_entity "
"set dirty='0' "
" where entity_id = " (number->string entity-id) ";")))
" where unique_id = '" unique-id "';")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
......@@ -196,6 +211,17 @@
" and attribute_id = '" (sqls (ktv-key kt)) "'")))
;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(map
(lambda (kt)
(list (ktv-key kt) (ktv-type kt) (get-value db table entity-id kt)))
(get-attribute-ids/types db table entity-type))))))
;; get an entire entity, as a list of key/value pairs (includes entity id)
(define (get-entity db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
......@@ -334,3 +360,16 @@
(get-entity db table (string->number (vector-ref i 0)))))
(cdr (db-select
db (string-append "select * from " table "_entity where dirty=1;")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doing things with unique ids
(define (entity-id-from-unique db table unique-id)
(select-first
db (string-append "select entity_id from " table "_entity where unique_id = "
unique-id)))
(define (entity-version-from-unique db table unique-id)
(select-first
db (string-append "select version from " table "_entity where unique_id = "
unique-id)))
......@@ -33,21 +33,6 @@
(setup db "stream")
db))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doing things with unique ids
(define (entity-id-from-unique db table unique-id)
(select-first
db (string-append "select entity_id from " table "_entity where unique_id = "
unique-id)))
(define (entity-version-from-unique db table unique-id)
(select-first
db (string-append "select version from " table "_entity where unique_id = "
unique-id)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (request-args->ktvlist data)
(map
(lambda (i)
......@@ -65,7 +50,7 @@
(define (sync-insert db table entity-type unique-id dirty version data)
(let ((ktvlist (dbg (request-args->ktvlist data))))
(insert-entity-with-unique db table entity-type unique-id ktvlist)
(insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(list "inserted" unique-id)))
(define (send-version db table entity-type unique-id current-version)
......@@ -113,6 +98,14 @@
(cdr (db-select
db (string-append "select unique_id, version from " table "_entity;")))))
(define (send-entity db table unique-id)
(let ((entity-id (entity-id-from-unique db table unique-id)))
(list
(select-first
db (string-append "select entity_type, unique_id, version from "
table "_entities where entity_id = " entity-id))
(get-entity-plain db table entity-id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(define db (open-db "test.db"))
......
......@@ -66,7 +66,17 @@
(lambda (table)
(pluto-response
(scheme->txt
(entity-versions db table)))))))
(entity-versions db table)))))
(register
(req 'entity '(table unique-id))
(lambda (table unique-id)
(pluto-response
(scheme->txt
(send-entity db table unique-id)))))
))
(define (start request)
(let ((values (url-query (request-uri 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