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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
;;; Commentary:
;; Code for parsing vdir's and icalendar files.
;; This module handles the finding of files, while
;; (vcomponent formats parse ical) handles reading data from icalendar files.
;;; Code:
(define-module (vcomponent formats vdir parse)
:use-module (srfi srfi-1)
:use-module ((ice-9 hash-table) :select (alist->hash-table))
:use-module ((ice-9 rdelim) :select (read-line))
:use-module ((ice-9 ftw) :select (scandir ftw))
:use-module (hnh util)
:use-module ((hnh util path) :select (path-append))
:use-module (hnh util exceptions)
:use-module (vcomponent base)
:use-module (calp translation)
:use-module (vcomponent formats ical parse)
:export (parse-vdir))
;; All VTIMEZONE's seem to be in "local" time in relation to
;; themselves. Therefore, a simple comparison should work,
;; and then the TZOFFSETTO properties can be subtd.
(define (parse-vdir path)
;; TODO empty files here cause "#<eof>" to appear in the output XML, which is *really* bad.
(let ((color
(catch 'system-error
(lambda () (call-with-input-file (path-append path "color") read-line))
(const "#FFFFFF")))
(name
(catch 'system-error
(lambda () (call-with-input-file (path-append path "displayname") read-line))
(const #f))))
(reduce (lambda (item calendar)
(define-values (events other)
(partition (lambda (e) (eq? 'VEVENT (type e)))
(children item)))
(unless (eq? 'VCALENDAR (type item))
(scm-error 'misc-error "parse-vdir"
"Unexepected top level component. Expected VCALENDAR, got ~a. In file ~s"
(list (type item) (prop item '-X-HNH-FILENAME))
#f))
;; TODO
#;
(for child in (children item)
(set! (prop child '-X-HNH-FILENAME)
(prop (parent child) '-X-HNH-FILENAME)))
;; NOTE The vdir standard says that each file should contain
;; EXACTLY one event. It can however contain multiple VEVENT
;; components, but they are still the same event.
;; In our case this means exceptions to reccurence rules, which
;; is set up here, and then later handled in rrule-generate.
;; NOTE These events also share UID, but are diferentiated
;; by RECURRENCE-ID. As far as I can tell this goes against
;; the standard. Section 3.8.4.4.
(case (length events)
[(0) (warning (G_ "No events in component~%~a")
(prop item '-X-HNH-FILENAME))
calendar]
[(1) (add-child calendar (car events))]
;; two or more
[else
;; Sequence numbers on their own specifies revisions of a
;; single compenent, incremented by a central authorative
;; source. In that case simply picking the version with the
;; highest SEQUENCE number would suffice. However, for
;; recurring events where each instance is its own VEVENT
;; they also signify something.
;; TODO Neither version is handled here (or anywhere else).
;; Multiple VEVENT objects can share a UID if they have
;; different RECURRENCE-ID fields. This signifies that they
;; are instances of the same event, similar to RDATE.
;; Here we first check if we have a component which contains
;; an RRULE or lacks a RECURRENCE-ID, and uses that as base.
;; Otherwise we just take the first component as base.
;;
;; All alternatives (and the base) is added the the -X-HNH-ALTERNATIVES
;; property of the base object, to be extracted where needed.
(let* ((head (or (find (extract 'RRULE) events)
(find (negate (extract 'RECURRENCE-ID)) events)
(car events)))
(rest (delete head events eq?)))
(add-child
calendar
;; TODO this is really ugly
(prop head '-X-HNH-ALTERNATIVES
(alist->hash-table
(map cons
;; head is added back to the collection to simplify
;; generation of recurrences. The recurrence
;; generation assumes that the base event either
;; contains an RRULE property, OR is in the
;; -X-HNH-ALTERNATIVES set. This might produce
;; duplicates, since the base event might also
;; get included through an RRULE. This however
;; is almost a non-problem, since RDATES and RRULES
;; can already produce duplicates, meaning that
;; we need to filter duplicates either way.
(map (extract 'RECURRENCE-ID) (cons head rest))
(cons head rest))))))])
;; return
calendar)
(vcomponent type: 'VIRTUAL)
(map #; (@ (ice-9 threads) par-map)
(lambda (fname)
(let ((fullname (path-append path fname)))
(set-properties (call-with-input-file fullname
parse-calendar)
(cons 'COLOR color)
(cons 'NAME name)
(cons '-X-HNH-FILENAME fullname))))
(scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
(string= "ics" (string-take-right s 3)))))))))
|
