Commit f0d91e62 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

sorted out the sql - added delete/death

parent 9715bc33
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" <manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.mongoose" package="foam.mongoose"
android:versionCode="9" android:versionCode="10"
android:versionName="1.0"> android:versionName="1.0">
<application android:label="@string/app_name" <application android:label="@string/app_name"
android:icon="@drawable/logo" android:icon="@drawable/logo"
......
...@@ -215,10 +215,12 @@ ...@@ -215,10 +215,12 @@
(define (all-entities db table type) (define (all-entities db table type)
(let ((s (db-select (let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e " db (string-append
"join " table "_value_varchar " "select e.entity_id from " table "_entity as e "
" as n on n.entity_id = e.entity_id " "join " table "_value_varchar "
"where entity_type = ? and n.attribute_id = ? order by n.value") "as n on n.entity_id = e.entity_id "
"where entity_type = ? and n.attribute_id = ? "
"order by substr(n.value,3)")
type "name"))) type "name")))
(msg (db-status db)) (msg (db-status db))
(if (null? s) (if (null? s)
...@@ -228,17 +230,39 @@ ...@@ -228,17 +230,39 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (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) (define (all-entities-where db table type ktv)
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv) " "
" as a on a.entity_id = e.entity_id " "as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ? "
"join " table "_value_varchar " "join " table "_value_varchar "
" as n on n.entity_id = e.entity_id " "as n on n.entity_id = e.entity_id and n.attribute_id = ? "
"where e.entity_type = ? and a.attribute_id = ? " "left join " table "_value_int "
"and a.value = ? and n.attribute_id = ? order by n.value") "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
type (ktv-key ktv) (ktv-value ktv) "name"))) "where e.entity_type = ? and (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)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -251,12 +275,19 @@ ...@@ -251,12 +275,19 @@
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv) " "
" as a on a.entity_id = e.entity_id " "as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ? "
"join " table "_value_" (ktv-type ktv2) "join " table "_value_" (ktv-type ktv2) " "
" as b on b.entity_id = e.entity_id " "as b on b.entity_id = e.entity_id and b.attribute_id = ? and b.value = ? "
"where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ") "join " table "_value_varchar "
type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2)))) "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 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)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -269,12 +300,19 @@ ...@@ -269,12 +300,19 @@
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv) " "
" as a on a.entity_id = e.entity_id " "as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ? "
"join " table "_value_" (ktv-type ktv2) "join " table "_value_" (ktv-type ktv2) " "
" as b on b.entity_id = e.entity_id " "as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value = ? or b.value = ?) "
"where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and (b.value = ? or b.value = ?) ") "join " table "_value_varchar "
type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2) or-value))) "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 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)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -287,15 +325,19 @@ ...@@ -287,15 +325,19 @@
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv) " "
" as a on a.entity_id = e.entity_id " "as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ?"
"join " table "_value_" (ktv-type ktv2) "join " table "_value_" (ktv-type ktv2) " "
" as b on b.entity_id = e.entity_id " "as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?) "
"where e.entity_type = ? " "join " table "_value_varchar "
"and a.attribute_id = ? and a.value = ? " "as n on n.entity_id = e.entity_id and n.attribute_id = ? "
"and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?)" "left join " table "_value_int "
) "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown"))) "where e.entity_type = ? and (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)) (msg "date select" (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -308,15 +350,19 @@ ...@@ -308,15 +350,19 @@
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv) " "
" as a on a.entity_id = e.entity_id " "as a on a.entity_id = e.entity_id and a.attribute_id = ? and a.value = ?"
"join " table "_value_" (ktv-type ktv2) "join " table "_value_" (ktv-type ktv2) " "
" as b on b.entity_id = e.entity_id " "as b on b.entity_id = e.entity_id and b.attribute_id = ? and (b.value < DateTime(?) and b.value != ?) "
"where e.entity_type = ? " "join " table "_value_varchar "
"and a.attribute_id = ? and a.value = ? " "as n on n.entity_id = e.entity_id and n.attribute_id = ? "
"and b.attribute_id = ? and (b.value < DateTime(?) or b.value = ?)" "left join " table "_value_int "
) "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown"))) "where e.entity_type = ? and (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)) (msg "date select" (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -333,8 +379,10 @@ ...@@ -333,8 +379,10 @@
" as a on a.entity_id = e.entity_id " " as a on a.entity_id = e.entity_id "
"join " table "_value_" (ktv-type ktv2) "join " table "_value_" (ktv-type ktv2)
" as b on b.entity_id = e.entity_id " " 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 = ? ") "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)))) type
(ktv-key ktv) (ktv-key ktv2)
(ktv-value ktv) (ktv-value ktv2))))
(msg (db-status db)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -386,6 +434,15 @@ ...@@ -386,6 +434,15 @@
; (prof-end "db-all-where") ; (prof-end "db-all-where")
; r)) ; 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) (define (db-all-where db table type ktv)
(prof-start "db-all-where") (prof-start "db-all-where")
(let ((r (map (let ((r (map
......
...@@ -495,6 +495,12 @@ ...@@ -495,6 +495,12 @@
db "sync" "mongoose" db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id")))) (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))))
(define (db-mongooses-by-pack-ignore-delete)
(db-all-where-ignore-delete
db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))))
(define (db-mongooses-by-pack-male) (define (db-mongooses-by-pack-male)
(db-all-where2or (db-all-where2or
db "sync" "mongoose" db "sync" "mongoose"
...@@ -1751,7 +1757,7 @@ ...@@ -1751,7 +1757,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"manage-individuals-list" "button" "manage-individuals-list" "button"
(db-mongooses-by-pack) #f (db-mongooses-by-pack-ignore-delete) #f
(lambda (individual) (lambda (individual)
(set-current! 'individual individual) (set-current! 'individual individual)
(list (start-activity "update-individual" 2 "")))) (list (start-activity "update-individual" 2 ""))))
...@@ -1867,8 +1873,14 @@ ...@@ -1867,8 +1873,14 @@
(lambda (v) (entity-add-value! "chip-code" "varchar" v) '())) (lambda (v) (entity-add-value! "chip-code" "varchar" v) '()))
(spacer 10) (spacer 10)
(horiz (horiz
(mbutton2 "update-individual-delete" "Delete" (lambda () (list (finish-activity 2)))) (mtoggle-button2 "update-individual-delete" "Delete"
(mbutton2 "update-individual-died" "Died" (lambda () (list (finish-activity 2))))) (lambda (v)
(entity-add-value! "deleted" "int" (if v 1 0))
(list)))
(mtoggle-button2 "update-individual-died" "Died"
(lambda (v)
(entity-add-value! "deleted" "int" (if v 2 0))
(list))))
(horiz (horiz
(mbutton2 "update-individual-cancel" "Cancel" (mbutton2 "update-individual-cancel" "Cancel"
(lambda () (entity-reset!) (list (finish-activity 2)))) (lambda () (entity-reset!) (list (finish-activity 2))))
...@@ -1883,6 +1895,7 @@ ...@@ -1883,6 +1895,7 @@
(entity-reset!) (entity-reset!)
(entity-set! (get-current 'individual '())) (entity-set! (get-current 'individual '()))
(let ((individual (get-current 'individual '()))) (let ((individual (get-current 'individual '())))
(msg "deleted = " (ktv-get individual "deleted"))
(list (list
(update-widget 'edit-text (get-id "update-individual-name") 'text (update-widget 'edit-text (get-id "update-individual-name") 'text
(ktv-get individual "name")) (ktv-get individual "name"))
...@@ -1896,9 +1909,13 @@ ...@@ -1896,9 +1909,13 @@
(update-widget 'edit-text (get-id "update-individual-litter-code") 'text (update-widget 'edit-text (get-id "update-individual-litter-code") 'text
(ktv-get individual "litter-code")) (ktv-get individual "litter-code"))
(update-widget 'edit-text (get-id "update-individual-chip-code") 'text (update-widget 'edit-text (get-id "update-individual-chip-code") 'text
(ktv-get individual "chip-code"))) (ktv-get individual "chip-code"))
)) (update-widget 'toggle-button (get-id "update-individual-delete") 'checked
(if (eqv? (ktv-get individual "deleted") 1) 1 0))
(update-widget 'toggle-button (get-id "update-individual-died") 'checked
(if (eqv? (ktv-get individual "deleted") 2) 1 0))
)))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment