blob: f0ed0fdc9d82ac78f9db83aed90eaa76c1ea7ede (
plain)
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
|
(define-module (vcomponent data-stores vdir)
:use-module (hnh util)
:use-module (oop goops)
:use-module (vcomponent data-stores common)
:use-module (srfi srfi-71)
:use-module ((srfi srfi-88) :select ())
:use-module (hnh util path)
:use-module ((vcomponent formats ical) :select (serialize deserialize))
:use-module ((ice-9 ftw) :select (scandir))
:export ())
(define-class <vdir-data-store> (<calendar-data-store>)
(path getter: path
init-keyword: path:)
(loaded-calendar accessor: loaded-calendar
init-value: #f)
(uid-map accessor: uid-map
init-value: #f)
)
(define (make-vdir-store path)
(make <vdir-data-store> path: path))
(define* (get-attribute path key key: dflt)
(catch 'system-error
(lambda () (call-with-input-file (path-append path key) read-line))
(const dflt)))
(define-method (get-all (this <vdir-data-store>))
(let ((files (scandir (path this) (lambda (item) (string-ci=? "ics" (filename-extension item)))))
(calendar (make-vcomponent 'VCALENDAR)))
(set! (prop calendar 'NAME) (get-attribute (path this) "displayname")
(prop calendar 'COLOR) (get-attribute (path this) "color" "#FFFFFF"))
(for-each (lambda (item) (reparent! calendar item))
(append-map (lambda (file)
(define cal
(call-with-input-file (path-append (path this) file)
deserialize))
(unless (eq? 'VCALENDAR (type cal))
(scm-error 'misc-error "get-all<vdir-data-store>"
"Unexpected top level component. Expected VCALENDAR, got ~a. In file ~s"
(list (type cal) file)))
(for-each (lambda (child)
(set! (prop child '-X-HNH-FILENAME) file))
(children cal))
)
files))
(set! (loaded-calendar this) calendar)
calendar))
(define-method (get-by-uid (this <vdir-data-store>) (uid <string>))
(unless (uid-map this)
(let ((cal
(or (loaded-calendar this)
(get-all this))))
(define ht (make-hash-table))
(for-each (lambda (ev) (hash-set! ht (uid ev) ev))
(children cal))
(set! (uid-map this) ht)))
(hash-ref m uid #f))
(define (wrap-for-output . vcomponents)
(let ((calendar (make-vcomponent 'VCALENDAR)))
(set! (prop calendar 'VERSION) "2.0"
(prop calendar 'PRODID) (prodid)
(prop calendar 'CALSCALE) "GREGORIAN")
(for-each (lambda (vcomponent) (reparent! calendar vcomponent))
vcomponents)
calendar))
(define-method (queue-write (this <vdir-data-store>) vcomponent)
;; TODO Multiple components
(let ((filename
(cond ((prop vcomponent '-X-HNH-FILENAME)
=> identity)
(else
(format #f "~a.ics" (prop vcomponent 'UID))))))
(with-atomic-output-to-file (path-append (path this) filename)
(lambda () (serialize (wrap-for-output vcomponent) (current-output-port))))))
(define-method (flush (this <vdir-data-store>))
(sync))
;; (define (get-in-date-interval ))
|
