Skip to content

GitLab

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

sorted out the sql - added delete/death

parent 9715bc33
Show whitespace changes
Inline Side-by-side
Showing with 122 additions and 48 deletions
android/AndroidManifest.xml
View file @ f0d91e62
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.mongoose"
android:versionCode="9"
android:versionCode="10"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
......
android/assets/eavdb.scm
View file @ f0d91e62
......@@ -215,10 +215,12 @@
(define (all-entities db table type)
(let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e "
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")
"as n on n.entity_id = e.entity_id "
"where entity_type = ? and n.attribute_id = ? "
"order by substr(n.value,3)")
type "name")))
(msg (db-status db))
(if (null? s)
......@@ -228,17 +230,39 @@
(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 "
"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 "
"where e.entity_type = ? and a.attribute_id = ? "
"and a.value = ? and n.attribute_id = ? order by n.value")
type (ktv-key ktv) (ktv-value ktv) "name")))
"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)
"name" "deleted" type)))
(msg (db-status db))
(if (null? s)
'()
......@@ -251,12 +275,19 @@
(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))))
"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 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)
'()
......@@ -269,12 +300,19 @@
(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 = ? or b.value = ?) ")
type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2) or-value)))
"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 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)
'()
......@@ -287,15 +325,19 @@
(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 a.value = ? "
"and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?)"
)
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
"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 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)
'()
......@@ -308,15 +350,19 @@
(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 a.value = ? "
"and b.attribute_id = ? and (b.value < DateTime(?) or b.value = ?)"
)
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
"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 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)
'()
......@@ -333,8 +379,10 @@
" 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))))
"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)
'()
......@@ -386,6 +434,15 @@
; (prof-end "db-all-where")
; 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
......
android/assets/starwisp.scm
View file @ f0d91e62
......@@ -495,6 +495,12 @@
db "sync" "mongoose"
(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)
(db-all-where2or
db "sync" "mongoose"
......@@ -1751,7 +1757,7 @@
(list
(populate-grid-selector
"manage-individuals-list" "button"
(db-mongooses-by-pack) #f
(db-mongooses-by-pack-ignore-delete) #f
(lambda (individual)
(set-current! 'individual individual)
(list (start-activity "update-individual" 2 ""))))
......@@ -1867,8 +1873,14 @@
(lambda (v) (entity-add-value! "chip-code" "varchar" v) '()))
(spacer 10)
(horiz
(mbutton2 "update-individual-delete" "Delete" (lambda () (list (finish-activity 2))))
(mbutton2 "update-individual-died" "Died" (lambda () (list (finish-activity 2)))))
(mtoggle-button2 "update-individual-delete" "Delete"
(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
(mbutton2 "update-individual-cancel" "Cancel"
(lambda () (entity-reset!) (list (finish-activity 2))))
......@@ -1883,6 +1895,7 @@
(entity-reset!)
(entity-set! (get-current 'individual '()))
(let ((individual (get-current 'individual '())))
(msg "deleted = " (ktv-get individual "deleted"))
(list
(update-widget 'edit-text (get-id "update-individual-name") 'text
(ktv-get individual "name"))
......@@ -1896,9 +1909,13 @@
(update-widget 'edit-text (get-id "update-individual-litter-code") 'text
(ktv-get individual "litter-code"))
(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) '())
......
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