Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
nebogeo
symbai
Commits
74ff7eb6
Commit
74ff7eb6
authored
May 01, 2014
by
Dave Griffiths
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
sorting out stuff
parent
c00d14ce
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
23 additions
and
35 deletions
+23
-35
eavdb/eavdb.ss
eavdb/eavdb.ss
+1
-0
web/scripts/server-sync.ss
web/scripts/server-sync.ss
+1
-1
web/scripts/sql.ss
web/scripts/sql.ss
+14
-0
web/server.scm
web/server.scm
+1
-14
web/test.scm
web/test.scm
+6
-20
No files found.
eavdb/eavdb.ss
View file @
74ff7eb6
...
...
@@ -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
)
...
...
web/scripts/server-sync.ss
View file @
74ff7eb6
...
...
@@ -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
)
))
...
...
web/scripts/sql.ss
View file @
74ff7eb6
...
...
@@ -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
))))
...
...
web/server.scm
View file @
74ff7eb6
...
...
@@ -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")
...
...
web/test.scm
View file @
74ff7eb6
...
...
@@ -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))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment