Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
nebogeo
symbai
Commits
85d4dc24
Commit
85d4dc24
authored
Apr 15, 2014
by
Dave Griffiths
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' of github.com:nebogeo/symbai
parents
526b6b82
f72192c4
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
18 additions
and
17 deletions
+18
-17
web/scripts/eavdb.ss
web/scripts/eavdb.ss
+9
-9
web/scripts/sync.ss
web/scripts/sync.ss
+8
-7
web/server.scm
web/server.scm
+1
-1
No files found.
web/scripts/eavdb.ss
View file @
85d4dc24
...
...
@@ -197,7 +197,7 @@
;; only update if the are different
(
if
(
not
(
ktv-eq?
ktv
(
list
(
ktv-key
ktv
)
(
ktv-type
ktv
)
s
)))
(
begin
(
msg
"incrementing value version in update-value"
)
;;
(msg "incrementing value version in update-value")
(
db-exec
db
(
string-append
"update "
table
"_value_"
(
ktv-type
ktv
)
" set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?"
)
...
...
@@ -210,9 +210,9 @@
db
(
string-append
"select value from "
table
"_value_"
(
ktv-type
ktv
)
" where entity_id = ? and attribute_id = ?"
)
entity-id
(
ktv-key
ktv
))))
(
msg
"update-value-from-sync"
s
)
(
msg
ktv
)
(
msg
entity-id
)
;;
(msg "update-value-from-sync" s)
;;
(msg ktv)
;;
(msg entity-id)
(
if
(
null?
s
)
(
insert-value
db
table
entity-id
ktv
#t
)
(
db-exec
...
...
@@ -489,7 +489,7 @@
entity-id
(
ktv-key
kt
)))
(
define
(
clean-entity-values
db
table
entity-id
)
(
msg
"clean-entity-values"
)
;;
(msg "clean-entity-values")
(
let*
((
entity-type
(
get-entity-type
db
table
entity-id
)))
(
cond
((
null?
entity-type
)
...
...
@@ -497,7 +497,7 @@
(
else
(
for-each
(
lambda
(
kt
)
(
msg
"cleaning"
kt
)
;;
(msg "cleaning" kt)
(
clean-value
db
table
entity-id
(
list
(
ktv-key
kt
)
(
ktv-type
kt
))))
(
get-attribute-ids/types
db
table
entity-type
))))))
...
...
@@ -564,13 +564,13 @@
version
entity-id
))
(
define
(
update-entity-clean
db
table
unique-id
)
(
msg
"cleaning"
)
;;
(msg "cleaning")
;; clean entity table
(
db-exec
db
(
string-append
"update "
table
"_entity set dirty=? where unique_id = ?"
)
0
unique-id
)
;; clean value tables for this entity
(
msg
"cleaning values"
)
;;
(msg "cleaning values")
(
clean-entity-values
db
table
(
entity-id-from-unique
db
table
unique-id
))
)
(
define
(
get-dirty-stats
db
table
)
...
...
@@ -588,7 +588,7 @@
'
()
(
map
(
lambda
(
i
)
(
msg
"dirty-entities"
)
;;
(msg "dirty-entities")
(
list
;; build according to url ([table] entity-type unique-id dirty version)
(
cdr
(
vector->list
i
))
...
...
web/scripts/sync.ss
View file @
85d4dc24
...
...
@@ -24,7 +24,6 @@
(
define
(
request-args->ktvlist
data
)
(
map
(
lambda
(
i
)
(
msg
i
)
(
let
((
kv
(
string-split
(
symbol->string
(
car
i
))
'
(
#
\
:
))))
(
list
(
car
kv
)
(
cadr
kv
)
(
cdr
i
)
(
string->number
(
list-ref
kv
2
)))))
...
...
@@ -32,13 +31,14 @@
(
define
(
sync-update
db
table
entity-type
unique-id
dirty
version
data
)
(
let
((
entity-id
(
entity-id-from-unique
db
table
unique-id
))
(
ktvlist
(
dbg
(
request-args->ktvlist
data
)))
)
(
msg
"sync-update"
ktvlist
)
(
ktvlist
(
request-args->ktvlist
data
)))
(
msg
"sync-update"
)
(
update-to-version
db
table
entity-id
version
ktvlist
)
(
list
"updated"
unique-id
)))
(
define
(
sync-insert
db
table
entity-type
unique-id
dirty
version
data
)
(
let
((
ktvlist
(
dbg
(
request-args->ktvlist
data
))))
(
let
((
ktvlist
(
request-args->ktvlist
data
)))
(
msg
"inserting new"
)
(
insert-entity-wholesale
db
table
entity-type
unique-id
dirty
version
ktvlist
)
(
list
"inserted"
unique-id
)))
...
...
@@ -51,12 +51,12 @@
(
define
(
merge-n-bump
current-version
db
table
entity-type
unique-id
dirty
version
data
)
(
let
((
entity-id
(
entity-id-from-unique
db
table
unique-id
)))
(
msg
"merge start:"
(
get-entity-version
db
table
entity-id
))
;;
(msg "merge start:" (get-entity-version db table entity-id))
(
let
((
r
(
sync-update
db
table
entity-type
unique-id
dirty
version
data
)))
(
msg
"merge post:"
(
get-entity-version
db
table
entity-id
))
;;
(msg "merge post:" (get-entity-version db table entity-id))
;; must be one newer than highest in the system
(
update-entity-version
db
table
entity-id
(
+
current-version
1
))
(
msg
"merge over:"
(
get-entity-version
db
table
entity-id
))
;;
(msg "merge over:" (get-entity-version db table entity-id))
r
)))
(
define
(
check-for-sync
db
table
entity-type
unique-id
dirty
version
data
)
...
...
@@ -117,6 +117,7 @@
(
define
(
entity-versions
db
table
)
(
let
((
s
(
db-select
db
(
string-append
"select unique_id, version from "
table
"_entity;"
))))
(
msg
s
)
(
if
(
null?
s
)
'
()
(
map
...
...
web/server.scm
View file @
85d4dc24
...
...
@@ -44,7 +44,7 @@
;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv")
(
msg
(
csv
db
"sync"
"individual"
))
;
(msg (csv db "sync" "individual"))
(
define
registered-requests
...
...
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