Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Dave Griffiths
mongoose-2000
Commits
6ea62f50
Commit
6ea62f50
authored
Jul 16, 2014
by
dave griffiths
Browse files
fixes to input
parent
42e1bb74
Changes
3
Hide whitespace changes
Inline
Side-by-side
web/run
View file @
6ea62f50
#!/bin/bash
./server.scm 8888
./server.scm 8888
>>
client/htdocs/log.txt 2>&1
web/scripts/input.ss
View file @
6ea62f50
...
...
@@ -17,7 +17,12 @@
(
require
(
planet
jaymccarthy/sqlite:5:1/sqlite
))
(
require
"utils.ss"
)
(
require
"eavdb.ss"
)
(
require
"sql.ss"
)
(
require
"../../eavdb/ktv.ss"
)
(
require
"../../eavdb/ktv-list.ss"
)
(
require
"../../eavdb/eavdb.ss"
)
(
require
"../../eavdb/entity-get.ss"
)
(
require
"../../eavdb/entity-insert.ss"
)
(
provide
(
all-defined-out
))
(
require
(
planet
neil/csv:1:=7
)
net/url
)
...
...
@@ -36,12 +41,40 @@
(
cons
row
(
loop
))))
(
loop
))
(
define
(
all-entities-where
db
table
type
ktv
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id from "
table
"_entity as e "
"join "
table
"_value_"
(
ktv-type
ktv
)
" "
"as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ? "
"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 substr(n.value,3)"
)
(
ktv-key
ktv
)
(
ktv-value
ktv
)
"name"
"deleted"
type
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
db-all-where
db
table
type
ktv
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where
db
table
type
ktv
))))
r
))
(
define
(
insert-mongooses
db
table
l
)
(
map
(
lambda
(
i
)
(
let
((
pack
(
car
(
db-all-where
db
table
"pack"
(
list
"name"
(
list-ref
i
2
)))))
(
let
((
pack
(
car
(
db-all-where
db
table
"pack"
(
list
"name"
"varchar"
(
list-ref
i
2
)))))
(
date
(
string-split
(
list-ref
i
3
)
'
(
#\/
))))
(
msg
i
)
(
insert-entity
db
table
"mongoose"
"sys"
...
...
web/server.scm
View file @
6ea62f50
...
...
@@ -33,7 +33,7 @@
"../eavdb/eavdb.ss"
"scripts/txt.ss"
"scripts/server-sync.ss"
;
"scripts/input.ss"
"scripts/input.ss"
)
; a utility to change the process owner,
...
...
@@ -45,7 +45,8 @@
(
define
db
(
db-open
db-name
setup
))
(
open-log
"log.txt"
)
;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv")
;(write-db db "sync" "/var/www/mongoose-web/web/input.csv")
;(msg (csv db "sync" "individual"))
...
...
@@ -62,7 +63,7 @@
(
msg
"couldn't get lock"
)
(
pluto-response
(
scheme->txt
'
(
"fail"
))))))
(
define
(
syncro
fn
)
(
define
(
syncro
-new
fn
)
(
msg
"s-start"
)
(
semaphore-wait
sema
)
(
let
((
r
(
fn
)))
...
...
@@ -70,6 +71,9 @@
(
semaphore-post
sema
)
r
))
(
define
(
syncro
fn
)
(
fn
))
(
define
registered-requests
(
list
...
...
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