Commit 5948d67f authored by dave griffiths's avatar dave griffiths
Browse files

fixed data export

parent a527726e
...@@ -68,6 +68,13 @@ ...@@ -68,6 +68,13 @@
(msg "unsupported ktv type in ktv-eq?: " (ktv-type a)) (msg "unsupported ktv type in ktv-eq?: " (ktv-type a))
#f)))) #f))))
(define (null-value-for-type type)
(cond
((equal? type "varchar") "not set")
((equal? type "int") 0)
((equal? type "real") 0)
((equal? type "file") "not set")))
;; stringify based on type (for url) ;; stringify based on type (for url)
(define (stringify-value ktv) (define (stringify-value ktv)
(cond (cond
...@@ -255,20 +262,24 @@ ...@@ -255,20 +262,24 @@
(vector-ref (cadr s) 1) (vector-ref (cadr s) 1)
(vector-ref (cadr s) 2))))) (vector-ref (cadr s) 2)))))
;; get an entire entity, as a list of key/value pairs ;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id) (define (get-entity-plain db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id))) (let* ((entity-type (get-entity-type db table entity-id)))
(cond (cond
((null? entity-type) (msg "entity" entity-id "not found!") '()) ((null? entity-type) (msg "entity" entity-id "not found!") '())
(else (else
(map (foldl
(lambda (kt) (lambda (kt r)
(let ((vdv (get-value db table entity-id kt))) (let ((vdv (get-value db table entity-id kt)))
(if (null? vdv) (if (null? vdv)
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt)) (begin
(list (ktv-key kt) (ktv-type kt) (msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
(list-ref vdv 0) (list-ref vdv 2))))) (cons (list (ktv-key kt) (ktv-type kt) (null-value-for-type (ktv-type kt))) r))
(get-attribute-ids/types db table entity-type)))))) (cons (list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)) r))))
'()
(reverse (get-attribute-ids/types db table entity-type)))))))
;; get an entire entity, as a list of key/value pairs, only dirty values ;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id) (define (get-entity-plain-for-sync db table entity-id)
...@@ -685,7 +696,7 @@ ...@@ -685,7 +696,7 @@
(lambda (kt r) (lambda (kt r)
(if (equal? r "") (string-append "\"" (ktv-key kt) "\"") (if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
(string-append r ", \"" (ktv-key kt) "\""))) (string-append r ", \"" (ktv-key kt) "\"")))
"id, " "id "
(get-attribute-ids/types db table entity-type))) (get-attribute-ids/types db table entity-type)))
(define (csv db table entity-type) (define (csv db table entity-type)
...@@ -700,7 +711,7 @@ ...@@ -700,7 +711,7 @@
((equal? (ktv-key ktv) "unique_id") r) ((equal? (ktv-key ktv) "unique_id") r)
((null? (ktv-value ktv)) ((null? (ktv-value ktv))
(msg "value not found in csv for " (ktv-key ktv)) (msg "value not found in csv for " (ktv-key ktv))
r) (string-append r ", NULL"))
;; dereferences lists of ids ;; dereferences lists of ids
((and ((and
(> (string-length (ktv-key ktv)) 8) (> (string-length (ktv-key ktv)) 8)
...@@ -709,8 +720,12 @@ ...@@ -709,8 +720,12 @@
;; look for unique ids and dereference them ;; look for unique ids and dereference them
((and ((and
(> (string-length (ktv-key ktv)) 3) (> (string-length (ktv-key ktv)) 3)
(equal? (substring (ktv-key ktv) 0 3) "id-")) (equal? (substring (ktv-key ktv) 0 3) "id-")
(string-append r ", \"" (get-entity-name db "sync" (ktv-value ktv)) "\"")) (not (equal? (ktv-value ktv) "none")))
(let ((name (get-entity-name db "sync" (ktv-value ktv))))
(if (null? name)
"\"nobody\""
(string-append r ", \"" name "\""))))
(else (else
(string-append r ", \"" (stringify-value-url ktv) "\"")))) (string-append r ", \"" (stringify-value-url ktv) "\""))))
(vector-ref res 1) ;; unique_id (vector-ref res 1) ;; unique_id
......
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
; "scripts/input.ss" ; "scripts/input.ss"
) )
; a utility to change the process owner, ; a utility to change the process owner,
; assuming mzscheme is called by root. ; assuming mzscheme is called by root.
;;(unsafe!) ;;(unsafe!)
...@@ -43,6 +44,9 @@ ...@@ -43,6 +44,9 @@
;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv") ;(write-db db "sync" "/home/dave/code/mongoose-web/web/input.csv")
(msg (csv db "sync" "individual"))
(define registered-requests (define registered-requests
(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