Skip to content

GitLab

Commit d0108787 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

internal android db working

parent 3a39bd89
Hide whitespace changes
Inline Side-by-side
Showing with 338 additions and 93 deletions
android/assets/eavdb.scm 0 → 100644
View file @ d0108787
;; MongooseWeb Copyright (C) 2013 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/>.
;; sql (in)sanity
;; android/racket stuff
(define exec/ignore db-exec)
(define db-select db-exec)
;; create eav tables (add types as required)
(define (setup db)
(exec/ignore db "create table entity ( entity_id integer primary key autoincrement, entity_type varchar(256))")
(exec/ignore db "create table attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))")
(exec/ignore db "create table value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096))")
(exec/ignore db "create table value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer)")
(exec/ignore db "create table value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real)"))
(define (sqls str)
;; todo sanitise str
str)
;; basic key/type/value structure
(define (ktv key type value) (list key type value))
(define ktv-key car)
(define ktv-type cadr)
(define ktv-value caddr)
;; stringify based on type
(define (stringify-value ktv)
(cond
((equal? (ktv-type ktv) "varchar") (string-append "'" (ktv-value ktv) "'"))
(else (number->string (ktv-value ktv)))))
;; helper to return first instance from a select
(define (select-first db str)
(let ((s (db-select db str)))
(if (or (null? s) (eq? s #t))
'()
(vector-ref (cadr s) 0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; putting data in
;; get the type from the attribute table with an entity/key
(define (get-attribute-type db entity-type key)
(let ((sql (string-append
"select attribute_type from attribute where entity_type = '"
(sqls entity-type)
"' and attribute_id = '"
(sqls key) "'")))
(select-first db sql)))
;; search for a type and add it if it doesn't exist
(define (find/add-attribute-type db entity-type key type)
(let ((t (get-attribute-type db entity-type key)))
;; add and return passed in type if not exist
(cond
((null? t)
(msg "adding new attribute for" entity-type " called " key " of type " type)
(db-insert
db (string-append
"insert into attribute values (null, '"
(sqls key) "', '" (sqls entity-type) "', '" (sqls type) "')"))
type)
(else
(cond
((equal? type t) t)
(else
(msg "type has changed for" entity-type key "from" t "to" type "???")
;; wont work
;; what do we do?
;; some kind of coercion for existing data???
type))))))
;; low level insert of a ktv
(define (insert-value db entity-id ktv)
;; use type to dispatch insert to correct value table
(db-insert db (string-append "insert into value_" (sqls (ktv-type ktv))
" values (null, " (number->string entity-id) ", '" (sqls (ktv-key ktv)) "', "
(stringify-value ktv) ")")))
;; insert an entire entity
(define (insert-entity db entity-type ktvlist)
(let ((id (db-insert
db (string-append
"insert into entity values (null, '" (sqls entity-type) "')"))))
;; create the attributes if they are new, and validate them if they exist
(for-each
(lambda (ktv)
(find/add-attribute-type db entity-type (ktv-key ktv) (ktv-type ktv)))
ktvlist)
;; add all the keys
(for-each
(lambda (ktv)
(msg (ktv-key ktv))
(insert-value db id ktv))
ktvlist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
(define (get-entity-type db entity-id)
(select-first
db (string-append
"select entity_type from entity where entity_id = " (number->string entity-id))))
;; get all the (current) attributes for an entity type
(define (get-attribute-ids/types db entity-type)
(let ((s (db-select
db (string-append
"select * from attribute where entity_type = '" (sqls entity-type) "'"))))
(if (null? s) '()
(map
(lambda (row)
(list (vector-ref row 1) ;; id
(vector-ref row 3))) ;; type
(cdr s)))))
;; get the value given an entity type, a attribute type and it's key (= attriute_id)
(define (get-value db entity-id kt)
(select-first
db (string-append "select value from value_" (sqls (ktv-type kt))
" where entity_id = " (number->string entity-id)
" and attribute_id = '" (sqls (ktv-key kt)) "'")))
;; get an entire entity, as a list of key/value pairs
(define (get-entity db entity-id)
(let* ((entity-type (get-entity-type db entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(cons
(list "entity_id" "int" entity-id)
(map
(lambda (kt)
(list (ktv-key kt) (ktv-type kt) (get-value db entity-id kt)))
(get-attribute-ids/types db entity-type)))))))
(define (all-entities db type)
(map
(lambda (i)
(string->number (vector-ref i 0)))
(cdr
(db-select
db
(string-append "select entity_id from entity where entity_type = '" type "';")))))
(define (validate db)
;; check attribute for duplicate entity-id/attribute-ids
0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
(define (ktv-get ktv-list key)
(cond
((null? ktv-list) #f)
((equal? (ktv-key (car ktv-list)) key)
(ktv-value (car ktv-list)))
(else (ktv-get (cdr ktv-list) key))))
(define (db-all db type)
(map
(lambda (i)
(get-entity db i))
(all-entities db type)))
android/assets/lib.scm
View file @ d0108787
......@@ -14,6 +14,14 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(define (msg . args)
(for-each
(lambda (i) (display i)(display " "))
args)
(newline))
(define (dbg i) (msg i) i)
(define (filter fn l)
(foldl
(lambda (i r)
......
android/assets/starwisp.scm
View file @ d0108787
......@@ -14,37 +14,44 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; persistent database
(define db "/sdcard/mongoose/test.db")
(define db "/sdcard/test.db")
(db-open db)
(setup db)
(display (db-exec db "select * from entity"))(newline)
(display (db-status db))(newline)
(display (db-open db))(newline)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
(display (db-status db))(newline)
(define (store-set store key value)
(cond
((null? store) (list (list key value)))
((eq? key (car (car store)))
(cons (list key value) (cdr store)))
(else
(cons (car store) (store-set (cdr store) key value)))))
(db-exec db "CREATE TABLE COMPANY(
ID INT PRIMARY KEY NOT NULL,
NAME TEXT NOT NULL,
AGE INT NOT NULL,
ADDRESS CHAR(50),
SALARY REAL );")
(define (store-get store key)
(cond
((null? store) #f)
((eq? key (car (car store)))
(cadr (car store)))
(else
(store-get (cdr store) key))))
(display (db-status db))(newline)
(db-exec db "INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
VALUES (1, 'Paul', 32, 'California', 20000.00 );
INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
VALUES (2, 'Allen', 25, 'Texas', 15000.00 );
INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
VALUES (3, 'Teddy', 23, 'Norway', 20000.00 );
INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
VALUES (4, 'Mark', 25, 'Rich-Mond ', 65000.00 );")
(define store '())
(display (db-status db))(newline)
(define (set-current! key value)
(set! store (store-set store key value)))
(display (db-exec db "select * from COMPANY"))(newline)
(define (get-current key)
(store-get store key))
(display (db-status db))(newline)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (mbutton id title fn)
(button (make-id id) title 20 fillwrap fn))
......@@ -304,33 +311,37 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ((build-pack-buttons
(lambda ()
(map
(lambda (pack)
(let ((name (ktv-get pack "name")))
(button (make-id (string-append "manage-packs-pack-" name))
name 20 fillwrap
(lambda ()
(list (start-activity "manage-individual" 2 (db-get pack "id")))))))
(db-all db "pack")))))
(activity
"manage-packs"
(vert
(text-view (make-id "title") "Manage packs" 40 fillwrap)
(spacer 10)
(horiz
(button (make-id "manage-packs-pack-0") "Pack 1" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 ""))))
(button (make-id "manage-packs-pack-1") "Pack 2" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 "")))))
(horiz
(button (make-id "manage-packs-pack-2") "Pack 3" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 ""))))
(button (make-id "manage-packs-pack-3") "Pack 4" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 "")))))
(horiz
(button (make-id "manage-packs-pack-4") "Pack 5" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 ""))))
(button (make-id "manage-packs-pack-5") "Pack 6" 20 fillwrap (lambda () (list (start-activity "manage-individual" 2 "")))))
(button (make-id "manage-packs-new") "New pack" 30 fillwrap (lambda () (list (start-activity "new-pack" 2 ""))))
(linear-layout
(make-id "manage-packs-pack-list")
'vertical fill (list))
(button (make-id "manage-packs-new") "New pack" 20 fillwrap (lambda () (list (start-activity "new-pack" 2 ""))))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-packs-pack-list") 'contents
(build-pack-buttons))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity requestcode resultcode) '()))
(lambda (activity requestcode resultcode) '())))
(activity
"new-pack"
......@@ -338,9 +349,17 @@
(text-view (make-id "title") "New pack" 40 fillwrap)
(spacer 10)
(text-view (make-id "new-pack-name-text") "Pack name" 20 fillwrap)
(edit-text (make-id "new-pack-name") "" 30 fillwrap (lambda (v) '()))
(edit-text (make-id "new-pack-name") "" 30 fillwrap
(lambda (v) (set-current! 'pack-name v) '()))
(spacer 10)
(button (make-id "new-pack-done") "Done" 30 fillwrap (lambda () (list (finish-activity 2))))
(horiz
(button (make-id "new-pack-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "new-pack-done") "Done" 20 fillwrap
(lambda ()
(insert-entity
db "pack" (list
(ktv "name" "varchar" (get-current 'pack-name))))
(list (finish-activity 2)))))
)
(lambda (activity arg)
(activity-layout activity))
......@@ -368,7 +387,7 @@
(button (make-id "manage-individuals-4") "Mongoose 5" 20 fillwrap (lambda () (list (start-activity "update-individual" 2 ""))))
(button (make-id "manage-individuals-5") "Mongoose 6" 20 fillwrap (lambda () (list (start-activity "update-individual" 2 "")))))
(button (make-id "manage-individuals-new") "New individual" 30 fillwrap (lambda () (list (start-activity "new-individual" 2 ""))))
(button (make-id "manage-individuals-new") "New individual" 20 fillwrap (lambda () (list (start-activity "new-individual" 2 ""))))
)
(lambda (activity arg)
......@@ -398,7 +417,7 @@
(text-view (make-id "new-individual-chip-text") "Chip code" 20 fillwrap)
(edit-text (make-id "new-individual-chip-code") "" 30 fillwrap (lambda (v) '()))
(spacer 10)
(button (make-id "new-individual-done") "Done" 30 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "new-individual-done") "Done" 20 fillwrap (lambda () (list (finish-activity 2))))
)
(lambda (activity arg)
(activity-layout activity))
......@@ -428,11 +447,11 @@
(edit-text (make-id "update-individual-chip-code") "" 30 fillwrap (lambda (v) '()))
(spacer 10)
(horiz
(button (make-id "update-individual-delete") "Delete" 30 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-died") "Died" 30 fillwrap (lambda () (list (finish-activity 2)))))
(button (make-id "update-individual-delete") "Delete" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-died") "Died" 20 fillwrap (lambda () (list (finish-activity 2)))))
(horiz
(button (make-id "update-individual-cancel") "Cancel" 30 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-done") "Done" 30 fillwrap (lambda () (list (finish-activity 2)))))
(button (make-id "update-individual-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-done") "Done" 20 fillwrap (lambda () (list (finish-activity 2)))))
)
(lambda (activity arg)
(activity-layout activity))
......@@ -464,8 +483,8 @@
(text-view (make-id "tag-location-radius-value") "10m" 20 fillwrap)
(horiz
(button (make-id "tag-location-cancel") "Cancel" 30 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "tag-location-done") "Done" 30 fillwrap (lambda () (list (finish-activity 2)))))
(button (make-id "tag-location-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "tag-location-done") "Done" 20 fillwrap (lambda () (list (finish-activity 2)))))
)
(lambda (activity arg)
......
android/jni/core/db.cpp
View file @ d0108787
......@@ -40,6 +40,18 @@ db::~db()
static int callback(void *d, int argc, char **argv, char **azColName){
int i;
list *data=(list*)d;
// add the column names first time round
if (data->size()==0)
{
list *row = new list;
for(i=0; i<argc; i++)
{
row->add_to_end(new db::value_node(azColName[i]));
}
data->add_to_end(new db::row_node(row));
}
list *row = new list;
for(i=0; i<argc; i++)
{
......@@ -89,3 +101,26 @@ list *db::exec(const char *sql)
return data;
}
unsigned int db::insert(const char *sql)
{
if (!m_running) return 0;
char *err = 0;
list *data = new list;
int rc = sqlite3_exec(m_db, sql, callback, data, &err);
if( rc != SQLITE_OK )
{
snprintf(m_status,4096,"SQL error: %s",err);
//m_running=0;
sqlite3_free(err);
return 0;
}
else
{
snprintf(m_status,4096,"SQL GOOD.");
}
return sqlite3_last_insert_rowid(m_db);
}
android/jni/core/db.h
View file @ d0108787
......@@ -27,6 +27,7 @@ public:
~db();
list *exec(const char *sql);
unsigned int insert(const char *sql);
const char *status() { return m_status; }
class value_node: public list::node
......
android/jni/main.cpp
View file @ d0108787
......@@ -77,34 +77,10 @@ int main(int argc, char *argv[])
appEval("(display \"loaded init\")(newline)");
appEval((char*)LoadFile("../assets/lib.scm").c_str());
appEval("(display \"loaded lib\")(newline)");
appEval((char*)LoadFile("../assets/eavdb.scm").c_str());
appEval("(display \"loaded eavdb\")(newline)");
appEval((char*)LoadFile("../assets/starwisp.scm").c_str());
appEval("(display \"loaded starwisp\")(newline)");
/*
db my_db("test.db");
my_db.exec("CREATE TABLE COMPANY(" \
"ID INT PRIMARY KEY NOT NULL," \
"NAME TEXT NOT NULL," \
"AGE INT NOT NULL," \
"ADDRESS CHAR(50)," \
"SALARY REAL );");
my_db.exec("INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY) " \
"VALUES (1, 'Paul', 32, 'California', 20000.00 ); " \
"INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY) " \
"VALUES (2, 'Allen', 25, 'Texas', 15000.00 ); " \
"INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)" \
"VALUES (3, 'Teddy', 23, 'Norway', 20000.00 );" \
"INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)" \
"VALUES (4, 'Mark', 25, 'Rich-Mond ', 65000.00 );");
list *data = my_db.exec("SELECT * FROM COMPANY");
// my_db.print_data(data);
delete data;
*/
return 0;
}
android/jni/scheme/opdefines.h
View file @ d0108787
......@@ -194,6 +194,7 @@
_OP_DEF(opexe_6, "send", 1, 1, TST_NONE, OP_SEND )
_OP_DEF(opexe_6, "db-open", 1, 1, TST_NONE, OP_OPEN_DB )
_OP_DEF(opexe_6, "db-exec", 2, 2, TST_NONE, OP_EXEC_DB )
_OP_DEF(opexe_6, "db-insert", 2, 2, TST_NONE, OP_INSERT_DB )
_OP_DEF(opexe_6, "db-status", 1, 1, TST_NONE, OP_STATUS_DB )
......
android/jni/scheme/scheme.cpp
View file @ d0108787
......@@ -4189,26 +4189,32 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
return sc->T;
}
// fudge to behave like planet jaymccarthy/sqlite:5:1/sqlite
static pointer db_data_to_scm(scheme *sc, list *data)
{
pointer ret=sc->NIL;
db::row_node *row=(db::row_node*)data->m_head;
while (row!=NULL)
if (data!=NULL)
{
pointer ret_row=sc->NIL;
db::value_node *value=(db::value_node*)row->m_row->m_head;
while (value!=NULL)
pointer ret=sc->NIL;
db::row_node *row=(db::row_node*)data->m_head;
while (row!=NULL)
{
ret_row=cons(sc,mk_string(sc,value->m_value),ret_row);
value=(db::value_node*)value->m_next;
}
pointer ret_row=mk_vector(sc,row->m_row->size());
int p=0;
db::value_node *value=(db::value_node*)row->m_row->m_head;
while (value!=NULL)
{
set_vector_elem(ret_row,p,mk_string(sc,value->m_value));
p++;
value=(db::value_node*)value->m_next;
}
ret_row=reverse(sc,ret_row);
ret=cons(sc,ret_row,ret);
row=(db::row_node*)row->m_next;
ret=cons(sc,ret_row,ret);
row=(db::row_node*)row->m_next;
}
ret=reverse(sc,ret);
return ret;
}
ret=reverse(sc,ret);
return ret;
return sc->NIL;
}
static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
......@@ -4286,6 +4292,17 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
}
s_return(sc,sc->F);
}
case OP_INSERT_DB: {
if (is_string(car(sc->args)) &&
is_string(cadr(sc->args))) {
db *d=the_db_container.get(string_value(car(sc->args)));
if (d!=NULL)
{
s_return(sc,mk_integer(sc,d->insert(string_value(cadr(sc->args)))));
}
}
s_return(sc,sc->F);
}
case OP_STATUS_DB: {
if (is_string(car(sc->args))) {
db *d=the_db_container.get(string_value(car(sc->args)));
......
android/src/foam/mongoose/Scheme.java
View file @ d0108787
......@@ -42,6 +42,7 @@ public class Scheme
Log.i("starwisp","started, now running init.scm...");
eval(readRawTextFile(ctx, "init.scm"));
eval(readRawTextFile(ctx, "lib.scm"));
eval(readRawTextFile(ctx, "eavdb.scm"));
}
public String eval(String code) {
......
web/scripts/eavdb.ss
View file @ d0108787
......@@ -19,6 +19,19 @@
;; sql (in)sanity
;; android/racket stuff
(define exec/ignore db-exec)
;; helper to return first instance from a select
(define (select-first db str)
(let ((s (select db str)))
(if (null? s)
s
(vector-ref (cadr s) 0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (msg . args)
(for-each
(lambda (i) (display i)(display " "))
......@@ -51,12 +64,6 @@
((equal? (ktv-type ktv) "varchar") (string-append "'" (ktv-value ktv) "'"))
(else (number->string (ktv-value ktv)))))
;; helper to return first instance from a select
(define (select-first db str)
(let ((s (select db str)))
(if (null? s)
s
(vector-ref (cadr s) 0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; putting data in
......
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