Commit 5a41e3df authored by Dave Griffiths's avatar Dave Griffiths
Browse files

getting ready for testing

parent abb6c9a5
......@@ -819,8 +819,7 @@
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
;; exporting human editable reports
(define (deref-entity entity)
(foldl
......@@ -846,46 +845,56 @@
entity))
(define (csv-convert col)
(if (number? col) (number->string col)
(if (string? col) col
(begin
(msg "csvify found:" col) "oops"))))
;; convert list of lists into comma seperated columns
;; and newline seperated rows
(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"))
(let ((row-text
(foldl
(lambda (col r)
(let ((converted (csv-convert col)))
(if (equal? r "")
converted
(string-append r ", " converted))))
"" row)))
(msg row-text)
(dbg (string-append r row-text "\n"))))
"" l))
;; meant to be general, but made for pup focal reports
(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))))
(cons
'("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
(sort
(foldl
(lambda (entity-type r)
(append
r (map
(lambda (entity)
(append
(list
(ktv-get entity "time")
(ktv-get entity "user")
(ktv-get pack "name")
(ktv-get focal "name")
entity-type)
(deref-entity
(ktv-filter-many
entity (list "user" "unique_id" "parent" "time")))))
(db-all-with-parent
db table entity-type
(ktv-get parent-entity "unique_id")))))
'()
entity-types)
(lambda (a b)
(string<? (car a) (car b))))))))
......@@ -363,6 +363,13 @@
(else (split-by-charset str charset maxsplit))))))
)
;; save text to the sdcard (for csv etc)
(define (save-data filename d)
(let ((f (open-output-file (string-append dirname filename))))
(display d f)
(close-output-port f))
d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; convert scheme values into equivilent json strings
......
......@@ -2068,9 +2068,12 @@
(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))
'())))
(save-data "pup-focal-export.csv" (export-csv main-db "stream" f pup-focal-export))
(list
(send-mail
""
"From Mongoose2000" "Please find attached your mongoose data"
(list "/sdcard/mongoose/pup-focal-export.csv"))))))
(db-all-in-date-range
main-db "stream" "pup-focal"
(get-current 'from-date (date->string (date-minus-months (date-time) 6)))
......@@ -2115,6 +2118,7 @@
(activity-layout activity))
(lambda (activity arg)
;; open the main database
(db-close main-db)
(db-open main-db)
(msg "opened main database")
(msg (db-status db))
......
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