Commit a032bb6f authored by Dave Griffiths's avatar Dave Griffiths

catchup with mongoose2000 & sync fixes

parent 69338381
......@@ -240,17 +240,29 @@
(build-url-from-ktvlist (cadr e))))
(define (is-image? filename)
(equal? (substring filename 3) "jpg"))
;; todo fix all hardcoded paths here
(define (send-files ktvlist)
(foldl
(lambda (ktv r)
(if (equal? (ktv-type ktv) "file")
(begin
(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))
(if (is-image? (ktv-value ktv))
(append
(list
;; make sure we're not sending mahusiv images to sync
(process-image-in-place
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))
(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)
(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))
......
......@@ -500,7 +500,8 @@
(define (drawlist-line colour width points) (list "line" colour width points))
(define (drawlist-text text x y colour size align) (list "text" text x y colour size align))
(define (toast msg) (list "toast" 0 "toast" msg))
(define (toast msg) (list "toast" 0 "toast" msg 30))
(define (toast-size msg size) (list "toast" 0 "toast" msg size))
(define (play-sound wav) (list "play-sound" 0 "play-sound" wav))
(define (soundfile-start-recording wav) (list "soundfile-start-recording" 0 "soundfile-start-recording" wav))
(define (soundfile-stop-recording) (list "soundfile-stop-recording" 0 "soundfile-stop-recording"))
......
......@@ -896,6 +896,7 @@
"main2"
(build-activity
(mtitle 'title)
(text-view (make-id "version") app-version 10 fillwrap)
(horiz
(medit-text 'user-id "normal"
(lambda (v)
......@@ -953,7 +954,8 @@
(set-current! 'location loc)
(list (toast (string-append
(number->string (car loc)) ", "
(number->string (cadr loc)))))))
(number->string (cadr loc))))))
(* 3 60 1000) 5)
(update-list-widget
db "sync" (list "name") "household" "household" (get-setting-value "current-village"))))))
(alog "end main start") r))
......@@ -1303,9 +1305,10 @@
;; need to reset the individual from the db now (as update reset it)
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
(append
(if (eqv? resultcode -1)
(list (process-image-in-place (string-append "/sdcard/symbai/files/" (get-current 'photo-name "error no photo name!!"))))
'())
;; (if (eqv? resultcode -1)
;; (list (process-image-in-place (string-append "/sdcard/symbai/files/" (get-current 'photo-name "error no photo name!!"))))
;; '())
'()
(list
(mupdate 'image-view 'photo "photo"))))
(else
......
......@@ -18,6 +18,8 @@ package foam.symbai;
import android.app.Activity;
import android.os.Bundle;
import android.content.Context;
import android.view.WindowManager;
import android.view.WindowManager.LayoutParams;
public class SyncActivity extends foam.starwisp.StarwispActivity
{
......@@ -26,5 +28,9 @@ public class SyncActivity extends foam.starwisp.StarwispActivity
{
m_Name = "sync";
super.onCreate(savedInstanceState);
WindowManager.LayoutParams params = getWindow().getAttributes();
params.flags |= LayoutParams.FLAG_KEEP_SCREEN_ON;
getWindow().setAttributes(params);
}
}
......@@ -45,6 +45,8 @@ import android.view.Gravity;
import android.view.KeyEvent;
import android.text.TextWatcher;
import android.text.Editable;
import android.content.pm.PackageInfo;
import android.content.pm.PackageManager.NameNotFoundException;
import org.json.JSONException;
import org.json.JSONObject;
......@@ -122,9 +124,23 @@ public class starwisp extends StarwispActivity
int day = c.get(Calendar.DAY_OF_MONTH);
int month = c.get(Calendar.MONTH)+1;
int year = c.get(Calendar.YEAR);
int timezone_offset_mins = (c.get(Calendar.ZONE_OFFSET) + c.get(Calendar.DST_OFFSET)) / 60000;
String version = "Version not found";
try {
PackageInfo pInfo = getPackageManager().getPackageInfo(getPackageName(), 0);
version = pInfo.versionName;
} catch (NameNotFoundException e) {
Log.e("starwisp", "Error getting version " + e.toString());
}
// pass in a bunch of useful stuff
m_Scheme.eval("(define dirname \"/sdcard/"+dirname+"\")(define date-day "+day+") (define date-month "+month+") (define date-year "+year+")");
m_Scheme.eval("(define dirname \"/sdcard/"+dirname+"\")"+
"(define date-day "+day+")"+
"(define date-month "+month+")"+
"(define date-year "+year+")"+
"(define timezone-offset-mins "+timezone_offset_mins+")"+
"(define app-version "+version+")");
Log.i("starwisp","started, now running starwisp.scm...");
m_Scheme.eval(m_Scheme.readRawTextFile(this, "translations.scm"));
......
......@@ -44,15 +44,28 @@
(define (setup db table)
(msg "db setup")
(db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
(db-exec db (string-append "create index if not exists index_" table "_entity on " table "_entity (unique_id)"))
(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 index if not exists index_" table "_attribute on " table "_attribute (entity_type)"))
(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, version integer)"))
(upgrade-table db (string-append table "_value_varchar"))
(db-exec db (string-append "create index if not exists index_" table "_value_varchar on " table "_value_varchar (entity_id,attribute_id)"))
(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, version integer)"))
(upgrade-table db (string-append table "_value_int"))
(db-exec db (string-append "create index if not exists index_" table "_value_int on " table "_value_int (entity_id,attribute_id)"))
(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, version integer)"))
(upgrade-table db (string-append table "_value_real"))
(db-exec db (string-append "create index if not exists index_" table "_value_real on " table "_value_real (entity_id,attribute_id)"))
(db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
(upgrade-table db (string-append table "_value_file")))
(upgrade-table db (string-append table "_value_file"))
(db-exec db (string-append "create index if not exists index_" table "_value_file on " table "_value_file (entity_id,attribute_id)"))
)
(define (validate db)
......
......@@ -33,56 +33,6 @@
"id "
(get-attribute-ids/types db table entity-type)))
(define (csv-old db table entity-type)
(let ((s (db-select
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type)))
(msg "CSV ------------------------------>" entity-type)
(msg s)
(if (null? s)
;; nothing here, just return titles
(csv-titles db table entity-type)
(foldl
(lambda (res r)
(msg res)
(let ((entity (get-entity-for-csv db table (vector-ref res 0))))
(string-append
r "\n"
(foldl
(lambda (ktv r)
(msg ktv)
(cond
((equal? (ktv-key ktv) "unique_id") r)
((null? (ktv-value ktv))
(msg "value not found in csv for " (ktv-key ktv))
(string-append r ", NULL"))
;; dereferences lists of ids
((and
(> (string-length (ktv-key ktv)) 8)
(equal? (substring (ktv-key ktv) 0 8) "id-list-"))
(let ((ids (string-split (ktv-value ktv) '(#\,))))
(if (null? ids)
(string-append r ", \"\"")
(string-append r ", \"" (get-entity-names db "sync" "\"")))))
;; look for unique ids and dereference them
((and
(> (string-length (ktv-key ktv)) 3)
(equal? (substring (ktv-key ktv) 0 3) "id-")
(not (equal? (ktv-value ktv) "none")))
(msg "looking up name")
(msg ktv)
(let ((name (get-entity-name db "sync" (ktv-value ktv))))
(if (null? name)
"\"nobody\""
(string-append r ", \"" name "\""))))
(else
(string-append r ", \"" (stringify-value-url ktv) "\""))))
(vector-ref res 1) ;; unique_id
entity))))
(csv-titles db table entity-type)
(cdr s)))))
(define (csv db table entity-type)
(let ((s (db-select
db (string-append
......@@ -174,35 +124,3 @@
(ktv-filter r key))
ktv-list
key-list))
;; meant to be general, but made for pup focal reports
;(define (export-csv db table parent-entity entity-types)
; (let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
; (pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
; (csvify
; (cons
; '("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
; (sort
; (foldl
; (lambda (entity-type r)
; (append
; r (map
; (lambda (entity)
; (append
; (list
; (ktv-get entity "time")
; (ktv-get entity "user")
; (ktv-get pack "name")
; (ktv-get focal "name")
; entity-type)
; (deref-entity
; db (ktv-filter-many
; entity (list "user" "unique_id" "parent" "time")))))
; (db-all-with-parent
; db table entity-type
; (ktv-get parent-entity "unique_id")))))
; '()
; entity-types)
; (lambda (a b)
; (string<? (car a) (car b))))))))
......@@ -60,44 +60,50 @@
(else c)))
(string->list var))))
(define (build-query table filter typed)
(string-append
(foldl
(lambda (i r)
(let ((var (mangle (string-append (filter-key i) "_var"))))
;; add a query chunk
(define (build-query-chunk i r table)
(let ((var (mangle (string-append (filter-key i) "_var"))))
;; add a query chunk
(if (equal? (substring (filter-op i) 0 1) "t")
;; time version
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and ( "
var ".value " (substring (filter-op i) 1 (string-length (filter-op i))) " DateTime(?) "
"or " var ".value like 'unknown') ")
;; normal version
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
var ".value " (filter-op i) " ? ")))
var ".value " (filter-op i) " ? "))))
(define (build-query table filter typed)
(string-append
(foldl
(lambda (i r)
(build-query-chunk i r table))
;; boilerplate query start
(string-append
"select e.entity_id from " table "_entity as e "
;; order by name
"join " table "_value_varchar "
"as n on n.entity_id = e.entity_id and n.attribute_id = 'name' "
;; ignore deleted
"join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 ")
;; ignore deleted (if not present - (readding))
"left join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' ")
filter)
(if typed "where e.entity_type = ? order by n.value"
(if (not (equal? typed "*"))
(if (equal? typed "mongoose") ;; not used, obviously - kept so the code matches
"where e.entity_type = ? and (d.value = 0 or d.value is NULL) order by substr(n.value,3)"
"where e.entity_type = ? and (d.value = 0 or d.value is NULL) order by n.value")
"order by n.value")))
(define (build-query-inc-deleted table filter)
(string-append
(foldl
(lambda (i r)
(let ((var (string-append (filter-key i) "_var")))
;; add a query chunk
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
var ".value " (filter-op i) " ? ")))
(build-query-chunk i r table))
;; boilerplate query start
(string-append
"select e.entity_id from " table "_entity as e "
......@@ -115,14 +121,14 @@
filter))
(define (filter-entities db table type filter)
(let ((q (build-query table filter (not (equal? type "*")))))
(let ((q (build-query table filter type)))
(let ((s (apply
db-select
(append
(list db q)
(build-args filter)
(list type)))))
(msg (db-status db))
db-select
(append
(list db q)
(build-args filter)
(if (not (equal? type "*")) (list type) '())))))
;;(msg (db-status db))
(if (null? s)
'()
(map
......@@ -130,15 +136,16 @@
(vector-ref i 0))
(cdr s))))))
(define (filter-entities-inc-deleted db table type filter)
(let ((q (build-query-inc-deleted table filter)))
(let ((s (apply
db-select
(append
(list db q)
(list db (build-query table filter (not (equal? type "*"))))
(build-args filter)
(if (equal? type "*") '() (list type))))))
(msg (db-status db))
;;(msg (db-status db))
(if (null? s)
'()
(map
......
......@@ -46,14 +46,14 @@
(define (fold-entity fn 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
(foldl
(lambda (kt r)
(let ((vd (get-value db table entity-id kt)))
(fn kt vd r)))
'()
(reverse (get-attribute-ids/types db table entity-type)))))))
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(foldl
(lambda (kt r)
(let ((vd (get-value db table entity-id kt)))
(fn kt vd r)))
'()
(reverse (get-attribute-ids/types db table entity-type)))))))
;; get an entire entity, as a list of key/value pairs
......@@ -112,18 +112,16 @@
(define (all-entities db table type)
(msg "all-entities" type)
(let ((s (db-select
db (dbg (string-append "select e.entity_id from " table "_entity as e "
db (string-append "select e.entity_id from " table "_entity as e "
"join " table "_value_varchar "
" as n on n.entity_id = e.entity_id and n.attribute_id = ? "
"left join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = ? "
"where e.entity_type = ? "
"and (d.value='NULL' or d.value is NULL or d.value = 0) "
"order by n.value"))
"order by n.value")
"name" "deleted" type)))
(msg s)
(msg (db-status db))
(if (null? s)
'()
......@@ -136,9 +134,9 @@
(let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e "
"join " table "_value_varchar "
" as n on n.entity_id = e.entity_id and n.attribute_id = ?"
" as n on n.entity_id = e.entity_id and n.attribute_id = ? "
"join " table "_value_varchar "
" as p on p.entity_id = e.entity_id and p.attribute_id = ?"
" as p on p.entity_id = e.entity_id and p.attribute_id = ? "
"left join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = ? "
"where e.entity_type = ? and "
......@@ -178,6 +176,10 @@
db (string-append "select version from " table "_entity where unique_id = ?")
unique-id))
(define (entity-type-from-unique db table unique-id)
(select-first
db (string-append "select entity_type from " table "_entity where unique_id = ?")
unique-id))
(define (get-unique-id db table entity-id)
(select-first
......
......@@ -82,10 +82,18 @@
(cdr de)))))
;; include all the ktvs
;; only certian entities - todo - fix!
(define (dirty-entities-for-review db table)
(let ((de (db-select
db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;"))))
"select e.entity_id, e.entity_type, e.unique_id, e.dirty, e.version from " table "_entity as e "
"left join " table "_value_varchar "
"as p on p.entity_id = e.entity_id and p.attribute_id = 'parent' "
"join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' "
"where e.dirty = 1 and p.value is NULL or p.value='not-set' "
"and d.value = 0 "
))))
(if (null? de)
'()
(map
......@@ -97,6 +105,29 @@
(get-entity-plain db table (vector-ref i 0))))
(cdr de)))))
;; include all the ktvs - including the parent itself
(define (dirty-entities-for-review-parent db table parent)
(let ((de (db-select
db (string-append
"select e.entity_id, e.entity_type, e.unique_id, e.dirty, e.version from " table "_entity as e "
"left join " table "_value_varchar "
"as p on p.entity_id = e.entity_id and p.attribute_id = 'parent' "
"join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' "
"where e.dirty=1 and (p.value = ? or e.unique_id = ?) and d.value=0;")
parent parent)))
(if (null? de)
'()
(map
(lambda (i)
;;(msg "dirty-entities")
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
(get-entity-plain db table (vector-ref i 0))))
(cdr de)))))
;; todo: BROKEN...
;; used for sync-all
......
......@@ -99,7 +99,7 @@
(let ((s (db-select
db (string-append
"select * from " table "_attribute where entity_type = ?")
entity-type)))
entity-type)))
(if (null? s) '()
(map
(lambda (row)
......
......@@ -18,6 +18,11 @@
(provide (all-defined-out))
;; todo: why are the fast versions switched off?
;; presumably not on raspberry pi - bugger.
;; do something with racket-fix.scm...
;(define (ktv-get ktv-list key)
; (cond
; ((null? ktv-list) #f)
......
......@@ -45,6 +45,7 @@
(define db (db-open db-name setup))
(open-log "log.txt")
;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv")
;(msg (csv db "sync" "individual"))
......
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