diff options
-rw-r--r-- | module/calp/server/webdav.scm | 38 | ||||
-rw-r--r-- | module/calp/webdav/resource/virtual.scm | 3 | ||||
-rw-r--r-- | module/hnh/util/table.scm | 11 | ||||
-rw-r--r-- | module/sxml/namespace.scm | 6 | ||||
-rw-r--r-- | module/vcomponent/data-stores/common.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/duration.scm | 4 |
6 files changed, 61 insertions, 3 deletions
diff --git a/module/calp/server/webdav.scm b/module/calp/server/webdav.scm index 7cbdd32e..3413f254 100644 --- a/module/calp/server/webdav.scm +++ b/module/calp/server/webdav.scm @@ -131,6 +131,7 @@ +;;; Extract the root element from sxml tree (define (root-element sxml) (sxml-match sxml [(*TOP* (*PI* . ,args) ,root) root] @@ -471,15 +472,37 @@ +;;; Log tables are tables for easily adding key value data, +;;; and later formatting them. +;;; They in themself do not actually do any logging. + +;;; The "global" log table (define log-table (make-parameter #f)) + +;;; Initialize the global log table to an empty log table (define (init-log-table!) (log-table '())) + +;;; Takes a list of alternating symbols and values, +;;; Each such pair is added to the log global table (define (log-table-add! . args) (for (key value) in (group args 2) (log-table (acons key value (log-table))))) + +;;; Get the given key from the global key table +;;; or return dflt (default #f) if not found (define* (log-table-get key optional: dflt) (or (assoc-ref (log-table) key) dflt)) +;;; Write data from the global log table to current output port. +;;; Each argument should be one of the following types +;;; string? :: printed verbatim +;;; symbol? :: value looked up in the global log table, +;;; and value printed +;;; pair? :: The car is a symbol to look up per `symbol?' +;;; The cdr is a procedure for foramtting the given +;;; value for output +;;; All other types are ignored. (define (log-table-format . args) (for-each (lambda (arg) (cond ((string? arg) (display arg)) @@ -490,6 +513,21 @@ (else #f))) args)) +;;; Writes a log message to current error port. +;;; This reads values for the log table. +;;; +;;; The following table fields are used +;;; now :: current datetime, as a datetime? +;;; method :: Name of the source method +;;; uri :: URI accessed, an an uri? object +;;; request :: The source request +;;; If the request-method of the request is +;;; 'COPY or 'MOVE then `headers' is checked for a +;;; destination header. +;;; headers :: Request headers, see `request' +;;; response-code :: Response code to emit (e.x. 200) +;;; response-phrase :: Phrase belonging to that code (e.x. "OK") +;;; msg :: Optional freetext message (define (emit-log!) ;; (write (log-table) (current-error-port)) ;; (newline (current-error-port)) diff --git a/module/calp/webdav/resource/virtual.scm b/module/calp/webdav/resource/virtual.scm index 1d2d5d31..42ffc123 100644 --- a/module/calp/webdav/resource/virtual.scm +++ b/module/calp/webdav/resource/virtual.scm @@ -38,7 +38,8 @@ (define-method (live-properties (self <virtual-resource>)) (append (next-method) - (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) (make-live-property isvirtual set-isvirtual!))))) + (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) + (make-live-property isvirtual set-isvirtual!))))) (define-method (content (self <virtual-resource>)) (content* self)) diff --git a/module/hnh/util/table.scm b/module/hnh/util/table.scm index a57e6591..268f1081 100644 --- a/module/hnh/util/table.scm +++ b/module/hnh/util/table.scm @@ -1,8 +1,15 @@ +;;; Commentary: +;;; An immutable key-value table. +;;; +;;; Currently implemented as a simple binary search tree, +;;; this may however change at any time. +;;; Code: + (define-module (hnh util table) :use-module (srfi srfi-1) :use-module (srfi srfi-88) - :use-module (srfi srfi-9) - :use-module (srfi srfi-9 gnu) + ;; :use-module (srfi srfi-9) + ;; :use-module (srfi srfi-9 gnu) :use-module (hnh util lens) :use-module (hnh util object) :export ((make-tree . table) diff --git a/module/sxml/namespace.scm b/module/sxml/namespace.scm index 144d1905..b29de017 100644 --- a/module/sxml/namespace.scm +++ b/module/sxml/namespace.scm @@ -1,3 +1,9 @@ +;;; Commentary: +;;; Module for changing the namespace prefix in sxml symbols. +;;; TODO consider removing this module in favour of (sxml namespaced). +;;; This is a hack, that one works correctly +;;; Code: + (define-module (sxml namespace) :use-module (hnh util) :use-module (sxml transform) diff --git a/module/vcomponent/data-stores/common.scm b/module/vcomponent/data-stores/common.scm index 2fb4422a..f9dee506 100644 --- a/module/vcomponent/data-stores/common.scm +++ b/module/vcomponent/data-stores/common.scm @@ -6,6 +6,8 @@ get-all get-by-uid)) +;;; This should NOT inherit from WebDAV <resource>. +;;; Instead, CalDAV resources should hold a reference to a calendar data store. (define-class <calendar-data-store> () ;; (path init-keyword: path: diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm index 449645fc..83f3d6e7 100644 --- a/module/vcomponent/duration.scm +++ b/module/vcomponent/duration.scm @@ -11,6 +11,10 @@ format-duration )) +;;; TODO Write tests for this + +;;; TODO replace record type + (define-immutable-record-type <duration> (make-duration sign week day dur-time) duration? |