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
9161798f
Commit
9161798f
authored
Sep 08, 2014
by
Dave Griffiths
Browse files
fixes/features from feedback, about to do debugging
parent
a44f5891
Changes
10
Hide whitespace changes
Inline
Side-by-side
android/AndroidManifest.xml
View file @
9161798f
...
...
@@ -34,6 +34,7 @@
<activity
android:name=
"ExportActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"ReviewActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"ReviewItemActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"ReviewCollectionActivity"
android:configChanges=
"orientation"
></activity>
</application>
<uses-permission
android:name=
"android.permission.WRITE_EXTERNAL_STORAGE"
/>
...
...
android/assets/dbsync.scm
View file @
9161798f
...
...
@@ -196,6 +196,15 @@
""
entities
))
(
define
(
assemble-array-with-ids
ids
)
(
foldl
(
lambda
(
i
r
)
(
if
(
equal?
r
""
)
i
(
string-append
r
","
i
)))
""
ids
))
(
define
(
string-split-simple
str
delim
)
(
string-split
str
(
list
delim
)))
...
...
@@ -298,9 +307,12 @@
(
string-append
url
"fn=file-list"
)
(
lambda
(
file-list
)
(
let
((
r
(
sync-files
file-list
)))
(
when
(
not
(
null?
r
))
(
set-current!
'upload
0
)
(
debug!
"Found a mismatch with files on raspberry pi - fixing..."
))
(
cond
((
not
(
null?
r
))
(
set-current!
'mismatch
0
)
(
debug!
"Found a mismatch with files on raspberry pi - fixing..."
))
(
else
(
set-current!
'mismatch
1
)))
r
)))))
...
...
@@ -434,17 +446,19 @@
(
lambda
(
data
)
(
let
((
new-entity-requests
(
build-entity-requests
db
table
data
)))
(
alog
"suck-new: marking dirty"
)
(
mark-unlisted-entities-dirty!
db
table
data
)
;; now doing this first!...
;; (mark-unlisted-entities-dirty! db table data)
(
alog
"suck-new: done marking dirty"
)
(
cond
((
null?
new-entity-requests
)
(
debug!
"No new data to download"
)
(
set-current!
'download
1
)
(
append
(
if
(
eqv?
(
get-current
'upload
0
)
1
)
(
list
(
play-sound
"ping"
))
'
())
(
list
(
toast
"No new data to download"
))))
(
if
(
and
;; (eqv? (get-current 'upload 0) 1) won't have got here if uploading still
(
eqv?
(
get-current
'mismatch
0
)
1
))
(
list
(
play-sound
"ping"
)
(
toast
"I'm synced with the Raspberry Pi"
))))
(
else
(
debug!
(
string-append
"Requesting "
...
...
@@ -463,24 +477,33 @@
"Stream data: "
(
number->string
(
car
stream
))
"/"
(
number->string
(
cadr
stream
)))))
(
define
(
upload-dirty
db
)
(
msg
"upload-dirty called"
)
(
let
((
r
(
append
(
spit
db
"sync"
(
dbg
(
dirty-entities
db
"sync"
)))
(
spit
db
"stream"
(
dirty-entities
db
"stream"
)))))
(
append
(
cond
((
>
(
length
r
)
0
)
(
debug!
(
string-append
"Uploading "
(
number->string
(
length
r
))
" items..."
))
(
list
(
toast
"Uploading data..."
)
(
play-sound
"active"
)))
(
else
(
debug!
"No data changed to upload"
)
(
set-current!
'upload
1
)
(
append
(
if
(
eqv?
(
get-current
'download
0
)
1
)
(
list
(
play-sound
"ping"
))
'
())
(
list
(
toast
"No data changed to upload"
)))))
r
)))
(
list
;; first check server for entities it doesn't have at all
;; (they need all attr marked as dirty
(
http-request
"upload-precheck-req"
(
string-append
url
"fn=entity-versions&table=sync"
)
(
lambda
(
data
)
;; todo - this is really slow and we're doing it all the time
;; if there are loads to do it's bad
(
msg
"checking for unlisted"
)
(
mark-unlisted-entities-dirty!
db
"sync"
data
)
(
let
((
r
(
append
(
spit
db
"sync"
(
dirty-entities
db
"sync"
))
(
spit
db
"stream"
(
dirty-entities
db
"stream"
)))))
(
append
(
cond
((
>
(
length
r
)
0
)
(
debug!
(
string-append
"Uploading "
(
number->string
(
length
r
))
" items..."
))
(
list
(
toast
"Uploading data..."
)
(
play-sound
"active"
)))
(
else
(
debug!
"No data changed to upload"
)
(
set-current!
'upload
1
)
(
list
(
toast
"No data changed to upload"
)))))
r
)))))
(
define
(
connect-to-net
fn
)
(
list
...
...
@@ -948,293 +971,3 @@
)))))
(
_
(
-
n
1
))))
(
_
(
random
10
)))
;;;;;;;;;; m2000 cruft
;; todo, sort these out... use new filter system...
(
define
(
all-entities-sort-normal
db
table
type
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id from "
table
"_entity as e "
"join "
table
"_value_varchar "
"as n on n.entity_id = e.entity_id "
"where entity_type = ? and n.attribute_id = ? "
"order by n.value"
)
type
"name"
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-where-ignore-delete
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 = ? "
"where e.entity_type = ? order by substr(n.value,3)"
)
(
ktv-key
ktv
)
(
ktv-value
ktv
)
"name"
type
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
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
(
all-entities-where2
db
table
type
ktv
ktv2
)
(
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_"
(
ktv-type
ktv2
)
" "
"as b on b.entity_id = e.entity_id and b.attribute_id = ? and b.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
)
(
ktv-key
ktv2
)
(
ktv-value
ktv2
)
"name"
"deleted"
type
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-where2or
db
table
type
ktv
ktv2
or-value
)
(
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_"
(
ktv-type
ktv2
)
" "
"as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value = ? or b.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
)
(
ktv-key
ktv2
)
(
ktv-value
ktv2
)
or-value
"name"
"deleted"
type
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-where-newer
db
table
type
ktv
ktv2
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id,d.value,b.value 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_"
(
ktv-type
ktv2
)
" "
"as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value > DateTime(?) and b.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
)
(
ktv-key
ktv2
)
(
ktv-value
ktv2
)
"Unknown"
"name"
"deleted"
type
)))
(
msg
"where newer"
(
ktv-value
ktv2
)
s
)
(
msg
"date select"
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-where-older
db
table
type
ktv
ktv2
)
(
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_"
(
ktv-type
ktv2
)
" "
"as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value < DateTime(?) and b.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
)
(
ktv-key
ktv2
)
(
ktv-value
ktv2
)
"Unknown"
"name"
"deleted"
type
)))
(
msg
"date select"
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
update-entities-where2
db
table
type
ktv
ktv2
)
(
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 "
"join "
table
"_value_"
(
ktv-type
ktv2
)
" as b on b.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ?"
)
type
(
ktv-key
ktv
)
(
ktv-key
ktv2
)
(
ktv-value
ktv
)
(
ktv-value
ktv2
))))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-in-date-range
db
table
type
start
end
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id from "
table
"_entity as e "
"join "
table
"_value_varchar "
"as t on t.entity_id = e.entity_id "
"where entity_type = ? and t.attribute_id = ? "
"and t.value > DateTime(?) and t.value <= DateTime(?) "
"order by t.value desc"
)
type
"time"
start
end
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
db-all-sort-normal
db
table
type
)
(
prof-start
"db-all"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-sort-normal
db
table
type
))))
(
prof-end
"db-all"
)
r
))
(
define
(
db-all-in-date-range
db
table
type
start
end
)
(
prof-start
"db-all"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-in-date-range
db
table
type
start
end
))))
(
prof-end
"db-all"
)
r
))
(
define
(
db-all-where-ignore-delete
db
table
type
ktv
)
(
prof-start
"db-all-where"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where-ignore-delete
db
table
type
ktv
))))
(
prof-end
"db-all-where"
)
r
))
(
define
(
db-all-where
db
table
type
ktv
)
(
prof-start
"db-all-where"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where
db
table
type
ktv
))))
(
prof-end
"db-all-where"
)
r
))
(
define
(
db-all-where2
db
table
type
ktv
ktv2
)
(
prof-start
"db-all-where2"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where2
db
table
type
ktv
ktv2
))))
(
prof-end
"db-all-where2"
)
r
))
(
define
(
db-all-where2or
db
table
type
ktv
ktv2
or-value
)
(
prof-start
"db-all-where2or"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where2or
db
table
type
ktv
ktv2
or-value
))))
(
prof-end
"db-all-where2or"
)
r
))
(
define
(
db-all-newer
db
table
type
ktv
ktv2
)
(
prof-start
"db-all-where newer"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where-newer
db
table
type
ktv
ktv2
))))
(
prof-end
"db-all-where newer"
)
r
))
(
define
(
db-all-older
db
table
type
ktv
ktv2
)
(
prof-start
"db-all-where older"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-where-older
db
table
type
ktv
ktv2
))))
(
prof-end
"db-all-where older"
)
r
))
(
define
(
db-all-with-parent
db
table
type
parent
)
(
prof-start
"db-all"
)
(
let
((
r
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities-with-parent
db
table
type
parent
))))
(
prof-end
"db-all"
)
r
))
android/assets/mongoose.scm
View file @
9161798f
...
...
@@ -95,9 +95,9 @@
(
define
list-strength
(
list
(
list
'none
"None"
)
(
list
'
weak
"Weak"
)
(
list
'
medium
"Medium"
)
(
list
'str
o
ng
"Strong"
)))
(
list
'
strength-3
"Weak"
)
(
list
'
strength-2
"Medium"
)
(
list
'str
e
ng
th-1
"Strong"
)))
(
define
list-gender
(
list
(
list
'male
"Male"
)
...
...
@@ -159,8 +159,7 @@
(
insert-entity-if-not-exists
db
"local"
"app-settings"
"null"
1
(
list
(
ktv
"user-id"
"varchar"
"No name yet..."
)))
(
msg
(
db-all-sort-normal
db
"local"
"app-settings"
)))
(
ktv
"user-id"
"varchar"
"No name yet..."
))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; user interface abstraction
...
...
@@ -346,28 +345,37 @@
(
string-split-simple
v
#
\
,
)
'
())))
(
define
(
db-mongoose-packs
)
(
msg
"db-mongooses-by-pack"
)
(
db-filter
db
"sync"
"pack"
'
()))
(
define
(
db-mongooses-by-pack
)
(
db-all-where
(
msg
"db-mongooses-by-pack"
)
(
db-filter
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))))
)
(
define
(
db-mongooses-by-pack-ignore-delete
)
(
db-
all-wh
er
e
-i
gnore
-delete
(
db-
filt
er-i
nc
-delete
d
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))))
)
(
define
(
db-mongooses-by-pack-male
)
(
db-
all-where2o
r
(
db-
filte
r
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
ktv
"gender"
"varchar"
"Male"
)
"Unknown"
))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"gender"
"varchar"
"not like"
"female"
))))
(
define
(
db-mongooses-by-pack-female
)
(
db-
all-where2o
r
(
db-
filte
r
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
ktv
"gender"
"varchar"
"Female"
)
"Unknown"
))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"gender"
"varchar"
"not like"
"male"
))))
;; (y m d h m s)
...
...
@@ -384,17 +392,38 @@
(
list-ref
d
5
)))))
(
define
(
db-mongooses-by-pack-pups
)
(
db-
all-new
er
(
db-
filt
er
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
ktv
"dob"
"varchar"
(
date->string
(
date-minus-months
(
date-time
)
6
)))))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"dob"
"varchar"
"t>"
(
date->string
(
date-minus-months
(
date-time
)
6
))))))
(
define
(
db-mongooses-by-pack-adults
)
(
db-
all-old
er
(
db-
filt
er
db
"sync"
"mongoose"
(
ktv
"pack-id"
"varchar"
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
ktv
"dob"
"varchar"
(
date->string
(
date-minus-months
(
date-time
)
6
)))))
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"dob"
"varchar"
"t<"
(
date->string
(
date-minus-months
(
date-time
)
6
))))))
(
define
(
db-mongooses-by-pack-adult-males
)
(
db-filter
db
"sync"
"mongoose"
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"gender"
"varchar"
"!="
"female"
)
(
list
"dob"
"varchar"
"t<"
(
date->string
(
date-minus-months
(
date-time
)
6
))))))
(
define
(
db-mongooses-by-pack-adult-females
)
(
db-filter
db
"sync"
"mongoose"
(
list
(
list
"pack-id"
"varchar"
"="
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))
(
list
"gender"
"varchar"
"!="
"male"
)
(
list
"dob"
"varchar"
"t<"
(
date->string
(
date-minus-months
(
date-time
)
6
))))))
(
define
(
tri-state
id
text
key
)
...
...
@@ -622,22 +651,55 @@
(
list
(
update-widget
'linear-layout
(
get-id
"review-list"
)
'contents
(
map
(
lambda
(
dirty-entity
)
(
foldl
(
lambda
(
dirty-entity
r
)
;; consists of ((type,uid,dirty,version) (ktvlist))
(
let*
((
data
(
car
dirty-entity
))
(
entity
(
cadr
dirty-entity
))
(
time
(
ktv-get
entity
"time"
))
(
type
(
list-ref
data
0
))
(
uid
(
list-ref
data
1
)))
(
mbutton
(
string-append
"review-"
uid
)
(
string-append
type
(
if
time
(
string-append
"-"
time
)
""
))
(
lambda
()
(
entity-init!
db
"stream"
type
(
get-entity-by-unique
db
"stream"
uid
))
(
list
(
start-activity
"review-item"
0
""
))))))
(
if
(
or
(
equal?
type
"group-comp"
)
(
equal?
type
"pup-focal"
))
(
cons
(
mbutton
(
string-append
"review-"
uid
)
(
string-append
type
(
if
time
(
string-append
"-"
time
)
""
))
(
lambda
()
(
set-current!
'review-collection
uid
)
(
entity-init!
db
"stream"
type
(
get-entity-by-unique
db
"stream"
uid
))
(
list
(
start-activity
"review-collection"
0
""
))))
r
)
r
)))
'
()
(
dirty-entities-for-review
db
"stream"
)))))
(
define
(
review-update-collection
parent-uid
)
(
list
(
update-widget
'linear-layout
(
get-id
"review-list"
)
'contents
(
foldl
(
lambda
(
dirty-entity
r
)
;; consists of ((type,uid,dirty,version) (ktvlist))
(
let*
((
data
(
car
dirty-entity
))
(
entity
(
cadr
dirty-entity
))
(
time
(
ktv-get
entity
"time"
))
(
type
(
list-ref
data
0
))
(
uid
(
list-ref
data
1
)))
(
if
(
equal?
(
ktv-get
entity
"parent"
)
parent-uid
)
(
cons
(
mbutton
(
string-append
"review-"
uid
)
(
string-append
type
(
if
time
(
string-append
"-"
time
)
""
))
(
lambda
()
(
entity-init!
db
"stream"
type
(
get-entity-by-unique
db
"stream"
uid
))
(
list
(
start-activity
"review-item"
0
""
))))
r
)
r
)))
'
()
(
dirty-entities-for-review-parent
db
"stream"
parent-uid
)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
...
...
@@ -758,8 +820,135 @@
(
list
(
list
"parent"
"varchar"
"="
(
get-current
'group-composition-id
0
))))))
;; hack
(
define
(
update-selector-colours2-or
id
entity-type
where
)
(
msg
"----------------------------------------------**"
)
(
update-grid-selector-colours
id
"id-mongoose"
(
map
(
lambda
(
i
)
(
msg
"found:"
i
)
(
get-entity
db
"stream"
i
))
(
let
((
s
(
apply
db-select
(
append
(
list
db
(
string-append
"select e.entity_id from stream_entity as e "
;; order by name