From 74ff7eb6957865a1431e89cd4a92a60de795f032 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Thu, 1 May 2014 16:13:15 +0100 Subject: [PATCH] sorting out stuff --- eavdb/eavdb.ss | 1 + web/scripts/server-sync.ss | 2 +- web/scripts/sql.ss | 14 ++++++++++++++ web/server.scm | 15 +-------------- web/test.scm | 26 ++++++-------------------- 5 files changed, 23 insertions(+), 35 deletions(-) diff --git a/eavdb/eavdb.ss b/eavdb/eavdb.ss index 31c4599..d61e74a 100644 --- a/eavdb/eavdb.ss +++ b/eavdb/eavdb.ss @@ -44,6 +44,7 @@ (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 (validate db) ;; check attribute for duplicate entity-id/attribute-ids 0) diff --git a/web/scripts/server-sync.ss b/web/scripts/server-sync.ss index a48bd3d..335e1a5 100644 --- a/web/scripts/server-sync.ss +++ b/web/scripts/server-sync.ss @@ -187,7 +187,7 @@ (build db (- n 1)))) (define (test) - (let ((db (db-open "unit.db"))) + (let ((db (db-open "unit.db" setup))) (build db 99999999) )) diff --git a/web/scripts/sql.ss b/web/scripts/sql.ss index cda5139..e3c39bd 100644 --- a/web/scripts/sql.ss +++ b/web/scripts/sql.ss @@ -31,6 +31,20 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (db-open db-name setup-fn) + (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-fn db "sync") + (setup-fn db "stream") + db)))) + + ;; helper to return first instance from a select (define (select-first db str . args) (let ((s (apply db-select (append (list db str) args)))) diff --git a/web/server.scm b/web/server.scm index 9a32b0a..45edb71 100755 --- a/web/server.scm +++ b/web/server.scm @@ -35,26 +35,13 @@ ; "scripts/input.ss" ) -(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)))) - ; a utility to change the process owner, ; assuming mzscheme is called by root. ;;(unsafe!) ;;(define setuid (get-ffi-obj 'setuid #f (_fun _int -> _int))) (define db-name "client/htdocs/symbai.db") -(define db (db-open db-name)) +(define db (db-open db-name setup)) (open-log "log.txt") ;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv") diff --git a/web/test.scm b/web/test.scm index cbf676a..106200a 100755 --- a/web/test.scm +++ b/web/test.scm @@ -21,32 +21,18 @@ "scripts/txt.ss" "scripts/server-sync.ss") -(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 db-name "unit-test.db") -(with-handlers - ((exn:fail? (lambda (e) (msg e)))) - (delete-file db-name)) -(define db (db-open db-name)) (open-log "unit-test-log.txt") (define (unit-tests) ;; db -(msg "testing db") -(define db "unit-test.db") -(set! db (db-open db)) + (msg "testing db") + (define db "unit-test.db") + (with-handlers + ((exn:fail? (lambda (e) (msg e)))) + (delete-file db)) + (set! db (db-open db setup)) ;;(msg (db-status db)) -- GitLab