Commit 1d51edcc authored by Dave Griffiths's avatar Dave Griffiths
Browse files

added adult filtering, clearing entities between dialogs, cancel buttons added

parent aedc8c6b
...@@ -286,6 +286,28 @@ ...@@ -286,6 +286,28 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (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 "
"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(?)"
)
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2))))
(msg "date select" (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (validate db) (define (validate db)
;; check attribute for duplicate entity-id/attribute-ids ;; check attribute for duplicate entity-id/attribute-ids
0) 0)
...@@ -365,6 +387,15 @@ ...@@ -365,6 +387,15 @@
(prof-end "db-all-where newer") (prof-end "db-all-where newer")
r)) 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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
......
...@@ -136,11 +136,11 @@ ...@@ -136,11 +136,11 @@
(define (entity-set! ktv-list) (define (entity-set! ktv-list)
(set-current! 'entity-values ktv-list)) (set-current! 'entity-values ktv-list))
(define (dt->string dt) (define (date-time->string dt)
(string-append (string-append
(number->string (list-ref dt 0)) "-" (number->string (list-ref dt 0)) "-"
(number->string (list-ref dt 1)) "-" (number->string (list-ref dt 1)) "-"
(number->string (list-ref dt 2)) "T" (number->string (list-ref dt 2)) " "
(number->string (list-ref dt 3)) ":" (number->string (list-ref dt 3)) ":"
(number->string (list-ref dt 4)) ":" (number->string (list-ref dt 4)) ":"
(substring (number->string (+ 100 (list-ref dt 5))) 1 2))) (substring (number->string (+ 100 (list-ref dt 5))) 1 2)))
...@@ -149,7 +149,7 @@ ...@@ -149,7 +149,7 @@
(define (entity-record-values db table type) (define (entity-record-values db table type)
;; standard bits ;; standard bits
(entity-add-value! "user" "varchar" (get-current 'user-id "none")) (entity-add-value! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value! "time" "varchar" (date->string (date-time))) (entity-add-value! "time" "varchar" (date-time->string (date-time)))
(entity-add-value! "lat" "real" 0) (entity-add-value! "lat" "real" 0)
(entity-add-value! "lon" "real" 0) (entity-add-value! "lon" "real" 0)
(let ((values (get-current 'entity-values '()))) (let ((values (get-current 'entity-values '())))
...@@ -472,6 +472,12 @@ ...@@ -472,6 +472,12 @@
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id")) (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6))))) (ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
(define (db-mongooses-by-pack-adults)
(db-all-older
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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
...@@ -584,18 +590,20 @@ ...@@ -584,18 +590,20 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(entity-add-value! "scan-time" "varchar" (date-time->string (date-time)))
(list (list
(play-sound "ping") (play-sound "ping")
(vibrate 300) (vibrate 300)
(populate-grid-selector (populate-grid-selector
"pf-scan-nearest" "single" "pf-scan-nearest" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack-adults)
(lambda (individual) (lambda (individual)
(entity-add-value! "id-nearest" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-nearest" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
(populate-grid-selector (populate-grid-selector
"pf-scan-close" "toggle" "pf-scan-close" "toggle"
(db-mongooses-by-pack) (db-mongooses-by-pack-adults)
(lambda (individuals) (lambda (individuals)
(entity-add-value! "id-list-close" "varchar" (assemble-array individuals)) (entity-add-value! "id-list-close" "varchar" (assemble-array individuals))
(list))) (list)))
...@@ -622,15 +630,19 @@ ...@@ -622,15 +630,19 @@
(lambda () (lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupfeed") (entity-record-values db "stream" "pup-focal-pupfeed")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfeed-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events"))))))) (list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupfeed-who" "single" "pf-pupfeed-who" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack-adults)
(lambda (individual) (lambda (individual)
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
...@@ -647,18 +659,22 @@ ...@@ -647,18 +659,22 @@
(list (list
(mtitle "title" "Event: Pup found food") (mtitle "title" "Event: Pup found food")
(mtext "text" "Food size") (mtext "text" "Food size")
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap
(lambda (v) (entity-add-value! "size" "varchar" v) '()))
(horiz (horiz
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap
(lambda (v) (entity-add-value! "size" "varchar" v) '()))
(mbutton "pf-pupfind-done" "Done" (mbutton "pf-pupfind-done" "Done"
(lambda () (lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupfind") (entity-record-values db "stream" "pup-focal-pupfind")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfind-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events"))))))) (list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
)) ))
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -683,15 +699,19 @@ ...@@ -683,15 +699,19 @@
(lambda () (lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupcare") (entity-record-values db "stream" "pup-focal-pupcare")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupcare-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events"))))))) (list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupcare-who" "single" "pf-pupcare-who" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack-adults)
(lambda (individual) (lambda (individual)
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
...@@ -728,15 +748,21 @@ ...@@ -728,15 +748,21 @@
(mtoggle-button "pf-pupaggr-win" "Win?" (mtoggle-button "pf-pupaggr-win" "Win?"
(lambda (v) (lambda (v)
(entity-add-value! "win" "varchar" (if v "yes" "no")) '())))) (entity-add-value! "win" "varchar" (if v "yes" "no")) '()))))
(mbutton "pf-pupaggr-done" "Done" (horiz
(lambda () (mbutton "pf-pupaggr-done" "Done"
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id "")) (lambda ()
(entity-record-values db "stream" "pup-focal-pupaggr") (entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(list (replace-fragment (get-id "event-holder") "events")))))) (entity-record-values db "stream" "pup-focal-pupaggr")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupaggr-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupaggr-partner" "single" "pf-pupaggr-partner" "single"
...@@ -775,11 +801,16 @@ ...@@ -775,11 +801,16 @@
(mbutton "pf-grpint-done" "Done" (mbutton "pf-grpint-done" "Done"
(lambda () (lambda ()
(entity-record-values db "stream" "group-interaction") (entity-record-values db "stream" "group-interaction")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpint-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))) (list (replace-fragment (get-id "event-holder") "events"))))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"gp-int-pack" "single" "gp-int-pack" "single"
...@@ -816,14 +847,19 @@ ...@@ -816,14 +847,19 @@
(lambda (v) (lambda (v)
(entity-add-value! "others-join" "varchar" (entity-add-value! "others-join" "varchar"
(if v "yes" "no")) '()))) (if v "yes" "no")) '())))
(mbutton "pf-grpalarm-done" "Done" (horiz
(lambda () (mbutton "pf-grpalarm-done" "Done"
(entity-record-values db "stream" "group-alarm") (lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))) (entity-record-values db "stream" "group-alarm")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"gp-alarm-caller" "single" "gp-alarm-caller" "single"
...@@ -854,20 +890,25 @@ ...@@ -854,20 +890,25 @@
(medit-text "gp-mov-c" "How many mongooses?" "numeric" (medit-text "gp-mov-c" "How many mongooses?" "numeric"
(lambda (v) (entity-add-value! "pack-count" "int" (string->number v)) '())))) (lambda (v) (entity-add-value! "pack-count" "int" (string->number v)) '()))))
(linear-layout (linear-layout
(make-id "") 'horizontal (layout 'fill-parent 90 '1 'left 0) trans-col (make-id "") 'horizontal (layout 'fill-parent 'wrap-content '1 'left 0) trans-col
(list (list
(vert (vert
(mtext "" "Where to") (mtext "" "Where to")
(spinner (make-id "gp-mov-to") (list "Latrine" "Water" "Food" "Nothing" "Den" "Unknown") fillwrap (spinner (make-id "gp-mov-to") (list "Latrine" "Water" "Food" "Nothing" "Den" "Unknown") fillwrap
(lambda (v) (entity-add-value! "destination" "varchar" v) '()))) (lambda (v) (entity-add-value! "destination" "varchar" v) '())))
(mbutton "pf-grpmov-done" "Done" (horiz
(lambda () (mbutton "pf-grpmov-done" "Done"
(entity-record-values db "stream" "group-move") (lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))) (entity-record-values db "stream" "group-move")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"gp-mov-leader" "single" "gp-mov-leader" "single"
...@@ -903,7 +944,9 @@ ...@@ -903,7 +944,9 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (list)) (lambda (fragment arg)
(entity-reset!)
(list))
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -1005,12 +1048,12 @@ ...@@ -1005,12 +1048,12 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-pup-choose" "toggle" "gc-pup-choose" "toggle"
(db-mongooses-by-pack) (db-mongooses-by-pack-pups)
(lambda (individual) (lambda (individual)
(list))) (list)))
(populate-grid-selector (populate-grid-selector
"gc-pup-escort" "toggle" "gc-pup-escort" "toggle"
(db-mongooses-by-pack) (db-mongooses-by-pack-adults)
(lambda (individual) (lambda (individual)
(list))) (list)))
)) ))
...@@ -1271,6 +1314,7 @@ ...@@ -1271,6 +1314,7 @@
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!)
(list (list
(populate-grid-selector (populate-grid-selector
"pf1-grid" "single" "pf1-grid" "single"
...@@ -1394,7 +1438,9 @@ ...@@ -1394,7 +1438,9 @@
) )
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (list)) (lambda (activity arg)
(entity-reset!)
(list))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -1471,6 +1517,7 @@ ...@@ -1471,6 +1517,7 @@
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!)
;; make sure all fields exist ;; make sure all fields exist
(entity-add-value! "name" "varchar" "noname") (entity-add-value! "name" "varchar" "noname")
(entity-add-value! "gender" "varchar" "Female") (entity-add-value! "gender" "varchar" "Female")
...@@ -1533,6 +1580,7 @@ ...@@ -1533,6 +1580,7 @@
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!)
(entity-set! (get-current 'individual '())) (entity-set! (get-current 'individual '()))
(let ((individual (get-current 'individual '()))) (let ((individual (get-current 'individual '())))
(list (list
......
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