From 74ff7eb6957865a1431e89cd4a92a60de795f032 Mon Sep 17 00:00:00 2001
From: Dave Griffiths <dave@fo.am>
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