Commit bdbc3d86 authored by dave griffiths's avatar dave griffiths
Browse files

rpi changes

parent df7416c2
...@@ -116,7 +116,7 @@ ...@@ -116,7 +116,7 @@
;; exporting human editable reports ;; exporting human editable reports
(define (deref-entity entity) (define (deref-entity db entity)
(foldl (foldl
(lambda (ktv r) (lambda (ktv r)
(append (append
...@@ -163,34 +163,48 @@ ...@@ -163,34 +163,48 @@
(dbg (string-append r row-text "\n")))) (dbg (string-append r row-text "\n"))))
"" l)) "" l))
(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))
;; meant to be general, but made for pup focal reports ;; meant to be general, but made for pup focal reports
(define (export-csv db table parent-entity entity-types) ;(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")))) ; (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"))))) ; (pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
(csvify ; (csvify
(cons ; (cons
'("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value") ; '("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
(sort ; (sort
(foldl ; (foldl
(lambda (entity-type r) ; (lambda (entity-type r)
(append ; (append
r (map ; r (map
(lambda (entity) ; (lambda (entity)
(append ; (append
(list ; (list
(ktv-get entity "time") ; (ktv-get entity "time")
(ktv-get entity "user") ; (ktv-get entity "user")
(ktv-get pack "name") ; (ktv-get pack "name")
(ktv-get focal "name") ; (ktv-get focal "name")
entity-type) ; entity-type)
(deref-entity ; (deref-entity
(ktv-filter-many ; db (ktv-filter-many
entity (list "user" "unique_id" "parent" "time"))))) ; entity (list "user" "unique_id" "parent" "time")))))
(db-all-with-parent ; (db-all-with-parent
db table entity-type ; db table entity-type
(ktv-get parent-entity "unique_id"))))) ; (ktv-get parent-entity "unique_id")))))
'() ; '()
entity-types) ; entity-types)
(lambda (a b) ; (lambda (a b)
(string<? (car a) (car b)))))))) ; (string<? (car a) (car b))))))))
...@@ -51,24 +51,26 @@ ...@@ -51,24 +51,26 @@
(define sema (make-semaphore 1)) (define sema (make-semaphore 1))
(define (syncro-try fn)
(msg "s-start")
(if (semaphore-try-wait? sema)
(let ((r (fn)))
(msg "s-end")
(semaphore-post sema)
r)
(begin
(msg "couldn't get lock")
(pluto-response (scheme->txt '("fail"))))))
(define (syncro fn) (define (syncro fn)
(msg "s-start") (fn))
(semaphore-wait sema)
(let ((r (fn))) ; (msg "s-start")
(msg "s-end") ; (if (semaphore-try-wait? sema)
(semaphore-post sema) ; (let ((r (fn)))
r)) ; (msg "s-end")
; (semaphore-post sema)
; r)
; (begin
; (msg "couldn't get lock")
; (pluto-response (scheme->txt '("fail"))))))
(define (syncro-new fn)
(msg "s-start")
(semaphore-wait sema)
(let ((r (fn)))
(msg "s-end")
(semaphore-post sema)
r))
(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