Commit aff06023 authored by Dave Griffiths's avatar Dave Griffiths

added admin app

parent a3ebe991
Open Sauces Notebook
====================
A structured notebook for recipes
Symbai android app
==================
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbaidb"
android:versionCode="1"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
android:theme="@style/StarwispTheme"
android:hardwareAccelerated="true"
>
<activity android:name="foam.symbaidb.starwisp"
android:configChanges="orientation"
android:label="@string/app_name">
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
<activity android:name="MainActivity" android:configChanges="orientation"></activity>
<activity android:name="ReviewItemActivity" android:configChanges="orientation"></activity>
</application>
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE" />
<uses-sdk android:minSdkVersion="8" />
<uses-feature android:name="android.hardware.camera" android:required="true" />
<supports-screens
android:smallScreens="true"
android:normalScreens="true"
android:largeScreens="true"
android:xlargeScreens="true"
android:anyDensity="true" />
</manifest>
Admin SQLite eavdb editor
=========================
#
# Set the keystore properties for signing the application.
#
#key.store=ushahidi-key.keystore
#key.alias=ushahidi-android
key.store=/home/dave/.keystore
key.alias=release_key
dave@fulmar.4670:1404729118
\ No newline at end of file
This diff is collapsed.
../../eavdb/
\ No newline at end of file
This diff is collapsed.
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; common code - require and provide ignored on tinyscheme
(require (planet jaymccarthy/sqlite:5:1/sqlite))
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-insert.ss"
"entity-get.ss"
"entity-update.ss"
"entity-sync.ss"
"entity-filter.ss")
(provide (all-defined-out))
;; create eav tables (add types as required)
(define (setup db table)
(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 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, version 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, version 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, version 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(4096), dirty integer, version integer)")))
(define (db-open db-name)
(cond
((file-exists? (string->path db-name))
(display "open existing db")(newline)
(open (string->path db-name)))
(else
(display "making new db")(newline)
(let ((db (open (string->path db-name))))
;; todo, dynamically create these tables
(setup db "sync")
(setup db "stream")
db))))
(define (validate db)
;; check attribute for duplicate entity-id/attribute-ids
0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
(define (db-all db table type)
(map
(lambda (i)
(get-entity db table i))
(all-entities db table type)))
(define (db-with-parent db table type parent)
(map
(lambda (i)
(get-entity db table i))
(all-entities-with-parent db table type parent)))
(define (db-filter db table type filter)
(map
(lambda (i)
(get-entity db table i))
(filter-entities db table type filter)))
;; Naked on Pluto Copyright (C) 2010 Aymeric Mansoux, Marloes de Valk, Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
#lang scheme
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-get.ss")
(provide (all-defined-out))
(define (csv-titles db table entity-type)
(foldl
(lambda (kt r)
(if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
(string-append r ", \"" (ktv-key kt) "\"")))
"id "
(get-attribute-ids/types db table entity-type)))
(define (csv db table entity-type)
(foldl
(lambda (res r)
(let ((entity (get-entity-for-csv db table (vector-ref res 0))))
(string-append
r "\n"
(foldl
(lambda (ktv r)
(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-"))
(string-append r ", \"" (get-entity-names db "sync" (string-split (ktv-value ktv) '(#\,))) "\""))
;; 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")))
(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 (db-select
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-insert.ss"
"entity-get.ss"
"entity-update.ss")
(provide (all-defined-out))
;; filter is list of (attribute-key type op arg) e.g. ("gender" "varchar" "=" "Female")
;; note: only one filter per key..
(define (make-filter k t o a) (list k t o a))
(define (filter-key f) (list-ref f 0))
(define (filter-type f) (list-ref f 1))
(define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3))
(define (merge-filter f fl)
(cond
((null? fl) (list f))
((equal? (filter-key (car fl)) (filter-key f))
(cons f (cdr fl)))
(else (cons (car fl) (merge-filter f (cdr fl))))))
(define (delete-filter key fl)
(cond
((null? fl) '())
((equal? (filter-key (car fl)) key)
(cdr fl))
(else (cons (car fl) (delete-filter key (cdr fl))))))
(define (build-query 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) " ? ")))
;; 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 ")
filter)
"where e.entity_type = ? order by n.value"))
(define (build-args filter)
(map
(lambda (i)
(filter-arg i))
filter))
(define (filter-entities db table type filter)
(let ((s (apply
db-select
(dbg (append
(list db (build-query table filter))
(build-args filter)
(list type))))))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss")
(provide (all-defined-out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
(define (entity-exists? db table unique-id)
(not (null? (select-first
db (string-append
"select * from " table "_entity where unique_id = ?")
unique-id))))
(define (get-entity-type db table entity-id)
(select-first
db (string-append
"select entity_type from " table "_entity where entity_id = ?")
entity-id))
(define (get-all-entity-types db table)
(cdr (db-select db (string-append "select distinct entity_type from " table "_entity;"))))
;; fold over values - fn takes ktv, dirty and accum
(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)))))))
;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id)
(fold-entity
(lambda (kt vd r)
(if (null? vd)
r (cons (ktv (ktv-key kt) (ktv-type kt) (car vd)) r)))
db table entity-id))
;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id)
(fold-entity
(lambda (kt vd r)
(cond
((null? vd) r)
;; only return if dirty
((zero? (cadr vd))
(cons
(list (ktv-key kt) (ktv-type kt) (list-ref vd 0))
r))
(else r)))
db table entity-id))
;; get an entire entity, as a list of key/value pairs maintaining order by filling
;; out null values - only use for csv building
(define (get-entity-for-csv db table entity-id)
(fold-entity
(lambda (kt vd r)
(if (null? vd)
(cons (list (ktv-key kt) (ktv-type kt) (null-value-for-type (ktv-type kt))) r)
(cons (ktv (ktv-key kt) (ktv-type kt) (car vd)) r)))
db table entity-id))
;; get an entire entity, as a list of key/value pairs (includes entity id)
(define (get-entity db table entity-id)
(let ((unique-id (get-unique-id db table entity-id)))
(cons
(list "unique_id" "varchar" unique-id)
(get-entity-plain db table entity-id))))
(define (all-entities db table type)
(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 = ?"
"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")
"name" "deleted" type)))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (all-entities-with-parent db table type parent)
(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 = ?"
"join " table "_value_varchar "
" 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 "
"p.value = ? and "
"(d.value='NULL' or d.value is NULL or d.value = 0) "
"order by n.value")
"name" "parent" "deleted" type parent)))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 (get-unique-id db table entity-id)
(select-first
db (string-append
"select unique_id from " table "_entity where entity_id = ?")
entity-id))
(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-by-unique db table unique-id)
(get-entity db table (get-entity-id db table unique-id)))
(define (get-entity-name db table unique-id)
(ktv-get (get-entity-by-unique db table unique-id) "name"))
(define (get-entity-names db table id-list)
(foldl
(lambda (id r)
(if (equal? r "")
(get-entity-name db table id)
(string-append r ", " (get-entity-name db table id))))
""
id-list))
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss")
(provide (all-defined-out))
;; insert an entire entity
(define (insert-entity db table entity-type user ktvlist)
(insert-entity-wholesale db table entity-type (get-unique user) 1 0 ktvlist))
;; insert an entire entity
(define (insert-entity/get-unique db table entity-type user ktvlist)
(let ((uid (get-unique user)))
(insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
uid))
(define sema (make-semaphore 1))
;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(semaphore-wait sema)
(db-exec db "begin transaction")
(let ((id (db-insert
db (string-append
"insert into " table "_entity values (null, ?, ?, ?, ?)")
entity-type unique-id dirty version)))
;; create the attributes if they are new, and validate them if they exist
(for-each
(lambda (ktv)
(find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv)))
ktvlist)
;; add all the keys
(for-each
(lambda (ktv)
(insert-value db table id ktv dirty))
ktvlist)
(db-exec db "end transaction")
(semaphore-post sema)
id))
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-insert.ss"
"entity-get.ss"
"entity-update.ss")
(provide (all-defined-out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; versioning
(define (get-entity-version db table entity-id)
(select-first
db (string-append "select version from " table "_entity where entity_id = ?")
entity-id))
(define (get-entity-dirty db table entity-id)
(select-first
db (string-append "select dirty from " table "_entity where entity_id = ?")
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)) )
(define (get-dirty-stats db table)
(list
(select-first
db (string-append "select count(entity_id) from " table "_entity where dirty=1"))
(select-first
db (string-append "select count(entity_id) from " table "_entity;"))))
(define (dirty-entities db table)
(let ((de (db-select
db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;"))))
(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))
;; data entries (todo - only dirty values!)
(dbg (get-entity-plain-for-sync db table (vector-ref i 0)))))
(cdr de)))))
;; 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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing
(define (stringify-list l)
(foldl
(lambda (i r)
(string-append r " " i))
"" l))
(define (stringify-ktvlist ktvlist)
(foldl
(lambda (i r)
(string-append r " " (ktv-key i) ":" (stringify-value i)))
""
ktvlist))
(define (build-sync-debug db table)
(foldl
(lambda (i r)
(string-append
r "\n" (vector-ref i 0) " " (vector-ref i 1) " "
(stringify-ktvlist (get-entity db table (vector-ref i 0)))))
""
(cdr (db-select
db (string-append "select * from " table "_entity where dirty=1;")))))
(define (build-sync db table)
(map
(lambda (i)
(list
(vector->list i)
(get-entity db table (vector-ref i 0))))
(cdr (db-select
db (string-append "select * from " table "_entity where dirty=1;")))))
(define (entity-sync-test db table)
(define e (insert-entity db table "thing" "me" (list (ktv "param1" "varchar" "bob")
(ktv "param2" "int" 30)
(ktv "param3" "real" 3.141)
(ktv "name" "varchar" "name")
(ktv "deleted" "int" 0))))
(define e2 (insert-entity db table "thing" "me"
(list (ktv "param1" "varchar" "bob")