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

adding export activity and fixed time representation error

parent 45dc469f
......@@ -31,6 +31,7 @@
<activity android:name="UpdateIndividualActivity" android:configChanges="orientation"></activity>
<activity android:name="TagLocationActivity" android:configChanges="orientation"></activity>
<activity android:name="SyncActivity" android:configChanges="orientation"></activity>
<activity android:name="ExportActivity" android:configChanges="orientation"></activity>
</application>
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE" />
......
......@@ -230,6 +230,44 @@
(vector-ref i 0))
(cdr s)))))
(define (all-entities-with-parent db table type parent)
(let ((s (db-select
db (string-append
"select e.entity_id from " table "_entity as e "
"join " table "_value_varchar "
"as p on p.entity_id = e.entity_id "
"where entity_type = ? and p.attribute_id = ? "
"and p.value = ?")
type "parent" parent)))
(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 (all-entities db table type)
(let ((s (db-select
db (string-append
......@@ -433,6 +471,20 @@
(cons ktv (cdr ktv-list)))
(else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))
(define (ktv-filter ktv-list key)
(filter
(lambda (ktv)
(not (equal? (ktv-key ktv) key)))
ktv-list))
(define (ktv-filter-many ktv-list key-list)
(foldl
(lambda (key r)
(ktv-filter r key))
ktv-list
key-list))
;; todo, sort these out...
(define (db-all-sort-normal db table type)
(prof-start "db-all")
......@@ -443,6 +495,16 @@
(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 db table type)
(prof-start "db-all")
(let ((r (map
......@@ -452,6 +514,15 @@
(prof-end "db-all")
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))
;(define (db-all-where db table type clause)
; (prof-start "db-all-where")
; (let ((r (foldl
......@@ -747,3 +818,74 @@
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
(define (deref-entity entity)
(foldl
(lambda (ktv r)
(append
r
(list
(ktv-key ktv)
(cond
;; dereferences lists of ids
((and
(> (string-length (ktv-key ktv)) 8)
(equal? (substring (ktv-key ktv) 0 8) "id-list-"))
(get-entity-names db "sync" (string-split (ktv-value ktv) '(#\,))))
;; look for unique ids and dereference them
((and
(> (string-length (ktv-key ktv)) 3)
(equal? (substring (ktv-key ktv) 0 3) "id-"))
(get-entity-name db "sync" (ktv-value ktv)))
(else
(ktv-value ktv))))))
'()
entity))
(define (csvify l)
(foldl
(lambda (row r)
(string-append
(foldl
(lambda (col r)
(string-append
r ", "
(if (number? col) (number->string col)
(if (string? col) col
(begin
(msg "csvify found:" col) "oops")))))
r
row) "\n"))
"" l))
(define (export-csv db table parent-entity entity-types)
(let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
(pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
(csvify
(foldl
(lambda (entity-type r)
(append
r
(map
(lambda (entity)
(append
(list
(ktv-get entity "time")
(ktv-get pack "name")
(ktv-get focal "name")
entity-type)
(deref-entity
(ktv-filter-many
entity (list "unique_id" "parent" "time")))))
(db-all-with-parent
db table entity-type
(ktv-get parent-entity "unique_id")))))
'()
entity-types))))
......@@ -32,6 +32,15 @@
"group-alarm"
"group-move"))
(define pup-focal-export
(list
"pup-focal-nearest"
"pup-focal-pupfeed"
"pup-focal-pupfind"
"pup-focal-pupcare"
"pup-focal-pupaggr"))
;; colours
(define pf-col (list 255 204 51 255))
......@@ -72,6 +81,7 @@
;; persistent database
(define db "/sdcard/mongoose/local-mongoose.db")
(define main-db "/sdcard/mongoose/mongoose.db")
(define (setup-database!)
(msg "setting up database")
......@@ -143,11 +153,11 @@
(define (date-time->string dt)
(string-append
(number->string (list-ref dt 0)) "-"
(number->string (list-ref dt 1)) "-"
(number->string (list-ref dt 2)) " "
(number->string (list-ref dt 3)) ":"
(number->string (list-ref dt 4)) ":"
(substring (number->string (+ 100 (list-ref dt 5))) 1 2)))
(substring (number->string (+ (list-ref dt 1) 100)) 1 3) "-"
(substring (number->string (+ (list-ref dt 2) 100)) 1 3) " "
(substring (number->string (+ (list-ref dt 3) 100)) 1 3) ":"
(substring (number->string (+ (list-ref dt 4) 100)) 1 3) ":"
(substring (number->string (+ (list-ref dt 5) 100)) 1 3)))
;; build entity from all ktvs, insert to db, return unique_id
(define (entity-record-values db table type)
......@@ -2006,6 +2016,9 @@
(lambda (e)
(string-append "/sdcard/mongoose/" e ".csv"))
entity-types))))))
(mbutton2 "sync-export2" "Export"
(lambda ()
(list (start-activity "export" 0 ""))))
(mbutton2 "sync-export" "Email local data"
(lambda ()
(debug! "Sending mail")
......@@ -2044,4 +2057,80 @@
(lambda (activity) '())
(lambda (activity requestcode resultcode) '()))
(let ((update-list
(lambda ()
(list
(update-widget
'linear-layout (get-id "focal-list") 'contents
(map
(lambda (f)
(mbutton
(string-append "export-" (ktv-get f "unique_id"))
(ktv-get f "time")
(lambda ()
(msg (string-append "export-" (ktv-get f "unique_id")))
(msg (export-csv main-db "stream" f pup-focal-export))
'())))
(db-all-in-date-range
main-db "stream" "pup-focal"
(get-current 'from-date (date->string (date-minus-months (date-time) 6)))
(get-current 'to-date (date->string (date-time))))))))))
(activity
"export"
(vert
(text-view (make-id "title") "Export" 40 fillwrap)
(text-view (make-id "title") "Date range" 20 fillwrap)
(horiz
(button (make-id "date-from") "From" 30 fillwrap
(lambda ()
(list (date-picker-dialog
"export-from-date"
(lambda (day month year)
(let ((datestring (date->string (list year (+ month 1) day))))
(msg "setting current from to" datestring)
(set-current! 'from-date datestring)
(update-list)))))))
(button (make-id "date-to") "To" 30 fillwrap
(lambda ()
(list (date-picker-dialog
"export-to-date"
(lambda (day month year)
(let ((datestring (date->string (list year (+ month 1) day))))
(msg "setting current to to" datestring)
(set-current! 'to-date datestring)
(update-list))))))))
(text-view (make-id "title") "Focals" 40 fillwrap)
(linear-layout
(make-id "focal-list")
'vertical
(layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0)
(list))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
;; open the main database
(db-open main-db)
(msg "opened main database")
(msg (db-status db))
;;(msg (db-select db "select * from stream_entity where entity_type = 'pup-focal';"))
;;(msg (all-entities-in-date-range
;; db "stream" "pup-focal"
;; (date->string (date-minus-months (date-time) 3))
;; (date->string (date-time))
;; ))
(update-list))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity requestcode resultcode) '())))
)
......@@ -73,6 +73,7 @@ public class starwisp extends StarwispActivity
ActivityManager.RegisterActivity("tag-location",TagLocationActivity.class);
ActivityManager.RegisterActivity("sync",SyncActivity.class);
ActivityManager.RegisterActivity("export",ExportActivity.class);
};
/** Called when the activity is first created. */
......
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