1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
(define-module (calp webdav property)
:use-module (sxml namespaced)
:use-module (web http status-codes)
:use-module ((srfi srfi-1) :select (concatenate find))
:use-module (srfi srfi-9)
:use-module (srfi srfi-71)
:use-module (srfi srfi-88)
:use-module (hnh util)
:use-module (calp namespaces)
:export (make-propstat
propstat?
propstat-status-code
propstat-property
propstat-error
propstat-response-description
propstat
merge-propstats
propstat-200?
;; propstat->sxml
propstat->namespaced-sxml
))
;;; Commentary:
;;; Code:
;; Maps directly to [WEBDAV]'s propstat objects. This is just a simpler interface in the code.
(define-record-type <propstat>
(make-propstat status prop error responsedescription)
propstat?
;; An http status code indicating if this property is present
(status propstat-status-code)
;; A list of namespaced sxml elements, such that they could all be
;; directly inserted as the children of <DAV::prop/>
;; @example
;; `((,(xml ns tag) "Content"))
;; @end example
(prop propstat-property)
;; See [WEBCAL] propstat XML element
(error propstat-error)
(responsedescription propstat-response-description))
(define* (propstat code prop key: error responsedescription)
(make-propstat code prop error responsedescription))
;; Query a given dead property from the given resource
;; property should be a xml-element item
;; (define (propfind-selected-property resource property)
;; (cond ((get-dead-property resource property)
;; => (lambda (it) (propstat 200 (list it))))
;; (else (propstat 404 (list (list property))))))
;; Takes a list of <propstat> items, finds all where status, error, and
;; responsedescription are all equal, and merges the prop tags of all those.
;; Returns a new list of <propstat> items
(define (merge-propstats propstats)
(map (lambda (group)
(define-values (code error desc) (unlist (car group)))
(make-propstat code
(concatenate
(map propstat-property (cdr group)))
error desc))
(group-by (lambda (propstat)
(list (propstat-status-code propstat)
(propstat-error propstat )
(propstat-response-description propstat)))
propstats)))
(define (propstat-200? prop)
(= 200 (propstat-status-code prop)))
;; (define (propstat->sxml propstat)
;; `(d:propstat (d:prop ,(propstat-property propstat))
;; (d:status ,(http-status-line (propstat-status-code propstat)))
;; ,@(awhen (propstat-error propstat)
;; `((d:error ,it)))
;; ,@(awhen (propstat-response-description propstat)
;; `((d:responsedescription ,it)))))
(define (propstat->namespaced-sxml propstat)
`(,(xml webdav 'propstat)
(,(xml webdav 'prop) ,@(propstat-property propstat))
(,(xml webdav 'status) ,(http-status-line (propstat-status-code propstat)))
,@(awhen (propstat-error propstat)
`((,(xml webdav 'error) ,it)))
,@(awhen (propstat-response-description propstat)
`((,(xml webdav 'responsedescription) ,it)))))
|