line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::CalDAVTalk; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
83001
|
use 5.006; |
|
2
|
|
|
|
|
8
|
|
4
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
51
|
|
5
|
2
|
|
|
2
|
|
8
|
use warnings FATAL => 'all'; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
79
|
|
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
557
|
use Net::DAVTalk; |
|
2
|
|
|
|
|
1044808
|
|
|
2
|
|
|
|
|
67
|
|
8
|
2
|
|
|
2
|
|
17
|
use base qw(Net::DAVTalk); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
131
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
12
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
125
|
|
11
|
2
|
|
|
2
|
|
833
|
use Data::ICal; |
|
2
|
|
|
|
|
32904
|
|
|
2
|
|
|
|
|
21
|
|
12
|
2
|
|
|
2
|
|
564
|
use Data::ICal::Entry::Event; |
|
2
|
|
|
|
|
669
|
|
|
2
|
|
|
|
|
17
|
|
13
|
2
|
|
|
2
|
|
516
|
use Data::ICal::TimeZone; |
|
2
|
|
|
|
|
4436
|
|
|
2
|
|
|
|
|
20
|
|
14
|
2
|
|
|
2
|
|
508
|
use Data::ICal::Entry::Alarm::Email; |
|
2
|
|
|
|
|
1178
|
|
|
2
|
|
|
|
|
20
|
|
15
|
2
|
|
|
2
|
|
474
|
use Data::ICal::Entry::Alarm::Display; |
|
2
|
|
|
|
|
387
|
|
|
2
|
|
|
|
|
22
|
|
16
|
2
|
|
|
2
|
|
624
|
use DateTime::Format::ICal; |
|
2
|
|
|
|
|
70824
|
|
|
2
|
|
|
|
|
25
|
|
17
|
2
|
|
|
2
|
|
71
|
use DateTime::TimeZone; |
|
2
|
|
|
|
|
15
|
|
|
2
|
|
|
|
|
17
|
|
18
|
2
|
|
|
2
|
|
47
|
use JSON::XS qw(encode_json); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
108
|
|
19
|
2
|
|
|
2
|
|
3648
|
use Net::CalDAVTalk::TimeZones; |
|
2
|
|
|
|
|
28
|
|
|
2
|
|
|
|
|
39
|
|
20
|
2
|
|
|
2
|
|
895
|
use Text::VCardFast qw(vcard2hash); |
|
2
|
|
|
|
|
4653
|
|
|
2
|
|
|
|
|
132
|
|
21
|
2
|
|
|
2
|
|
13
|
use XML::Spice; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
16
|
|
22
|
2
|
|
|
2
|
|
68
|
use MIME::Base64 qw(encode_base64); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
67
|
|
23
|
2
|
|
|
2
|
|
481
|
use MIME::Types; |
|
2
|
|
|
|
|
5784
|
|
|
2
|
|
|
|
|
91
|
|
24
|
2
|
|
|
2
|
|
623
|
use Digest::SHA qw(sha1_hex); |
|
2
|
|
|
|
|
3651
|
|
|
2
|
|
|
|
|
139
|
|
25
|
2
|
|
|
2
|
|
13
|
use URI::Escape qw(uri_unescape); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
194
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $BATCHSIZE = 100; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# monkey patch like a bandit |
30
|
|
|
|
|
|
|
BEGIN { |
31
|
2
|
|
|
2
|
|
11
|
my @properties = Data::ICal::Entry::Alarm::optional_unique_properties(); |
32
|
2
|
|
|
|
|
12
|
foreach my $want (qw(uid acknowledged)) { |
33
|
4
|
50
|
|
|
|
9
|
push @properties, $want unless grep { $_ eq $want } @properties; |
|
10
|
|
|
|
|
24
|
|
34
|
|
|
|
|
|
|
} |
35
|
2
|
|
|
2
|
|
12
|
no warnings 'redefine'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
119
|
|
36
|
2
|
|
|
0
|
|
1212
|
*Data::ICal::Entry::Alarm::optional_unique_properties = sub { @properties }; |
|
0
|
|
|
|
|
0
|
|
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our ( |
40
|
|
|
|
|
|
|
$DefaultCalendarColour, |
41
|
|
|
|
|
|
|
$DefaultDisplayName, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
our $UTC = DateTime::TimeZone::UTC->new(); |
45
|
|
|
|
|
|
|
our $FLOATING = DateTime::TimeZone::Floating->new(); |
46
|
|
|
|
|
|
|
our $LOCALE = DateTime::Locale->load('en_US'); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Beginning and End of time as used for "all event" date ranges |
49
|
|
|
|
|
|
|
# Reducing this range may result in events disappearing from FastMail |
50
|
|
|
|
|
|
|
# calendars, as we think they have been deleted from the other end, |
51
|
|
|
|
|
|
|
# so best to avoid this. |
52
|
|
|
|
|
|
|
# However, from my tests, the events should be resurrected once this date |
53
|
|
|
|
|
|
|
# window includes them again. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my $BoT = '1970-01-01T00:00:00'; |
56
|
|
|
|
|
|
|
my $EoT = '2038-01-19T00:00:00'; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my ( |
59
|
|
|
|
|
|
|
%WeekDayNames, |
60
|
|
|
|
|
|
|
%WeekDayNamesReverse, |
61
|
|
|
|
|
|
|
%DaysByName, |
62
|
|
|
|
|
|
|
%DaysByIndex, |
63
|
|
|
|
|
|
|
%ColourNames, |
64
|
|
|
|
|
|
|
@Frequencies, |
65
|
|
|
|
|
|
|
%RecurrenceProperties, |
66
|
|
|
|
|
|
|
%UTCLinks, |
67
|
|
|
|
|
|
|
%MustBeTopLevel, |
68
|
|
|
|
|
|
|
%EventKeys, |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
BEGIN { |
72
|
2
|
|
|
2
|
|
24
|
%WeekDayNames = ( |
73
|
|
|
|
|
|
|
su => 'sunday', |
74
|
|
|
|
|
|
|
mo => 'monday', |
75
|
|
|
|
|
|
|
tu => 'tuesday', |
76
|
|
|
|
|
|
|
we => 'wednesday', |
77
|
|
|
|
|
|
|
th => 'thursday', |
78
|
|
|
|
|
|
|
fr => 'friday', |
79
|
|
|
|
|
|
|
sa => 'saturday', |
80
|
|
|
|
|
|
|
); |
81
|
2
|
|
|
|
|
12
|
%WeekDayNamesReverse = reverse %WeekDayNames; |
82
|
|
|
|
|
|
|
|
83
|
2
|
|
|
|
|
7
|
%DaysByName = ( |
84
|
|
|
|
|
|
|
su => 0, |
85
|
|
|
|
|
|
|
mo => 1, |
86
|
|
|
|
|
|
|
tu => 2, |
87
|
|
|
|
|
|
|
we => 3, |
88
|
|
|
|
|
|
|
th => 4, |
89
|
|
|
|
|
|
|
fr => 5, |
90
|
|
|
|
|
|
|
sa => 6, |
91
|
|
|
|
|
|
|
); |
92
|
|
|
|
|
|
|
|
93
|
2
|
|
|
|
|
12
|
%DaysByIndex = reverse %DaysByName; |
94
|
2
|
|
|
|
|
4
|
$DefaultCalendarColour = '#0252D4'; |
95
|
2
|
|
|
|
|
2
|
$DefaultDisplayName = 'Untitled Calendar'; |
96
|
2
|
|
|
|
|
6
|
@Frequencies = qw{yearly monthly weekly daily hourly minutely secondly}; |
97
|
|
|
|
|
|
|
|
98
|
2
|
|
|
|
|
133
|
%EventKeys = ( |
99
|
|
|
|
|
|
|
'' => { |
100
|
|
|
|
|
|
|
uid => [0, 'string', 1, undef], |
101
|
|
|
|
|
|
|
relatedTo => [0, 'string', 0, undef], |
102
|
|
|
|
|
|
|
prodId => [0, 'string', 0, undef], |
103
|
|
|
|
|
|
|
created => [0, 'utcdate', 0, undef], |
104
|
|
|
|
|
|
|
updated => [0, 'utcdate', 1, undef], |
105
|
|
|
|
|
|
|
sequence => [0, 'number', 0, undef], |
106
|
|
|
|
|
|
|
title => [0, 'string', 0, ''], |
107
|
|
|
|
|
|
|
description => [0, 'string', 0, ''], |
108
|
|
|
|
|
|
|
links => [0, 'object', 0, undef], |
109
|
|
|
|
|
|
|
locale => [0, 'string', 0, undef], |
110
|
|
|
|
|
|
|
localizations => [0, 'patch', 0, undef], |
111
|
|
|
|
|
|
|
locations => [0, 'object', 0, undef], |
112
|
|
|
|
|
|
|
isAllDay => [0, 'bool', 0, $JSON::false], |
113
|
|
|
|
|
|
|
start => [0, 'localdate', 1, undef], |
114
|
|
|
|
|
|
|
timeZone => [0, 'timezone', 0, undef], |
115
|
|
|
|
|
|
|
duration => [0, 'duration', 0, undef], |
116
|
|
|
|
|
|
|
recurrenceRule => [0, 'object', 0, undef], |
117
|
|
|
|
|
|
|
recurrenceOverrides => [0, 'patch', 0, undef], |
118
|
|
|
|
|
|
|
status => [0, 'string', 0, undef], |
119
|
|
|
|
|
|
|
showAsFree => [0, 'bool', 0, undef], |
120
|
|
|
|
|
|
|
replyTo => [0, 'object', 0, undef], |
121
|
|
|
|
|
|
|
participants => [0, 'object', 0, undef], |
122
|
|
|
|
|
|
|
useDefaultAlerts => [0, 'bool', 0, $JSON::false], |
123
|
|
|
|
|
|
|
alerts => [0, 'object', 0, undef], |
124
|
|
|
|
|
|
|
}, |
125
|
|
|
|
|
|
|
replyTo => { |
126
|
|
|
|
|
|
|
imip => [0, 'mailto', 0, undef], |
127
|
|
|
|
|
|
|
web => [0, 'href', 0, undef], |
128
|
|
|
|
|
|
|
}, |
129
|
|
|
|
|
|
|
links => { |
130
|
|
|
|
|
|
|
href => [0, 'string', 1, undef], |
131
|
|
|
|
|
|
|
type => [0, 'string', 0, undef], |
132
|
|
|
|
|
|
|
size => [0, 'number', 0, undef], |
133
|
|
|
|
|
|
|
rel => [0, 'string', 1, undef], |
134
|
|
|
|
|
|
|
title => [0, 'string', 1, undef], |
135
|
|
|
|
|
|
|
properties => [0, 'string', 1, undef], |
136
|
|
|
|
|
|
|
}, |
137
|
|
|
|
|
|
|
locations => { |
138
|
|
|
|
|
|
|
name => [0, 'string', 0, undef], |
139
|
|
|
|
|
|
|
accessInstructions => [0, 'string', 0, undef], |
140
|
|
|
|
|
|
|
rel => [0, 'string', 0, 'unknown'], |
141
|
|
|
|
|
|
|
timeZone => [0, 'timezone', 0, undef], |
142
|
|
|
|
|
|
|
address => [0, 'object', 0, undef], |
143
|
|
|
|
|
|
|
coordinates => [0, 'string', 0, undef], |
144
|
|
|
|
|
|
|
uri => [0, 'string', 0, undef], |
145
|
|
|
|
|
|
|
}, |
146
|
|
|
|
|
|
|
recurrenceRule => { |
147
|
|
|
|
|
|
|
frequency => [0, 'string', 1, undef], |
148
|
|
|
|
|
|
|
interval => [0, 'number', 0, undef], |
149
|
|
|
|
|
|
|
rscale => [0, 'string', 0, 'gregorian'], |
150
|
|
|
|
|
|
|
skip => [0, 'string', 0, 'omit'], |
151
|
|
|
|
|
|
|
firstDayOfWeek => [0, 'string', 0, 'monday'], |
152
|
|
|
|
|
|
|
byDay => [1, 'object', 0, undef], |
153
|
|
|
|
|
|
|
byDate => [1, 'number', 0, undef], |
154
|
|
|
|
|
|
|
byMonth => [1, 'string', 0, undef], |
155
|
|
|
|
|
|
|
byYearDay => [1, 'number', 0, undef], |
156
|
|
|
|
|
|
|
byWeekNo => [1, 'number', 0, undef], |
157
|
|
|
|
|
|
|
byHour => [1, 'number', 0, undef], |
158
|
|
|
|
|
|
|
byMinute => [1, 'number', 0, undef], |
159
|
|
|
|
|
|
|
bySecond => [1, 'number', 0, undef], |
160
|
|
|
|
|
|
|
bySetPosition => [1, 'number', 0, undef], |
161
|
|
|
|
|
|
|
count => [0, 'number', 0, undef], |
162
|
|
|
|
|
|
|
until => [0, 'localdate', 0, undef], |
163
|
|
|
|
|
|
|
}, |
164
|
|
|
|
|
|
|
byDay => { |
165
|
|
|
|
|
|
|
day => [0, 'string', 1, undef], |
166
|
|
|
|
|
|
|
nthOfPeriod => [0, 'number', 0, undef], |
167
|
|
|
|
|
|
|
}, |
168
|
|
|
|
|
|
|
participants => { |
169
|
|
|
|
|
|
|
name => [0, 'string', 1, undef], |
170
|
|
|
|
|
|
|
email => [0, 'string', 1, undef], |
171
|
|
|
|
|
|
|
kind => [0, 'string', 0, 'unknown'], |
172
|
|
|
|
|
|
|
roles => [1, 'string', 1, undef], |
173
|
|
|
|
|
|
|
locationId => [0, 'string', 0, undef], |
174
|
|
|
|
|
|
|
scheduleStatus => [0, 'string', 0, 'needs-action'], |
175
|
|
|
|
|
|
|
schedulePriority => [0, 'string', 0, 'required'], |
176
|
|
|
|
|
|
|
scheduleRSVP => [0, 'bool', 0, $JSON::false], |
177
|
|
|
|
|
|
|
scheduleUpdated => [0, 'utcdate', 0, undef], |
178
|
|
|
|
|
|
|
memberOf => [1, 'string', 0, undef], |
179
|
|
|
|
|
|
|
}, |
180
|
|
|
|
|
|
|
alerts => { |
181
|
|
|
|
|
|
|
relativeTo => [0, 'string', 0, 'before-start'], |
182
|
|
|
|
|
|
|
offset => [0, 'duration', 1, undef], |
183
|
|
|
|
|
|
|
action => [0, 'object', 1, undef], |
184
|
|
|
|
|
|
|
}, |
185
|
|
|
|
|
|
|
action => { |
186
|
|
|
|
|
|
|
type => [0, 'string', 1, undef], |
187
|
|
|
|
|
|
|
}, |
188
|
|
|
|
|
|
|
); |
189
|
|
|
|
|
|
|
|
190
|
2
|
|
|
|
|
23
|
%RecurrenceProperties = ( |
191
|
|
|
|
|
|
|
bymonthday => { |
192
|
|
|
|
|
|
|
name => 'byDate', |
193
|
|
|
|
|
|
|
max => 31, |
194
|
|
|
|
|
|
|
signed => 1, |
195
|
|
|
|
|
|
|
}, |
196
|
|
|
|
|
|
|
byyearday => { |
197
|
|
|
|
|
|
|
name => 'byYearDay', |
198
|
|
|
|
|
|
|
max => 366, |
199
|
|
|
|
|
|
|
signed => 1, |
200
|
|
|
|
|
|
|
}, |
201
|
|
|
|
|
|
|
byweekno => { |
202
|
|
|
|
|
|
|
name => 'byWeekNo', |
203
|
|
|
|
|
|
|
max => 53, |
204
|
|
|
|
|
|
|
signed => 1, |
205
|
|
|
|
|
|
|
}, |
206
|
|
|
|
|
|
|
byhour => { |
207
|
|
|
|
|
|
|
name => 'byHour', |
208
|
|
|
|
|
|
|
max => 23, |
209
|
|
|
|
|
|
|
}, |
210
|
|
|
|
|
|
|
byminute => { |
211
|
|
|
|
|
|
|
name => 'byMinute', |
212
|
|
|
|
|
|
|
max => 59, |
213
|
|
|
|
|
|
|
}, |
214
|
|
|
|
|
|
|
bysecond => { |
215
|
|
|
|
|
|
|
name => 'bySecond', |
216
|
|
|
|
|
|
|
max => 60, |
217
|
|
|
|
|
|
|
}, |
218
|
|
|
|
|
|
|
bysetpos => { |
219
|
|
|
|
|
|
|
name => 'bySetPosition', |
220
|
|
|
|
|
|
|
max => 366, |
221
|
|
|
|
|
|
|
signed => 1, |
222
|
|
|
|
|
|
|
}, |
223
|
|
|
|
|
|
|
); |
224
|
|
|
|
|
|
|
|
225
|
2
|
|
|
|
|
5
|
%MustBeTopLevel = map { $_ => 1 } qw{ |
|
16
|
|
|
|
|
27
|
|
226
|
|
|
|
|
|
|
uid |
227
|
|
|
|
|
|
|
relatedTo |
228
|
|
|
|
|
|
|
prodId |
229
|
|
|
|
|
|
|
isAllDay |
230
|
|
|
|
|
|
|
recurrenceRule |
231
|
|
|
|
|
|
|
recurrenceOverrides |
232
|
|
|
|
|
|
|
replyTo |
233
|
|
|
|
|
|
|
participantId |
234
|
|
|
|
|
|
|
}; |
235
|
|
|
|
|
|
|
# not in tc-api / JMAP, but necessary for iMIP |
236
|
2
|
|
|
|
|
4
|
$MustBeTopLevel{method} = 1; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Colour names defined in CSS Color Module Level 3 |
239
|
|
|
|
|
|
|
# http://www.w3.org/TR/css3-color/ |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
%ColourNames |
242
|
2
|
|
|
|
|
7
|
= map { $_ => 1 } |
|
294
|
|
|
|
|
464
|
|
243
|
|
|
|
|
|
|
qw{ |
244
|
|
|
|
|
|
|
aliceblue |
245
|
|
|
|
|
|
|
antiquewhite |
246
|
|
|
|
|
|
|
aqua |
247
|
|
|
|
|
|
|
aquamarine |
248
|
|
|
|
|
|
|
azure |
249
|
|
|
|
|
|
|
beige |
250
|
|
|
|
|
|
|
bisque |
251
|
|
|
|
|
|
|
black |
252
|
|
|
|
|
|
|
blanchedalmond |
253
|
|
|
|
|
|
|
blue |
254
|
|
|
|
|
|
|
blueviolet |
255
|
|
|
|
|
|
|
brown |
256
|
|
|
|
|
|
|
burlywood |
257
|
|
|
|
|
|
|
cadetblue |
258
|
|
|
|
|
|
|
chartreuse |
259
|
|
|
|
|
|
|
chocolate |
260
|
|
|
|
|
|
|
coral |
261
|
|
|
|
|
|
|
cornflowerblue |
262
|
|
|
|
|
|
|
cornsilk |
263
|
|
|
|
|
|
|
crimson |
264
|
|
|
|
|
|
|
cyan |
265
|
|
|
|
|
|
|
darkblue |
266
|
|
|
|
|
|
|
darkcyan |
267
|
|
|
|
|
|
|
darkgoldenrod |
268
|
|
|
|
|
|
|
darkgray |
269
|
|
|
|
|
|
|
darkgreen |
270
|
|
|
|
|
|
|
darkgrey |
271
|
|
|
|
|
|
|
darkkhaki |
272
|
|
|
|
|
|
|
darkmagenta |
273
|
|
|
|
|
|
|
darkolivegreen |
274
|
|
|
|
|
|
|
darkorange |
275
|
|
|
|
|
|
|
darkorchid |
276
|
|
|
|
|
|
|
darkred |
277
|
|
|
|
|
|
|
darksalmon |
278
|
|
|
|
|
|
|
darkseagreen |
279
|
|
|
|
|
|
|
darkslateblue |
280
|
|
|
|
|
|
|
darkslategray |
281
|
|
|
|
|
|
|
darkslategrey |
282
|
|
|
|
|
|
|
darkturquoise |
283
|
|
|
|
|
|
|
darkviolet |
284
|
|
|
|
|
|
|
deeppink |
285
|
|
|
|
|
|
|
deepskyblue |
286
|
|
|
|
|
|
|
dimgray |
287
|
|
|
|
|
|
|
dimgrey |
288
|
|
|
|
|
|
|
dodgerblue |
289
|
|
|
|
|
|
|
firebrick |
290
|
|
|
|
|
|
|
floralwhite |
291
|
|
|
|
|
|
|
forestgreen |
292
|
|
|
|
|
|
|
fuchsia |
293
|
|
|
|
|
|
|
gainsboro |
294
|
|
|
|
|
|
|
ghostwhite |
295
|
|
|
|
|
|
|
gold |
296
|
|
|
|
|
|
|
goldenrod |
297
|
|
|
|
|
|
|
gray |
298
|
|
|
|
|
|
|
green |
299
|
|
|
|
|
|
|
greenyellow |
300
|
|
|
|
|
|
|
grey |
301
|
|
|
|
|
|
|
honeydew |
302
|
|
|
|
|
|
|
hotpink |
303
|
|
|
|
|
|
|
indianred |
304
|
|
|
|
|
|
|
indigo |
305
|
|
|
|
|
|
|
ivory |
306
|
|
|
|
|
|
|
khaki |
307
|
|
|
|
|
|
|
lavender |
308
|
|
|
|
|
|
|
lavenderblush |
309
|
|
|
|
|
|
|
lawngreen |
310
|
|
|
|
|
|
|
lemonchiffon |
311
|
|
|
|
|
|
|
lightblue |
312
|
|
|
|
|
|
|
lightcoral |
313
|
|
|
|
|
|
|
lightcyan |
314
|
|
|
|
|
|
|
lightgoldenrodyellow |
315
|
|
|
|
|
|
|
lightgray |
316
|
|
|
|
|
|
|
lightgreen |
317
|
|
|
|
|
|
|
lightgrey |
318
|
|
|
|
|
|
|
lightpink |
319
|
|
|
|
|
|
|
lightsalmon |
320
|
|
|
|
|
|
|
lightseagreen |
321
|
|
|
|
|
|
|
lightskyblue |
322
|
|
|
|
|
|
|
lightslategray |
323
|
|
|
|
|
|
|
lightslategrey |
324
|
|
|
|
|
|
|
lightsteelblue |
325
|
|
|
|
|
|
|
lightyellow |
326
|
|
|
|
|
|
|
lime |
327
|
|
|
|
|
|
|
limegreen |
328
|
|
|
|
|
|
|
linen |
329
|
|
|
|
|
|
|
magenta |
330
|
|
|
|
|
|
|
maroon |
331
|
|
|
|
|
|
|
mediumaquamarine |
332
|
|
|
|
|
|
|
mediumblue |
333
|
|
|
|
|
|
|
mediumorchid |
334
|
|
|
|
|
|
|
mediumpurple |
335
|
|
|
|
|
|
|
mediumseagreen |
336
|
|
|
|
|
|
|
mediumslateblue |
337
|
|
|
|
|
|
|
mediumspringgreen |
338
|
|
|
|
|
|
|
mediumturquoise |
339
|
|
|
|
|
|
|
mediumvioletred |
340
|
|
|
|
|
|
|
midnightblue |
341
|
|
|
|
|
|
|
mintcream |
342
|
|
|
|
|
|
|
mistyrose |
343
|
|
|
|
|
|
|
moccasin |
344
|
|
|
|
|
|
|
navajowhite |
345
|
|
|
|
|
|
|
navy |
346
|
|
|
|
|
|
|
oldlace |
347
|
|
|
|
|
|
|
olive |
348
|
|
|
|
|
|
|
olivedrab |
349
|
|
|
|
|
|
|
orange |
350
|
|
|
|
|
|
|
orangered |
351
|
|
|
|
|
|
|
orchid |
352
|
|
|
|
|
|
|
palegoldenrod |
353
|
|
|
|
|
|
|
palegreen |
354
|
|
|
|
|
|
|
paleturquoise |
355
|
|
|
|
|
|
|
palevioletred |
356
|
|
|
|
|
|
|
papayawhip |
357
|
|
|
|
|
|
|
peachpuff |
358
|
|
|
|
|
|
|
peru |
359
|
|
|
|
|
|
|
pink |
360
|
|
|
|
|
|
|
plum |
361
|
|
|
|
|
|
|
powderblue |
362
|
|
|
|
|
|
|
purple |
363
|
|
|
|
|
|
|
red |
364
|
|
|
|
|
|
|
rosybrown |
365
|
|
|
|
|
|
|
royalblue |
366
|
|
|
|
|
|
|
saddlebrown |
367
|
|
|
|
|
|
|
salmon |
368
|
|
|
|
|
|
|
sandybrown |
369
|
|
|
|
|
|
|
seagreen |
370
|
|
|
|
|
|
|
seashell |
371
|
|
|
|
|
|
|
sienna |
372
|
|
|
|
|
|
|
silver |
373
|
|
|
|
|
|
|
skyblue |
374
|
|
|
|
|
|
|
slateblue |
375
|
|
|
|
|
|
|
slategray |
376
|
|
|
|
|
|
|
slategrey |
377
|
|
|
|
|
|
|
snow |
378
|
|
|
|
|
|
|
springgreen |
379
|
|
|
|
|
|
|
steelblue |
380
|
|
|
|
|
|
|
tan |
381
|
|
|
|
|
|
|
teal |
382
|
|
|
|
|
|
|
thistle |
383
|
|
|
|
|
|
|
tomato |
384
|
|
|
|
|
|
|
turquoise |
385
|
|
|
|
|
|
|
violet |
386
|
|
|
|
|
|
|
wheat |
387
|
|
|
|
|
|
|
white |
388
|
|
|
|
|
|
|
whitesmoke |
389
|
|
|
|
|
|
|
yellow |
390
|
|
|
|
|
|
|
yellowgreen |
391
|
|
|
|
|
|
|
}; |
392
|
|
|
|
|
|
|
|
393
|
2
|
|
|
|
|
11474
|
%UTCLinks = ( |
394
|
|
|
|
|
|
|
'Etc/GMT-0' => 1, |
395
|
|
|
|
|
|
|
'Etc/GMT+0' => 1, |
396
|
|
|
|
|
|
|
'Etc/GMT0' => 1, |
397
|
|
|
|
|
|
|
'Etc/GMT' => 1, |
398
|
|
|
|
|
|
|
'Etc/Greenwich' => 1, |
399
|
|
|
|
|
|
|
'Etc/UCT' => 1, |
400
|
|
|
|
|
|
|
'Etc/Universal' => 1, |
401
|
|
|
|
|
|
|
'Etc/UTC' => 1, |
402
|
|
|
|
|
|
|
'Etc/Zulu' => 1, |
403
|
|
|
|
|
|
|
'GMT' => 1, |
404
|
|
|
|
|
|
|
'UCT' => 1, |
405
|
|
|
|
|
|
|
'UTC' => 1, |
406
|
|
|
|
|
|
|
); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head1 NAME |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Net::CalDAVTalk - Module to talk CalDAV and give a JSON interface to the data |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head1 VERSION |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Version 0.11 |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=cut |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head1 SYNOPSIS |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
This module is the initial release of the code used at FastMail for talking |
426
|
|
|
|
|
|
|
to CalDAV servers. It's quite specific to an early version of our API, so |
427
|
|
|
|
|
|
|
while it might be useful to others, it's being pushed to CPAN more because |
428
|
|
|
|
|
|
|
the Cassandane test suite needs it. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
See Net::DAVTalk for details on how to specify hosts and paths. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
my $CalDAV = Net::CalDAVTalk->new( |
433
|
|
|
|
|
|
|
user => $service->user(), |
434
|
|
|
|
|
|
|
password => $service->pass(), |
435
|
|
|
|
|
|
|
host => $service->host(), |
436
|
|
|
|
|
|
|
port => $service->port(), |
437
|
|
|
|
|
|
|
scheme => 'http', |
438
|
|
|
|
|
|
|
url => '/', |
439
|
|
|
|
|
|
|
expandurl => 1, |
440
|
|
|
|
|
|
|
); |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
or using DNS: |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
my $domain = $user; |
445
|
|
|
|
|
|
|
$domain =~ s/.*\@//; |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
my $url; |
448
|
|
|
|
|
|
|
my ($reply) = $Resolver->search("_caldavs._tcp.$domain", "srv"); |
449
|
|
|
|
|
|
|
if ($reply) { |
450
|
|
|
|
|
|
|
my @d = $reply->answer; |
451
|
|
|
|
|
|
|
if (@d) { |
452
|
|
|
|
|
|
|
my $host = $d[0]->target(); |
453
|
|
|
|
|
|
|
my $port = $d[0]->port(); |
454
|
|
|
|
|
|
|
$url = "https://$host"; |
455
|
|
|
|
|
|
|
$url .= ":$port" unless $port eq 443; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
This will use the '/.well-known/caldav' address to find the actual current user |
460
|
|
|
|
|
|
|
principal, and from there the calendar-home-set for further operations. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
my $foo = Net::CalDAVTalk->new( |
463
|
|
|
|
|
|
|
user => $user, |
464
|
|
|
|
|
|
|
password => $password, |
465
|
|
|
|
|
|
|
url => $url, |
466
|
|
|
|
|
|
|
expandurl => 1, |
467
|
|
|
|
|
|
|
); |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=head2 new(%args) |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
Takes the same arguments as Net::DAVTalk and adds the caldav namespaces |
475
|
|
|
|
|
|
|
and some Cyrus specific namespaces for all XML requests. |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
A => 'http://apple.com/ns/ical/' |
478
|
|
|
|
|
|
|
C => 'urn:ietf:params:xml:ns:caldav' |
479
|
|
|
|
|
|
|
CY => 'http://cyrusimap.org/ns/' |
480
|
|
|
|
|
|
|
UF => 'http://cyrusimap.org/ns/userflag/' |
481
|
|
|
|
|
|
|
SF => 'http://cyrusimap.org/ns/sysflag/' |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=cut |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub new { |
486
|
0
|
|
|
0
|
1
|
|
my ($Class, %Params) = @_; |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
$Params{homesetns} = 'C'; |
489
|
0
|
|
|
|
|
|
$Params{homeset} = 'calendar-home-set'; |
490
|
0
|
|
|
|
|
|
$Params{wellknown} = 'caldav'; |
491
|
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
|
my $Self = $Class->SUPER::new(%Params); |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
$Self->ns(A => 'http://apple.com/ns/ical/'); |
495
|
0
|
|
|
|
|
|
$Self->ns(C => 'urn:ietf:params:xml:ns:caldav'); |
496
|
0
|
|
|
|
|
|
$Self->ns(CY => 'http://cyrusimap.org/ns/'); |
497
|
0
|
|
|
|
|
|
$Self->ns(UF => 'http://cyrusimap.org/ns/userflag/'); |
498
|
0
|
|
|
|
|
|
$Self->ns(SF => 'http://cyrusimap.org/ns/sysflag/'); |
499
|
|
|
|
|
|
|
|
500
|
0
|
|
|
|
|
|
return $Self; |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=head2 $self->tz($name) |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
Returns a DateTime::TimeZone object for the given name, but caches |
506
|
|
|
|
|
|
|
the result for speed. |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=cut |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub tz { |
511
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
512
|
0
|
|
|
|
|
|
my $tzName = shift; |
513
|
0
|
0
|
|
|
|
|
return $FLOATING unless defined $tzName; |
514
|
0
|
0
|
|
|
|
|
return $UTC if $UTCLinks{$tzName}; |
515
|
0
|
0
|
|
|
|
|
unless (exists $Self->{_tz}{$tzName}) { |
516
|
0
|
|
|
|
|
|
$Self->{_tz}{$tzName} = DateTime::TimeZone->new(name => $tzName); |
517
|
|
|
|
|
|
|
} |
518
|
0
|
|
|
|
|
|
return $Self->{_tz}{$tzName}; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=head2 $self->logger(sub { }) |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
Sets a function to receive all log messages. Gets called with the first |
524
|
|
|
|
|
|
|
argument being a level name, and then a list of items to log: |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
e.g. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
$CalDAV->logger(sub { |
529
|
|
|
|
|
|
|
my $level = shift; |
530
|
|
|
|
|
|
|
return if ($level eq 'debug' and not $ENV{DEBUG_CALDAV}); |
531
|
|
|
|
|
|
|
warn "LOG $level: $_\n" for @_; |
532
|
|
|
|
|
|
|
}); |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=cut |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
sub logger { |
537
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
538
|
|
|
|
|
|
|
|
539
|
0
|
0
|
|
|
|
|
if ($@) { |
540
|
0
|
|
|
|
|
|
$Self->{logger} = shift; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
0
|
|
|
|
|
|
return $Self->{logger}; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=head2 $self->DeleteCalendar($calendarId) |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Delete the named calendar from the server (shorturl - see Net::DAVTalk) |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=cut |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=head2 $Cal->DeleteCalendar($calendarId) |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
Delete the calendar with collection name $calendarId (full or relative path) |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
e.g. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
$Cal->DeleteCalendar('Default'); |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=cut |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub DeleteCalendar { |
563
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId) = @_; |
564
|
|
|
|
|
|
|
|
565
|
0
|
0
|
|
|
|
|
unless ($calendarId) { |
566
|
0
|
|
|
|
|
|
confess 'Calendar not specified'; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
$Self->Request( |
570
|
0
|
|
|
|
|
|
'DELETE', |
571
|
|
|
|
|
|
|
"$calendarId/", |
572
|
|
|
|
|
|
|
); |
573
|
|
|
|
|
|
|
|
574
|
0
|
|
|
|
|
|
return 1; |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub _fixColour { |
578
|
0
|
|
0
|
0
|
|
|
my $color = lc(shift || ''); |
579
|
|
|
|
|
|
|
|
580
|
0
|
0
|
|
|
|
|
return $color if $ColourNames{$color}; |
581
|
0
|
0
|
|
|
|
|
return $DefaultCalendarColour unless $color =~ m/^\s*(\#[a-f0-9]{3,8})\s*$/; |
582
|
0
|
|
|
|
|
|
$color = $1; |
583
|
0
|
0
|
|
|
|
|
return uc($color) if length($color) == 7; |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# Optional digit is for transparency (RGBA) |
586
|
0
|
0
|
|
|
|
|
if ( $color =~ m/^#(.)(.)(.).?$/ ) { |
587
|
0
|
|
|
|
|
|
return uc "#$1$1$2$2$3$3"; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# Last two digits are for transparency (RGBA) |
591
|
0
|
0
|
|
|
|
|
if ( length($color) == 9 ) { |
592
|
0
|
|
|
|
|
|
return uc(substr($color,0,7)); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
0
|
|
|
|
|
|
return $DefaultCalendarColour; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=head2 $self->GetCalendar($calendarId) |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
Get a single calendar from the server by calendarId |
602
|
|
|
|
|
|
|
(currently implemented very inefficiently as a get |
603
|
|
|
|
|
|
|
of all calendars. Returns undef if the calendar |
604
|
|
|
|
|
|
|
doesn't exist. |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
e.g |
607
|
|
|
|
|
|
|
my $Calendar = $CalDAV->GetCalendar('Default'); |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=cut |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub GetCalendar { |
612
|
0
|
|
|
0
|
1
|
|
my ($Self, $CalendarId) = @_; |
613
|
0
|
|
|
|
|
|
my $Calendars = $Self->GetCalendars(); |
614
|
0
|
0
|
0
|
|
|
|
die "No calendars" unless ($Calendars and @$Calendars); |
615
|
0
|
|
|
|
|
|
my ($Calendar) = grep { $_->{id} eq $CalendarId } @$Calendars; |
|
0
|
|
|
|
|
|
|
616
|
0
|
|
|
|
|
|
return $Calendar; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=head2 $self->GetCalendars(Properties => []) |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Fetch all the calendars on the server. You can request additional |
622
|
|
|
|
|
|
|
properties, but they aren't parsed well yet. |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
e.g |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
my $Calendars = $CalDAV->GetCalendars(); |
627
|
|
|
|
|
|
|
foreach my $Cal (@$Calendars) { |
628
|
|
|
|
|
|
|
# do stuff |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=cut |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub GetCalendars { |
634
|
0
|
|
|
0
|
1
|
|
my ($Self, %Args) = @_; |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# XXX To generalise for CPAN: |
637
|
|
|
|
|
|
|
# XXX - the PROPFIND should be D:allprop unless $Args{Properties} is set |
638
|
|
|
|
|
|
|
# XXX - return all properties as object attributes without renaming |
639
|
|
|
|
|
|
|
# XXX - translate property names to our own liking within ME::CalDAV |
640
|
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
my %Properties = map { $_ => 1 } ( |
642
|
|
|
|
|
|
|
'D:displayname', |
643
|
|
|
|
|
|
|
'D:resourcetype', |
644
|
|
|
|
|
|
|
'A:calendar-color', |
645
|
|
|
|
|
|
|
'D:current-user-privilege-set', |
646
|
|
|
|
|
|
|
'D:acl', |
647
|
|
|
|
|
|
|
'A:calendar-order', |
648
|
|
|
|
|
|
|
'C:calendar-timezone', |
649
|
|
|
|
|
|
|
'D:sync-token', |
650
|
|
|
|
|
|
|
'D:supported-report-set', |
651
|
|
|
|
|
|
|
'C:supported-calendar-data', |
652
|
0
|
0
|
|
|
|
|
@{$Args{Properties} || []}, |
|
0
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
); |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
my $Response = $Self->Request( |
656
|
|
|
|
|
|
|
'PROPFIND', |
657
|
|
|
|
|
|
|
'', |
658
|
|
|
|
|
|
|
x('D:propfind', $Self->NS(), |
659
|
|
|
|
|
|
|
x('D:prop', |
660
|
0
|
|
|
|
|
|
map { x($_) } keys %Properties, |
|
0
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
), |
662
|
|
|
|
|
|
|
), |
663
|
|
|
|
|
|
|
Depth => 1, |
664
|
|
|
|
|
|
|
); |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
my @Calendars; |
667
|
|
|
|
|
|
|
|
668
|
0
|
|
|
|
|
|
my $NS_A = $Self->ns('A'); |
669
|
0
|
|
|
|
|
|
my $NS_C = $Self->ns('C'); |
670
|
0
|
|
|
|
|
|
my $NS_CY = $Self->ns('CY'); |
671
|
0
|
|
|
|
|
|
my $NS_D = $Self->ns('D'); |
672
|
0
|
0
|
|
|
|
|
foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) { |
|
0
|
|
|
|
|
|
|
673
|
0
|
0
|
|
|
|
|
next unless $Response->{"{$NS_D}href"}{content}; |
674
|
0
|
|
|
|
|
|
my $href = uri_unescape($Response->{"{$NS_D}href"}{content}); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# grab the short version of the path |
677
|
0
|
|
|
|
|
|
my $calendarId = $Self->shortpath($href); |
678
|
|
|
|
|
|
|
# and remove trailing slash always |
679
|
0
|
|
|
|
|
|
$calendarId =~ s{/$}{}; |
680
|
|
|
|
|
|
|
|
681
|
0
|
0
|
|
|
|
|
foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) { |
|
0
|
|
|
|
|
|
|
682
|
0
|
0
|
|
|
|
|
next unless $Propstat->{"{$NS_D}prop"}{"{$NS_D}resourcetype"}{"{$NS_C}calendar"}; |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# XXX - this should be moved into ME::CalDAV::GetCalendars() |
685
|
0
|
|
|
|
|
|
my $visData = $Propstat->{"{$NS_D}prop"}{"{$NS_C}X-FM-isVisible"}{content}; |
686
|
0
|
0
|
0
|
|
|
|
my $isVisible = (not defined($visData) or $visData) ? $JSON::true : $JSON::false; |
687
|
|
|
|
|
|
|
|
688
|
0
|
|
|
|
|
|
my %Privileges = ( |
689
|
|
|
|
|
|
|
mayAdmin => $JSON::false, |
690
|
|
|
|
|
|
|
mayWrite => $JSON::false, |
691
|
|
|
|
|
|
|
mayRead => $JSON::false, |
692
|
|
|
|
|
|
|
mayReadFreeBusy => $JSON::false, |
693
|
|
|
|
|
|
|
); |
694
|
|
|
|
|
|
|
|
695
|
0
|
|
|
|
|
|
my $Priv = $Propstat->{"{$NS_D}prop"}{"{$NS_D}current-user-privilege-set"}{"{$NS_D}privilege"}; |
696
|
0
|
0
|
0
|
|
|
|
$Priv = [] unless ($Priv and ref($Priv) eq 'ARRAY'); |
697
|
0
|
|
|
|
|
|
foreach my $item (@$Priv) { |
698
|
0
|
0
|
|
|
|
|
$Privileges{'mayAdmin'} = $JSON::true if $item->{"{$NS_CY}admin"}; |
699
|
0
|
0
|
|
|
|
|
$Privileges{'mayWrite'} = $JSON::true if $item->{"{$NS_D}write-content"}; |
700
|
0
|
0
|
|
|
|
|
$Privileges{'mayRead'} = $JSON::true if $item->{"{$NS_D}read"}; |
701
|
0
|
0
|
|
|
|
|
$Privileges{'mayReadFreeBusy'} = $JSON::true if $item->{"{$NS_C}read-free-busy"}; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
0
|
|
|
|
|
|
my $CanEvent; |
705
|
0
|
|
|
|
|
|
my $Type = $Propstat->{"{$NS_D}prop"}{"{$NS_C}supported-calendar-data"}{"{$NS_C}calendar-data"}; |
706
|
0
|
0
|
0
|
|
|
|
$Type = [] unless ($Type and ref($Type) eq 'ARRAY'); |
707
|
0
|
|
|
|
|
|
foreach my $item (@$Type) { |
708
|
0
|
0
|
|
|
|
|
next unless $item->{"\@content-type"}; |
709
|
0
|
0
|
|
|
|
|
$CanEvent = 1 if $item->{"\@content-type"}{content} eq "application/event+json"; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# XXX - temporary compat |
713
|
0
|
0
|
|
|
|
|
$Privileges{isReadOnly} = $Privileges{mayWrite} ? $JSON::false : $JSON::true; |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
|
my @ShareWith; |
716
|
0
|
|
|
|
|
|
my $ace = $Propstat->{"{$NS_D}prop"}{"{$NS_D}acl"}{"{$NS_D}ace"}; |
717
|
0
|
0
|
0
|
|
|
|
$ace = [] unless ($ace and ref($ace) eq 'ARRAY'); |
718
|
0
|
|
|
|
|
|
foreach my $Acl (@$ace) { |
719
|
0
|
0
|
|
|
|
|
next if $Acl->{"{$NS_D}protected"}; # ignore admin ACLs |
720
|
0
|
0
|
|
|
|
|
next unless $Acl->{"{$NS_D}grant"}; |
721
|
0
|
0
|
|
|
|
|
next unless $Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"}; |
722
|
0
|
0
|
|
|
|
|
next unless ref($Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"}) eq 'ARRAY'; |
723
|
|
|
|
|
|
|
# XXX - freeBusyPublic here? Or should we do it via the web server? |
724
|
0
|
|
0
|
|
|
|
my $user = uri_unescape($Acl->{"{$NS_D}principal"}{"{$NS_D}href"}{content} // ''); |
725
|
0
|
0
|
|
|
|
|
next unless $user =~ m{^/dav/principals/user/([^/]+)}; |
726
|
0
|
|
|
|
|
|
my $email = $1; |
727
|
0
|
0
|
|
|
|
|
next if $email eq 'admin'; |
728
|
0
|
|
|
|
|
|
my %ShareObject = ( |
729
|
|
|
|
|
|
|
email => $email, |
730
|
|
|
|
|
|
|
mayAdmin => $JSON::false, |
731
|
|
|
|
|
|
|
mayWrite => $JSON::false, |
732
|
|
|
|
|
|
|
mayRead => $JSON::false, |
733
|
|
|
|
|
|
|
mayReadFreeBusy => $JSON::false, |
734
|
|
|
|
|
|
|
); |
735
|
0
|
|
|
|
|
|
foreach my $item (@{$Acl->{"{$NS_D}grant"}{"{$NS_D}privilege"}}) { |
|
0
|
|
|
|
|
|
|
736
|
0
|
0
|
|
|
|
|
$ShareObject{'mayAdmin'} = $JSON::true if $item->{"{$NS_CY}admin"}; |
737
|
0
|
0
|
|
|
|
|
$ShareObject{'mayWrite'} = $JSON::true if $item->{"{$NS_D}write-content"}; |
738
|
0
|
0
|
|
|
|
|
$ShareObject{'mayRead'} = $JSON::true if $item->{"{$NS_D}read"}; |
739
|
0
|
0
|
|
|
|
|
$ShareObject{'mayReadFreeBusy'} = $JSON::true if $item->{"{$NS_C}read-free-busy"}; |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
0
|
|
|
|
|
|
push @ShareWith, \%ShareObject; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
my %Cal = ( |
746
|
|
|
|
|
|
|
id => $calendarId, |
747
|
|
|
|
|
|
|
name => ($Propstat->{"{$NS_D}prop"}{"{$NS_D}displayname"}{content} || $DefaultDisplayName), |
748
|
|
|
|
|
|
|
href => $href, |
749
|
|
|
|
|
|
|
color => _fixColour($Propstat->{"{$NS_D}prop"}{"{$NS_A}calendar-color"}{content}), |
750
|
|
|
|
|
|
|
timeZone => $Propstat->{"{$NS_D}prop"}{"{$NS_C}calendar-timezone"}{content}, |
751
|
|
|
|
|
|
|
isVisible => $isVisible, |
752
|
|
|
|
|
|
|
precedence => int($Propstat->{"{$NS_D}prop"}{"{$NS_A}calendar-order"}{content} || 1), |
753
|
0
|
0
|
0
|
|
|
|
syncToken => ($Propstat->{"{$NS_D}prop"}{"{$NS_D}sync-token"}{content} || ''), |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
754
|
|
|
|
|
|
|
shareWith => (@ShareWith ? \@ShareWith : $JSON::false), |
755
|
|
|
|
|
|
|
_can_event => ($CanEvent ? $JSON::true : $JSON::false), |
756
|
|
|
|
|
|
|
%Privileges, |
757
|
|
|
|
|
|
|
); |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
|
760
|
0
|
|
|
|
|
|
push @Calendars, \%Cal; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
|
return \@Calendars; |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head2 $self->NewCalendar($Args) |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Create a new calendar. The Args are the as the things returned by GetCalendars, |
770
|
|
|
|
|
|
|
except that if you don't provide 'id' (same as shorturl), then a UUID will be |
771
|
|
|
|
|
|
|
generated for you. It's recommended to not provide 'id' unless you need to |
772
|
|
|
|
|
|
|
create a specific path for compatibility with other things, and to use 'name' |
773
|
|
|
|
|
|
|
to identify the calendar for users. 'name' is stored as DAV:displayname. |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
e.g. |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
my $Id = $CalDAV->NewCalendar({name => 'My Calendar', color => 'aqua'}); |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
(Color names will be translated based on the CSS name list) |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=cut |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
sub NewCalendar { |
784
|
0
|
|
|
0
|
1
|
|
my ($Self, $Args) = @_; |
785
|
|
|
|
|
|
|
|
786
|
0
|
0
|
|
|
|
|
unless (ref($Args) eq 'HASH') { |
787
|
0
|
|
|
|
|
|
confess 'Invalid calendar'; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
# The URL should be "/$calendarId/" but this isn't true with Zimbra (Yahoo! |
791
|
|
|
|
|
|
|
# Calendar). It will accept a MKCALENDAR at "/$calendarId/" but will rewrite |
792
|
|
|
|
|
|
|
# the calendar's URL to be "/$HTMLEscapedDisplayName/". I'm sure MKCALENDAR |
793
|
|
|
|
|
|
|
# should follow WebDAV's MKCOL method here, but it's not specified in CalDAV. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# default values |
796
|
0
|
|
0
|
|
|
|
$Args->{id} //= $Self->genuuid(); |
797
|
0
|
|
0
|
|
|
|
$Args->{name} //= $DefaultDisplayName; |
798
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
|
my $calendarId = $Args->{id}; |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
|
my @Properties; |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
|
push @Properties, x('D:displayname', $Args->{name}); |
804
|
|
|
|
|
|
|
|
805
|
0
|
0
|
|
|
|
|
if (exists $Args->{isVisible}) { |
806
|
0
|
0
|
|
|
|
|
push @Properties, x('C:X-FM-isVisible', ($Args->{isVisible} ? 1 : 0)); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
0
|
0
|
|
|
|
|
if (exists $Args->{color}) { |
810
|
0
|
|
|
|
|
|
push @Properties, x('A:calendar-color', _fixColour($Args->{color})); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
0
|
0
|
|
|
|
|
if (exists $Args->{timeZone}) { |
814
|
0
|
|
|
|
|
|
push @Properties, x('C:calendar-timezone', $Args->{timeZone}); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
0
|
0
|
|
|
|
|
if (exists $Args->{precedence}) { |
818
|
0
|
0
|
0
|
|
|
|
unless (($Args->{precedence} // '') =~ /^\d+$/) { |
819
|
0
|
|
|
|
|
|
confess "Invalid precedence ($Args->{precedence}) (expected int >= 0)"; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
0
|
|
|
|
|
|
push @Properties, x('A:calendar-order', $Args->{precedence}); |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
$Self->Request( |
826
|
0
|
|
|
|
|
|
'MKCALENDAR', |
827
|
|
|
|
|
|
|
"$calendarId/", |
828
|
|
|
|
|
|
|
x('C:mkcalendar', $Self->NS(), |
829
|
|
|
|
|
|
|
x('D:set', |
830
|
|
|
|
|
|
|
x('D:prop', @Properties), |
831
|
|
|
|
|
|
|
), |
832
|
|
|
|
|
|
|
), |
833
|
|
|
|
|
|
|
); |
834
|
|
|
|
|
|
|
|
835
|
0
|
|
|
|
|
|
return $calendarId; |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=head2 $self->UpdateCalendar($Args) |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Like 'NewCalendar', but updates an existing calendar, and 'id' is required. |
841
|
|
|
|
|
|
|
Returns the id, just like NewCalendar. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=cut |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
sub UpdateCalendar { |
846
|
0
|
|
|
0
|
1
|
|
my ($Self, $Args, $Prev) = @_; |
847
|
|
|
|
|
|
|
|
848
|
0
|
0
|
|
|
|
|
unless (ref($Args) eq 'HASH') { |
849
|
0
|
|
|
|
|
|
confess 'Invalid calendar'; |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
0
|
|
|
|
|
|
my %Calendar = %{$Args}; |
|
0
|
|
|
|
|
|
|
853
|
0
|
|
|
|
|
|
my $calendarId = $Calendar{id}; |
854
|
|
|
|
|
|
|
|
855
|
0
|
0
|
|
|
|
|
unless ($calendarId) { |
856
|
0
|
|
|
|
|
|
confess 'Calendar not specified'; |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
0
|
|
|
|
|
|
my @Params; |
860
|
|
|
|
|
|
|
|
861
|
0
|
0
|
|
|
|
|
if (defined $Calendar{name}) { |
862
|
0
|
|
|
|
|
|
push @Params, x('D:displayname', $Calendar{name}); |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
0
|
0
|
|
|
|
|
if (defined $Calendar{color}) { |
866
|
0
|
|
|
|
|
|
push @Params, x('A:calendar-color', _fixColour($Calendar{color})); |
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
|
869
|
0
|
0
|
|
|
|
|
if (exists $Args->{timeZone}) { |
870
|
0
|
|
|
|
|
|
push @Params, x('C:calendar-timezone', $Args->{timeZone}); |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
0
|
0
|
|
|
|
|
if (exists $Calendar{isVisible}) { |
874
|
0
|
0
|
|
|
|
|
push @Params, x('C:X-FM-isVisible', $Calendar{isVisible} ? 1 : 0); |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
|
877
|
0
|
0
|
|
|
|
|
if (exists $Calendar{precedence}) { |
878
|
0
|
0
|
0
|
|
|
|
unless (($Calendar{precedence} ||'') =~ /^\d+$/) { |
879
|
0
|
|
|
|
|
|
confess "Invalid precedence ($Calendar{precedence})"; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
|
push @Params, x('A:calendar-order', $Calendar{precedence}); |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
0
|
0
|
|
|
|
|
return $calendarId unless @Params; |
886
|
|
|
|
|
|
|
|
887
|
0
|
|
|
|
|
|
$Self->Request( |
888
|
|
|
|
|
|
|
'PROPPATCH', |
889
|
|
|
|
|
|
|
"$calendarId/", |
890
|
|
|
|
|
|
|
x('D:propertyupdate', $Self->NS(), |
891
|
|
|
|
|
|
|
x('D:set', |
892
|
|
|
|
|
|
|
x('D:prop', |
893
|
|
|
|
|
|
|
@Params, |
894
|
|
|
|
|
|
|
), |
895
|
|
|
|
|
|
|
), |
896
|
|
|
|
|
|
|
), |
897
|
|
|
|
|
|
|
); |
898
|
|
|
|
|
|
|
|
899
|
0
|
|
|
|
|
|
return $calendarId; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
# Event methods |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head2 $self->DeleteEvent($Event|$href) |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
Given a single event or the href to the event, delete that event, |
907
|
|
|
|
|
|
|
delete it from the server. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
Returns true. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=cut |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub DeleteEvent { |
914
|
0
|
|
|
0
|
1
|
|
my ($Self) = shift; |
915
|
0
|
|
|
|
|
|
my ($Event) = @_; |
916
|
|
|
|
|
|
|
|
917
|
0
|
0
|
|
|
|
|
confess "Need an event" unless $Event; |
918
|
|
|
|
|
|
|
|
919
|
0
|
0
|
|
|
|
|
$Event = { href => $Event, summary => $Event } unless ref($Event) eq 'HASH'; |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
$Self->Request( |
922
|
|
|
|
|
|
|
'DELETE', |
923
|
|
|
|
|
|
|
$Event->{href}, |
924
|
0
|
|
|
|
|
|
); |
925
|
|
|
|
|
|
|
|
926
|
0
|
|
|
|
|
|
return 1; |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=head2 $self->GetEvents($calendarId, %Args) |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Fetches some or all of the events in a calendar. |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Supported args: |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
href => [] - perform a multi-get on just these fullpath urls. |
936
|
|
|
|
|
|
|
after+before => ISO8601 - date range to query |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
In scalar context returns an arrayref of events. In list context |
939
|
|
|
|
|
|
|
returns both an arrayref of events and an arrayref of errors: |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
e.g. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
my ($Events, $Errors) = $CalDAV->GetEvents('Default'); |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=cut |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
sub GetEvents { |
948
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, %Args) = @_; |
949
|
|
|
|
|
|
|
|
950
|
0
|
|
|
|
|
|
my $urls = $Self->GetEventLinks($calendarId, %Args); |
951
|
|
|
|
|
|
|
|
952
|
0
|
|
|
|
|
|
my @AllUrls = sort keys %$urls; |
953
|
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
|
my ($Events, $Errors, $Links) = $Self->GetEventsMulti($calendarId, \@AllUrls, %Args); |
955
|
|
|
|
|
|
|
|
956
|
0
|
0
|
|
|
|
|
return wantarray ? ($Events, $Errors, $Links) : $Events; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=head2 $self->GetEventsMulti($calendarId, $Urls, %Args) |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
Fetches the events in Urs from the calendar |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
Supported args: |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
* ContentType |
966
|
|
|
|
|
|
|
* Version |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
For the calendar-data response |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
In scalar context returns an arrayref of events. In list context |
971
|
|
|
|
|
|
|
returns an array of: |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
* arrayref of events |
974
|
|
|
|
|
|
|
* arrayref of errors: |
975
|
|
|
|
|
|
|
* hash of href to getetag |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=cut |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
sub GetEventsMulti { |
980
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, $Urls, %Args) = @_; |
981
|
|
|
|
|
|
|
|
982
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
983
|
|
|
|
|
|
|
|
984
|
0
|
|
|
|
|
|
my @Annotations; |
985
|
0
|
|
0
|
|
|
|
my $AnnotNames = $Args{Annotations} || []; |
986
|
0
|
|
|
|
|
|
foreach my $key (@$AnnotNames) { |
987
|
0
|
0
|
|
|
|
|
my $name = ($key =~ m/:/ ? $key : "C:$key"); |
988
|
0
|
|
|
|
|
|
push @Annotations, x($name); |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
|
my %CalProps; |
992
|
0
|
0
|
|
|
|
|
if ($Args{ContentType}) { |
993
|
0
|
|
|
|
|
|
$CalProps{'content-type'} = $Args{ContentType}; |
994
|
|
|
|
|
|
|
} |
995
|
0
|
0
|
|
|
|
|
if ($Args{Version}) { |
996
|
0
|
|
|
|
|
|
$CalProps{'version'} = $Args{Version}; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
|
999
|
0
|
|
|
|
|
|
my (@Events, @Errors, %Links); |
1000
|
|
|
|
|
|
|
|
1001
|
0
|
|
|
|
|
|
while (my @urls = splice(@$Urls, 0, $BATCHSIZE)) { |
1002
|
|
|
|
|
|
|
my $Response = $Self->Request( |
1003
|
|
|
|
|
|
|
'REPORT', |
1004
|
|
|
|
|
|
|
"$calendarId/", |
1005
|
|
|
|
|
|
|
x('C:calendar-multiget', $Self->NS(), |
1006
|
|
|
|
|
|
|
x('D:prop', |
1007
|
|
|
|
|
|
|
x('C:calendar-data', \%CalProps), |
1008
|
|
|
|
|
|
|
x('D:getetag'), |
1009
|
|
|
|
|
|
|
@Annotations, |
1010
|
|
|
|
|
|
|
), |
1011
|
0
|
|
|
|
|
|
map { x('D:href', $_) } @urls, |
|
0
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
), |
1014
|
|
|
|
|
|
|
Depth => 1, |
1015
|
|
|
|
|
|
|
); |
1016
|
|
|
|
|
|
|
|
1017
|
0
|
|
|
|
|
|
my $NS_A = $Self->ns('A'); |
1018
|
0
|
|
|
|
|
|
my $NS_C = $Self->ns('C'); |
1019
|
0
|
|
|
|
|
|
my $NS_D = $Self->ns('D'); |
1020
|
0
|
0
|
|
|
|
|
foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) { |
|
0
|
|
|
|
|
|
|
1021
|
0
|
|
0
|
|
|
|
my $href = uri_unescape($Response->{"{$NS_D}href"}{content} // ''); |
1022
|
0
|
0
|
|
|
|
|
next unless $href; |
1023
|
0
|
0
|
|
|
|
|
foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) { |
|
0
|
|
|
|
|
|
|
1024
|
0
|
|
|
|
|
|
my $etag = $Propstat->{"{$NS_D}prop"}{"{$NS_D}getetag"}{content}; |
1025
|
0
|
|
|
|
|
|
$Links{$href} = $etag; |
1026
|
0
|
|
|
|
|
|
my $Prop = $Propstat->{"{$NS_D}prop"}{"{$NS_C}calendar-data"}; |
1027
|
0
|
|
|
|
|
|
my $Data = $Prop->{content}; |
1028
|
0
|
0
|
|
|
|
|
next unless $Data; |
1029
|
|
|
|
|
|
|
|
1030
|
0
|
|
|
|
|
|
my $Event; |
1031
|
|
|
|
|
|
|
|
1032
|
0
|
0
|
0
|
|
|
|
if ($Prop->{'-content-type'} and $Prop->{'-content-type'} =~ m{application/event\+json}) { |
1033
|
|
|
|
|
|
|
# JSON event is in API format already |
1034
|
0
|
|
|
|
|
|
$Event = eval { decode_json($Data) }; |
|
0
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
else { |
1037
|
|
|
|
|
|
|
# returns an array, but there should only be one UID per file |
1038
|
0
|
|
|
|
|
|
($Event) = eval { $Self->vcalendarToEvents($Data) }; |
|
0
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
0
|
0
|
|
|
|
|
if ($@) { |
1042
|
0
|
|
|
|
|
|
push @Errors, $@; |
1043
|
0
|
|
|
|
|
|
next; |
1044
|
|
|
|
|
|
|
} |
1045
|
0
|
0
|
|
|
|
|
next unless $Event; |
1046
|
|
|
|
|
|
|
|
1047
|
0
|
0
|
|
|
|
|
if ($Args{Full}) { |
1048
|
0
|
|
|
|
|
|
$Event->{_raw} = $Data; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
0
|
|
|
|
|
|
$Event->{href} = $href; |
1052
|
0
|
|
|
|
|
|
$Event->{id} = $Self->shortpath($href); |
1053
|
|
|
|
|
|
|
|
1054
|
0
|
|
|
|
|
|
foreach my $key (@$AnnotNames) { |
1055
|
0
|
|
|
|
|
|
my $propns = $NS_C; |
1056
|
0
|
|
|
|
|
|
my $name = $key; |
1057
|
0
|
0
|
|
|
|
|
if ($key =~ m/(.*):(.*)/) { |
1058
|
0
|
|
|
|
|
|
$name = $2; |
1059
|
0
|
|
|
|
|
|
$propns = $Self->ns($1); |
1060
|
|
|
|
|
|
|
} |
1061
|
0
|
|
|
|
|
|
my $AData = $Propstat->{"{$NS_D}prop"}{"{$propns}$name"}{content}; |
1062
|
0
|
0
|
|
|
|
|
next unless $AData; |
1063
|
0
|
|
|
|
|
|
$Event->{annotation}{$name} = $AData; |
1064
|
|
|
|
|
|
|
} |
1065
|
|
|
|
|
|
|
|
1066
|
0
|
|
|
|
|
|
push @Events, $Event; |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
} |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
0
|
0
|
|
|
|
|
return wantarray ? (\@Events, \@Errors, \%Links) : \@Events; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=head2 $self->GetEventLinks($calendarId, %Args) |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
Fetches the URLs of calendar events in a calendar. |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
Supported args: |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
after+before => ISO8601 - date range to query |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
returns a hash of href to etag |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
=cut |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
sub GetEventLinks { |
1087
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, %Args) = @_; |
1088
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
1089
|
|
|
|
|
|
|
|
1090
|
0
|
|
|
|
|
|
my @Extra; |
1091
|
0
|
0
|
0
|
|
|
|
if ($Args{AlwaysRange} || $Args{after} || $Args{before}) { |
|
|
|
0
|
|
|
|
|
1092
|
0
|
|
0
|
|
|
|
my $Start = _wireDate($Args{after} || $BoT); |
1093
|
0
|
|
0
|
|
|
|
my $End = _wireDate($Args{before} || $EoT); |
1094
|
0
|
|
|
|
|
|
push @Extra, x('C:time-range', { |
1095
|
|
|
|
|
|
|
start => $Start->strftime('%Y%m%dT000000Z'), |
1096
|
|
|
|
|
|
|
end => $End->strftime('%Y%m%dT000000Z'), |
1097
|
|
|
|
|
|
|
}); |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
0
|
|
|
|
|
|
my $Response = $Self->Request( |
1101
|
|
|
|
|
|
|
'REPORT', |
1102
|
|
|
|
|
|
|
"$calendarId/", |
1103
|
|
|
|
|
|
|
x('C:calendar-query', $Self->NS(), |
1104
|
|
|
|
|
|
|
x('D:prop', |
1105
|
|
|
|
|
|
|
x('D:getetag'), |
1106
|
|
|
|
|
|
|
), |
1107
|
|
|
|
|
|
|
x('C:filter', |
1108
|
|
|
|
|
|
|
x('C:comp-filter', { name => 'VCALENDAR' }, |
1109
|
|
|
|
|
|
|
x('C:comp-filter', { name => 'VEVENT' }, |
1110
|
|
|
|
|
|
|
@Extra, |
1111
|
|
|
|
|
|
|
), |
1112
|
|
|
|
|
|
|
), |
1113
|
|
|
|
|
|
|
), |
1114
|
|
|
|
|
|
|
), |
1115
|
|
|
|
|
|
|
Depth => 1, |
1116
|
|
|
|
|
|
|
); |
1117
|
|
|
|
|
|
|
|
1118
|
0
|
|
|
|
|
|
my (%Links, @Errors); |
1119
|
|
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
|
my $NS_A = $Self->ns('A'); |
1121
|
0
|
|
|
|
|
|
my $NS_C = $Self->ns('C'); |
1122
|
0
|
|
|
|
|
|
my $NS_D = $Self->ns('D'); |
1123
|
0
|
0
|
|
|
|
|
foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) { |
|
0
|
|
|
|
|
|
|
1124
|
0
|
|
0
|
|
|
|
my $href = uri_unescape($Response->{"{$NS_D}href"}{content} // ''); |
1125
|
0
|
0
|
|
|
|
|
next unless $href; |
1126
|
0
|
0
|
|
|
|
|
foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) { |
|
0
|
|
|
|
|
|
|
1127
|
0
|
|
|
|
|
|
my $etag = $Propstat->{"{$NS_D}prop"}{"{$NS_D}getetag"}{content}; |
1128
|
0
|
|
|
|
|
|
$Links{$href} = $etag; |
1129
|
|
|
|
|
|
|
} |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
0
|
|
|
|
|
|
return \%Links; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
=head2 $self->GetEvent($href) |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
Just get a single event (calls GetEvents with that href) |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
=cut |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
sub GetEvent { |
1142
|
0
|
|
|
0
|
1
|
|
my ($Self, $href, %Args) = @_; |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
# XXX - API |
1145
|
0
|
|
|
|
|
|
my $calendarId = $href; |
1146
|
0
|
|
|
|
|
|
$calendarId =~ s{/[^/]*$}{}; |
1147
|
|
|
|
|
|
|
|
1148
|
0
|
|
|
|
|
|
my ($Events, $Errors) = $Self->GetEventsMulti($calendarId, [$Self->fullpath($href)], %Args); |
1149
|
|
|
|
|
|
|
|
1150
|
0
|
0
|
|
|
|
|
die "Errors @$Errors" if @$Errors; |
1151
|
0
|
0
|
|
|
|
|
die "Multiple items returned for $href" if @$Events > 1; |
1152
|
|
|
|
|
|
|
|
1153
|
0
|
|
|
|
|
|
return $Events->[0]; |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=head2 $self->GetFreeBusy($calendarId, %Args) |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
Like 'GetEvents' but uses a free-busy-query and then generates |
1159
|
|
|
|
|
|
|
synthetic events out of the result. |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
Doesn't have a 'href' parameter, just the before/after range. |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=cut |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
sub GetFreeBusy { |
1166
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, %Args) = @_; |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
# validate parameters {{{ |
1169
|
|
|
|
|
|
|
|
1170
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
1171
|
|
|
|
|
|
|
|
1172
|
0
|
|
|
|
|
|
my @Query; |
1173
|
0
|
0
|
0
|
|
|
|
if ($Args{AlwaysRange} || $Args{after} || $Args{before}) { |
|
|
|
0
|
|
|
|
|
1174
|
0
|
|
0
|
|
|
|
my $Start = _wireDate($Args{after} || $BoT); |
1175
|
0
|
|
0
|
|
|
|
my $End = _wireDate($Args{before} || $EoT); |
1176
|
|
|
|
|
|
|
|
1177
|
0
|
|
|
|
|
|
push @Query, |
1178
|
|
|
|
|
|
|
x('C:time-range', { |
1179
|
|
|
|
|
|
|
start => $Start->strftime('%Y%m%dT000000Z'), |
1180
|
|
|
|
|
|
|
end => $End->strftime('%Y%m%dT000000Z'), |
1181
|
|
|
|
|
|
|
}); |
1182
|
|
|
|
|
|
|
} |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
# }}} |
1185
|
|
|
|
|
|
|
|
1186
|
0
|
|
|
|
|
|
my $Response = $Self->Request( |
1187
|
|
|
|
|
|
|
'REPORT', |
1188
|
|
|
|
|
|
|
"$calendarId/", |
1189
|
|
|
|
|
|
|
x('C:free-busy-query', $Self->NS(), |
1190
|
|
|
|
|
|
|
@Query, |
1191
|
|
|
|
|
|
|
), |
1192
|
|
|
|
|
|
|
Depth => 1, |
1193
|
|
|
|
|
|
|
); |
1194
|
|
|
|
|
|
|
|
1195
|
0
|
0
|
|
|
|
|
my $Data = eval { vcard2hash($Response->{content}, multival => ['rrule'], only_one => 1) } |
|
0
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
or confess "Error parsing VFreeBusy data: $@"; |
1197
|
|
|
|
|
|
|
|
1198
|
0
|
|
|
|
|
|
my @result; |
1199
|
|
|
|
|
|
|
my @errors; |
1200
|
0
|
|
|
|
|
|
my $now = DateTime->now(); |
1201
|
0
|
|
|
|
|
|
foreach my $item (@{$Data->{objects}[0]{objects}}) { |
|
0
|
|
|
|
|
|
|
1202
|
0
|
0
|
|
|
|
|
next unless $item->{type} eq 'vfreebusy'; |
1203
|
0
|
|
|
|
|
|
foreach my $line (@{$item->{properties}{freebusy}}) { |
|
0
|
|
|
|
|
|
|
1204
|
0
|
|
|
|
|
|
my ($Start, $End) = split '/', $line->{value}; |
1205
|
0
|
|
|
|
|
|
my ($StartTime, $IsAllDay) = $Self->_makeDateObj($Start, 'UTC', 'UTC'); |
1206
|
0
|
|
|
|
|
|
my $EndTime; |
1207
|
0
|
0
|
|
|
|
|
if ($End =~ m/^[+-]?P/i) { |
1208
|
0
|
|
0
|
|
|
|
my $Duration = eval { DateTime::Format::ICal->parse_duration(uc $End) } |
1209
|
|
|
|
|
|
|
|| next; |
1210
|
0
|
|
|
|
|
|
$EndTime = $StartTime->clone()->add($Duration); |
1211
|
|
|
|
|
|
|
} else { |
1212
|
0
|
|
|
|
|
|
($EndTime) = $Self->_makeDateObj($End, 'UTC', 'UTC'); |
1213
|
|
|
|
|
|
|
} |
1214
|
0
|
|
|
|
|
|
my $duration = $Self->_make_duration($EndTime->subtract_datetime($StartTime)); |
1215
|
|
|
|
|
|
|
my $NewEvent = { |
1216
|
|
|
|
|
|
|
timeZone => 'Etc/UTC', |
1217
|
|
|
|
|
|
|
start => $StartTime->iso8601(), |
1218
|
|
|
|
|
|
|
duration => $duration, |
1219
|
0
|
0
|
0
|
|
|
|
title => ($Args{name} // ''), |
1220
|
|
|
|
|
|
|
isAllDay => ($IsAllDay ? $JSON::true : $JSON::false), |
1221
|
|
|
|
|
|
|
updated => $now->iso8601(), |
1222
|
|
|
|
|
|
|
}; |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
# Generate a uid that should remain the same for this freebusy entry |
1225
|
0
|
|
|
|
|
|
$NewEvent->{uid} = _hexkey($NewEvent) . '-freebusyauto'; |
1226
|
|
|
|
|
|
|
$NewEvent->{isAllDay} = |
1227
|
0
|
0
|
|
|
|
|
$NewEvent->{isAllDay} ? $JSON::true : $JSON::false; |
1228
|
0
|
|
|
|
|
|
push @result, $NewEvent; |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
|
1232
|
0
|
|
|
|
|
|
warn Dumper(\@result); |
1233
|
0
|
|
|
|
|
|
return (\@result, \@errors); |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=head2 $self->SyncEvents($calendarId, %Args) |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
Like GetEvents, but if you pass a syncToken argument, then it will |
1239
|
|
|
|
|
|
|
fetch changes since that token (obtained from an earlier GetCalendars |
1240
|
|
|
|
|
|
|
call). |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
In scalar context still just returns new events, in list context returns |
1243
|
|
|
|
|
|
|
Events, Removed and Errors. |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
e.g. |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
my ($Events, $Removed, $Errors) = $CalDAV->SyncEvents('Default', syncToken => '...'); |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
=cut |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
sub SyncEvents { |
1252
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, %Args) = @_; |
1253
|
|
|
|
|
|
|
|
1254
|
0
|
|
|
|
|
|
my ($Added, $Removed, $Errors, $SyncToken) = $Self->SyncEventLinks($calendarId, %Args); |
1255
|
|
|
|
|
|
|
|
1256
|
0
|
|
|
|
|
|
my @AllUrls = sort keys %$Added; |
1257
|
|
|
|
|
|
|
|
1258
|
0
|
|
|
|
|
|
my ($Events, $ThisErrors, $Links) = $Self->GetEventsMulti($calendarId, \@AllUrls, %Args); |
1259
|
0
|
|
|
|
|
|
push @$Errors, @$ThisErrors; |
1260
|
|
|
|
|
|
|
|
1261
|
0
|
0
|
|
|
|
|
return wantarray ? ($Events, $Removed, $Errors, $SyncToken, $Links) : $Events; |
1262
|
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub SyncEventLinks { |
1265
|
0
|
|
|
0
|
0
|
|
my ($Self, $calendarId, %Args) = @_; |
1266
|
|
|
|
|
|
|
|
1267
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
my $Response = $Self->Request( |
1270
|
|
|
|
|
|
|
'REPORT', |
1271
|
|
|
|
|
|
|
"$calendarId/", |
1272
|
|
|
|
|
|
|
x('D:sync-collection', $Self->NS(), |
1273
|
0
|
0
|
|
|
|
|
x('D:sync-token', ($Args{syncToken} ? ($Args{syncToken}) : ())), |
1274
|
|
|
|
|
|
|
x('D:sync-level', 1), |
1275
|
|
|
|
|
|
|
x('D:prop', |
1276
|
|
|
|
|
|
|
x('D:getetag'), |
1277
|
|
|
|
|
|
|
), |
1278
|
|
|
|
|
|
|
), |
1279
|
|
|
|
|
|
|
); |
1280
|
|
|
|
|
|
|
|
1281
|
0
|
|
|
|
|
|
my $NS_A = $Self->ns('A'); |
1282
|
0
|
|
|
|
|
|
my $NS_C = $Self->ns('C'); |
1283
|
0
|
|
|
|
|
|
my $NS_D = $Self->ns('D'); |
1284
|
|
|
|
|
|
|
|
1285
|
0
|
|
|
|
|
|
my $SyncToken = $Response->{"{$NS_D}sync-token"}{content}; |
1286
|
0
|
0
|
|
|
|
|
confess "NO SYNC TOKEN RETURNED " . Dumper($Response) unless $SyncToken; |
1287
|
|
|
|
|
|
|
|
1288
|
0
|
|
|
|
|
|
my (%Added, @Removed, @Errors); |
1289
|
0
|
0
|
|
|
|
|
foreach my $Response (@{$Response->{"{$NS_D}response"} || []}) { |
|
0
|
|
|
|
|
|
|
1290
|
0
|
|
0
|
|
|
|
my $href = uri_unescape($Response->{"{$NS_D}href"}{content} // ''); |
1291
|
0
|
0
|
|
|
|
|
next unless $href; |
1292
|
|
|
|
|
|
|
|
1293
|
0
|
0
|
|
|
|
|
unless ($Response->{"{$NS_D}propstat"}) { |
1294
|
0
|
|
|
|
|
|
push @Removed, $href; |
1295
|
0
|
|
|
|
|
|
next; |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
|
1298
|
0
|
0
|
|
|
|
|
foreach my $Propstat (@{$Response->{"{$NS_D}propstat"} || []}) { |
|
0
|
|
|
|
|
|
|
1299
|
0
|
|
|
|
|
|
my $status = $Propstat->{"{$NS_D}status"}{content}; |
1300
|
0
|
0
|
|
|
|
|
if ($status =~ m/ 200 /) { |
1301
|
0
|
|
|
|
|
|
my $etag = $Propstat->{"{$NS_D}prop"}{"{$NS_D}getetag"}{content}; |
1302
|
0
|
|
|
|
|
|
$Added{$href} = $etag; |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
else { |
1305
|
0
|
|
|
|
|
|
push @Errors, "Odd status $status"; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
0
|
|
|
|
|
|
return (\%Added, \@Removed, \@Errors, $SyncToken); |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
=head2 $self->NewEvent($calendarId, $Args) |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
Create a new event in the named calendar. If you don't specify 'uid' then |
1316
|
|
|
|
|
|
|
a UUID will be created. You should only specify the UID if you need to for |
1317
|
|
|
|
|
|
|
syncing purposes - it's better to auto-generate otherwise. |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
Returns the href, but also updates 'uid' in $Args. |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
Also updates 'sequence'. |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
e.g. |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
my $href = $CalDAV->NewEvent('Default', $Args); |
1326
|
|
|
|
|
|
|
my $newuid = $Args->{uid}; |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
=cut |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
sub NewEvent { |
1331
|
0
|
|
|
0
|
1
|
|
my ($Self, $calendarId, $Args) = @_; |
1332
|
|
|
|
|
|
|
|
1333
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
1334
|
|
|
|
|
|
|
|
1335
|
0
|
0
|
|
|
|
|
confess "invalid event" unless ref($Args) eq 'HASH'; |
1336
|
|
|
|
|
|
|
|
1337
|
0
|
|
|
|
|
|
my $UseEvent = delete $Args->{_put_event_json}; |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
# calculate updated sequence numbers |
1340
|
0
|
0
|
|
|
|
|
unless (exists $Args->{sequence}) { |
1341
|
0
|
|
|
|
|
|
$Args->{sequence} = 1; |
1342
|
|
|
|
|
|
|
} |
1343
|
|
|
|
|
|
|
|
1344
|
0
|
0
|
|
|
|
|
if ($Args->{exceptions}) { |
1345
|
0
|
|
|
|
|
|
foreach my $recurrenceId (sort keys %{$Args->{exceptions}}) { |
|
0
|
|
|
|
|
|
|
1346
|
0
|
|
|
|
|
|
my $val = $Args->{exceptions}{$recurrenceId}; |
1347
|
0
|
0
|
|
|
|
|
next unless $val; |
1348
|
0
|
0
|
|
|
|
|
next if exists $val->{sequence}; |
1349
|
|
|
|
|
|
|
|
1350
|
0
|
|
|
|
|
|
$val->{sequence} = $Args->{sequence}; |
1351
|
|
|
|
|
|
|
} |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
|
1354
|
0
|
|
0
|
|
|
|
$Args->{uid} //= $Self->genuuid(); |
1355
|
0
|
|
|
|
|
|
my $uid = $Args->{uid}; |
1356
|
0
|
|
|
|
|
|
my $path = $uid; |
1357
|
0
|
|
|
|
|
|
$path =~ tr/[a-zA-Z0-9\@\.\_\-]//cd; |
1358
|
0
|
|
|
|
|
|
my $href = "$calendarId/$path.ics"; |
1359
|
|
|
|
|
|
|
|
1360
|
0
|
0
|
|
|
|
|
if ($UseEvent) { |
1361
|
0
|
|
|
|
|
|
$Self->Request( |
1362
|
|
|
|
|
|
|
'PUT', |
1363
|
|
|
|
|
|
|
$href, |
1364
|
|
|
|
|
|
|
encode_json($Args), |
1365
|
|
|
|
|
|
|
'Content-Type' => 'application/event+json', |
1366
|
|
|
|
|
|
|
); |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
else { |
1369
|
0
|
|
|
|
|
|
my $VCalendar = $Self->_argsToVCalendar($Args); |
1370
|
0
|
|
|
|
|
|
$Self->Request( |
1371
|
|
|
|
|
|
|
'PUT', |
1372
|
|
|
|
|
|
|
$href, |
1373
|
|
|
|
|
|
|
$VCalendar->as_string(), |
1374
|
|
|
|
|
|
|
'Content-Type' => 'text/calendar', |
1375
|
|
|
|
|
|
|
); |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
|
1378
|
0
|
|
|
|
|
|
return $href; |
1379
|
|
|
|
|
|
|
} |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=head2 $self->UpdateEvent($href, $Args) |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
Like NewEvent, but you only need to specify keys that you want to change, |
1384
|
|
|
|
|
|
|
and it takes the full href to the card instead of the containing calendar. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
=cut |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
sub UpdateEvent { |
1389
|
0
|
|
|
0
|
1
|
|
my ($Self, $href, $Args) = @_; |
1390
|
|
|
|
|
|
|
|
1391
|
0
|
|
|
|
|
|
my $UseEvent = delete $Args->{_put_event_json}; |
1392
|
|
|
|
|
|
|
|
1393
|
0
|
|
|
|
|
|
my ($OldEvent, $NewEvent) = $Self->_updateEvent($href, $Args); |
1394
|
|
|
|
|
|
|
|
1395
|
0
|
0
|
|
|
|
|
if ($UseEvent) { |
1396
|
0
|
|
|
|
|
|
$Self->Request( |
1397
|
|
|
|
|
|
|
'PUT', |
1398
|
|
|
|
|
|
|
$href, |
1399
|
|
|
|
|
|
|
encode_json($NewEvent), |
1400
|
|
|
|
|
|
|
'Content-Type' => 'application/event+json', |
1401
|
|
|
|
|
|
|
); |
1402
|
|
|
|
|
|
|
} |
1403
|
|
|
|
|
|
|
else { |
1404
|
0
|
|
|
|
|
|
my $VCalendar = $Self->_argsToVCalendar($NewEvent); |
1405
|
0
|
|
|
|
|
|
$Self->Request( |
1406
|
|
|
|
|
|
|
'PUT', |
1407
|
|
|
|
|
|
|
$href, |
1408
|
|
|
|
|
|
|
$VCalendar->as_string(), |
1409
|
|
|
|
|
|
|
'Content-Type' => 'text/calendar', |
1410
|
|
|
|
|
|
|
); |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
|
1413
|
0
|
|
|
|
|
|
return 1; |
1414
|
|
|
|
|
|
|
} |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
sub _updateEvent { |
1417
|
0
|
|
|
0
|
|
|
my ($Self, $href, $Args) = @_; |
1418
|
|
|
|
|
|
|
|
1419
|
0
|
|
|
|
|
|
my $OldEvent = $Self->GetEvent($href); |
1420
|
|
|
|
|
|
|
|
1421
|
0
|
0
|
|
|
|
|
confess "Error getting old event for $href" |
1422
|
|
|
|
|
|
|
unless $OldEvent; |
1423
|
|
|
|
|
|
|
|
1424
|
0
|
|
|
|
|
|
my %NewEvent; |
1425
|
|
|
|
|
|
|
|
1426
|
0
|
|
|
|
|
|
foreach my $Property (keys %EventKeys) { |
1427
|
0
|
0
|
|
|
|
|
if (exists $Args->{$Property}) { |
|
|
0
|
|
|
|
|
|
1428
|
0
|
0
|
|
|
|
|
if (defined $Args->{$Property}) { |
1429
|
0
|
|
|
|
|
|
$NewEvent{$Property} = $Args->{$Property}; |
1430
|
|
|
|
|
|
|
} |
1431
|
|
|
|
|
|
|
} |
1432
|
|
|
|
|
|
|
elsif (exists $OldEvent->{$Property}) { |
1433
|
0
|
|
|
|
|
|
$NewEvent{$Property} = $OldEvent->{$Property}; |
1434
|
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
# calculate updated sequence numbers |
1438
|
0
|
0
|
|
|
|
|
unless (exists $Args->{sequence}) { |
1439
|
0
|
|
0
|
|
|
|
$NewEvent{sequence} = ($OldEvent->{sequence} || 0) + 1; |
1440
|
|
|
|
|
|
|
} |
1441
|
|
|
|
|
|
|
|
1442
|
0
|
0
|
|
|
|
|
if ($NewEvent{exceptions}) { |
1443
|
0
|
|
|
|
|
|
foreach my $recurrenceId (sort keys %{$NewEvent{exceptions}}) { |
|
0
|
|
|
|
|
|
|
1444
|
0
|
|
|
|
|
|
my $val = $NewEvent{exceptions}{$recurrenceId}; |
1445
|
0
|
0
|
|
|
|
|
next unless $val; |
1446
|
0
|
0
|
|
|
|
|
next if exists $val->{sequence}; |
1447
|
|
|
|
|
|
|
|
1448
|
0
|
|
|
|
|
|
my $old = $OldEvent->{exceptions}{$recurrenceId}; |
1449
|
0
|
|
|
|
|
|
my $sequence = $NewEvent{sequence}; |
1450
|
0
|
0
|
0
|
|
|
|
if ($old && exists $old->{sequence}) { |
1451
|
0
|
0
|
|
|
|
|
$sequence = $old->{sequence} + 1 unless $sequence > $old->{sequence}; |
1452
|
|
|
|
|
|
|
} |
1453
|
0
|
|
|
|
|
|
$val->{sequence} = $sequence; |
1454
|
|
|
|
|
|
|
} |
1455
|
|
|
|
|
|
|
} |
1456
|
|
|
|
|
|
|
|
1457
|
0
|
|
|
|
|
|
$NewEvent{href} = $href; |
1458
|
|
|
|
|
|
|
|
1459
|
0
|
|
|
|
|
|
return ($OldEvent, \%NewEvent); |
1460
|
|
|
|
|
|
|
} |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=head2 $self->AnnotateEvent($href, $Args) |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
Instead of actually changing an event itself, use proppatch to |
1465
|
|
|
|
|
|
|
add or remove properties on the event. |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
=cut |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
sub AnnotateEvent { |
1470
|
0
|
|
|
0
|
1
|
|
my ($Self, $href, $Args) = @_; |
1471
|
|
|
|
|
|
|
|
1472
|
0
|
|
|
|
|
|
my $OldEvent = $Self->GetEvent($href); |
1473
|
|
|
|
|
|
|
|
1474
|
0
|
0
|
|
|
|
|
confess "Error getting old event for $href" |
1475
|
|
|
|
|
|
|
unless $OldEvent; |
1476
|
|
|
|
|
|
|
|
1477
|
0
|
|
|
|
|
|
my @Set; |
1478
|
|
|
|
|
|
|
my @Remove; |
1479
|
0
|
|
|
|
|
|
foreach my $key (sort keys %$Args) { |
1480
|
0
|
0
|
|
|
|
|
my $name = ($key =~ m/:/ ? $key : "C:$key"); |
1481
|
0
|
0
|
|
|
|
|
if (defined $Args->{$key}) { |
1482
|
0
|
|
|
|
|
|
push @Set, x($name, $Args->{$key}); |
1483
|
|
|
|
|
|
|
} |
1484
|
|
|
|
|
|
|
else { |
1485
|
0
|
|
|
|
|
|
push @Remove, x($name); |
1486
|
|
|
|
|
|
|
} |
1487
|
|
|
|
|
|
|
} |
1488
|
|
|
|
|
|
|
|
1489
|
0
|
|
|
|
|
|
my @Params; |
1490
|
0
|
0
|
|
|
|
|
push @Params, x('D:set', x('D:prop', @Set)) if @Set; |
1491
|
0
|
0
|
|
|
|
|
push @Params, x('D:remove', x('D:prop', @Remove)) if @Remove; |
1492
|
0
|
0
|
|
|
|
|
return undef unless @Params; |
1493
|
|
|
|
|
|
|
|
1494
|
0
|
|
|
|
|
|
$Self->Request( |
1495
|
|
|
|
|
|
|
'PROPPATCH', |
1496
|
|
|
|
|
|
|
$href, |
1497
|
|
|
|
|
|
|
x('D:propertyupdate', $Self->NS(), @Params), |
1498
|
|
|
|
|
|
|
); |
1499
|
|
|
|
|
|
|
|
1500
|
0
|
|
|
|
|
|
return 1; |
1501
|
|
|
|
|
|
|
} |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
=head2 $self->MoveEvent($href, $newCalendarId) |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
Move an event into a new calendar. Returns the new href. |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=cut |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
sub MoveEvent { |
1510
|
0
|
|
|
0
|
1
|
|
my ($Self, $href, $newCalendarId) = @_; |
1511
|
|
|
|
|
|
|
|
1512
|
0
|
|
|
|
|
|
my $OldEvent = $Self->GetEvent($href); |
1513
|
|
|
|
|
|
|
|
1514
|
0
|
0
|
|
|
|
|
return unless $OldEvent; |
1515
|
|
|
|
|
|
|
|
1516
|
0
|
|
|
|
|
|
my $dest = $href; |
1517
|
0
|
|
|
|
|
|
$dest =~ s{.*/}{$newCalendarId/}; |
1518
|
0
|
0
|
|
|
|
|
return if $href eq $dest; |
1519
|
|
|
|
|
|
|
|
1520
|
0
|
|
|
|
|
|
$Self->Request( |
1521
|
|
|
|
|
|
|
'MOVE', |
1522
|
|
|
|
|
|
|
$href, |
1523
|
|
|
|
|
|
|
undef, |
1524
|
|
|
|
|
|
|
'Destination' => $Self->fullpath($dest), |
1525
|
|
|
|
|
|
|
); |
1526
|
|
|
|
|
|
|
|
1527
|
0
|
|
|
|
|
|
warn "CAL: MoveEvent $Self->{user} ($href => $dest)\n"; |
1528
|
|
|
|
|
|
|
|
1529
|
0
|
|
|
|
|
|
return $dest; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
sub _BYDAY2byDay { |
1533
|
0
|
|
|
0
|
|
|
my ($BYDAY) = @_; |
1534
|
|
|
|
|
|
|
|
1535
|
0
|
|
|
|
|
|
my ($Count, $Day) = $BYDAY =~ /^([-+]?\d+)?(\w\w)$/; |
1536
|
|
|
|
|
|
|
|
1537
|
0
|
0
|
|
|
|
|
unless ($Day) { |
1538
|
0
|
|
|
|
|
|
confess 'Recurrence BYDAY-weekday not specified'; |
1539
|
|
|
|
|
|
|
} |
1540
|
|
|
|
|
|
|
|
1541
|
0
|
0
|
|
|
|
|
unless ($WeekDayNames{$Day}) { |
1542
|
0
|
|
|
|
|
|
confess 'Invalid recurrence BYDAY-weekday'; |
1543
|
|
|
|
|
|
|
} |
1544
|
|
|
|
|
|
|
|
1545
|
0
|
0
|
|
|
|
|
if ($Count) { |
1546
|
0
|
0
|
0
|
|
|
|
unless (($Count >= -53) and ($Count <= 53)) { |
1547
|
0
|
|
|
|
|
|
confess 'Recurrence BYDAY-ordwk is out of range'; |
1548
|
|
|
|
|
|
|
} |
1549
|
|
|
|
|
|
|
} |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
return { |
1552
|
0
|
0
|
|
|
|
|
day => $WeekDayNames{$Day}, |
1553
|
|
|
|
|
|
|
$Count ? (nthOfPeriod => int($Count)) : (), |
1554
|
|
|
|
|
|
|
}; |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
sub _byDay2BYDAY { |
1558
|
0
|
|
|
0
|
|
|
my ($byDay) = @_; |
1559
|
|
|
|
|
|
|
|
1560
|
0
|
0
|
|
|
|
|
unless (defined $byDay) { |
1561
|
0
|
|
|
|
|
|
confess 'Invalid recurrence byDay'; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
0
|
0
|
|
|
|
|
unless (ref $byDay eq 'HASH') { |
1565
|
0
|
|
|
|
|
|
confess 'Recurrence byDay is not an object'; |
1566
|
|
|
|
|
|
|
} |
1567
|
|
|
|
|
|
|
|
1568
|
0
|
|
|
|
|
|
my $Day = $WeekDayNamesReverse{$byDay->{day}}; |
1569
|
0
|
0
|
|
|
|
|
unless ($Day) { |
1570
|
0
|
|
|
|
|
|
confess 'Recurrence byDay is not a known day'; |
1571
|
|
|
|
|
|
|
} |
1572
|
0
|
|
|
|
|
|
my $Prefix = ''; |
1573
|
0
|
0
|
|
|
|
|
$Prefix = int($byDay->{nthOfPeriod}) if $byDay->{nthOfPeriod}; |
1574
|
|
|
|
|
|
|
|
1575
|
0
|
|
|
|
|
|
return $Prefix . uc($Day); |
1576
|
|
|
|
|
|
|
} |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
sub _makeDateObj { |
1579
|
0
|
|
|
0
|
|
|
my $Self = shift; |
1580
|
0
|
|
|
|
|
|
my $DateStr = shift; |
1581
|
0
|
|
|
|
|
|
my $TZStr = shift; |
1582
|
0
|
|
|
|
|
|
my $TargetTz = shift; |
1583
|
|
|
|
|
|
|
|
1584
|
0
|
|
|
|
|
|
my ($Date, $HasTime) = _vDate($DateStr); |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
# if it's all day, return it immediately |
1587
|
0
|
0
|
|
|
|
|
return ($Date, 1) unless $HasTime; |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
# Do the timezone manipulation as required |
1590
|
0
|
0
|
|
|
|
|
$Date->set_time_zone($Self->tz($TZStr)) if $TZStr; |
1591
|
0
|
0
|
|
|
|
|
$Date->set_time_zone($Self->tz($TargetTz)) if $TargetTz; |
1592
|
|
|
|
|
|
|
|
1593
|
0
|
|
|
|
|
|
return ($Date, 0); |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
sub _getDateObj { |
1597
|
0
|
|
|
0
|
|
|
my $Self = shift; |
1598
|
0
|
|
|
|
|
|
my $Calendar = shift; |
1599
|
0
|
|
|
|
|
|
my $VItem = shift; |
1600
|
0
|
|
|
|
|
|
my $TargetTz = shift; |
1601
|
|
|
|
|
|
|
|
1602
|
0
|
|
|
|
|
|
my $TimeZone = $Self->_getTimeZone($Calendar, $VItem); |
1603
|
0
|
|
|
|
|
|
my ($Date, $IsAllDay) = $Self->_makeDateObj($VItem->{value}, $TimeZone, $TargetTz); |
1604
|
|
|
|
|
|
|
|
1605
|
0
|
0
|
|
|
|
|
return (wantarray ? ($Date, $TimeZone, $IsAllDay) : $Date); |
1606
|
|
|
|
|
|
|
} |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
sub _getDateObjMulti { |
1609
|
0
|
|
|
0
|
|
|
my $Self = shift; |
1610
|
0
|
|
|
|
|
|
my $Calendar = shift; |
1611
|
0
|
|
|
|
|
|
my $VItem = shift; |
1612
|
0
|
|
|
|
|
|
my $TargetTz = shift; |
1613
|
|
|
|
|
|
|
|
1614
|
0
|
|
|
|
|
|
my @Dates; |
1615
|
|
|
|
|
|
|
|
1616
|
0
|
|
|
|
|
|
my $TimeZone = $Self->_getTimeZone($Calendar, $VItem); |
1617
|
0
|
|
|
|
|
|
foreach my $Value (split /,/, $VItem->{value}) { |
1618
|
|
|
|
|
|
|
# XXX - handle $V2 sanely |
1619
|
0
|
0
|
0
|
|
|
|
if (lc($VItem->{params}{value}[0] || '') eq 'period') { |
1620
|
0
|
|
|
|
|
|
($Value, my $V2) = split /\//, $Value; |
1621
|
|
|
|
|
|
|
} |
1622
|
0
|
|
|
|
|
|
my ($Date, $IsAllDay) = $Self->_makeDateObj($Value, $TimeZone, $TargetTz); |
1623
|
0
|
|
|
|
|
|
push @Dates, $Date; |
1624
|
|
|
|
|
|
|
} |
1625
|
|
|
|
|
|
|
|
1626
|
0
|
|
|
|
|
|
return @Dates; |
1627
|
|
|
|
|
|
|
} |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
# Exclude DTSTAMP from auto uid generation |
1630
|
|
|
|
|
|
|
sub _hexkey { |
1631
|
0
|
|
|
0
|
|
|
my $VEvent = shift; |
1632
|
0
|
|
|
|
|
|
my $updated = delete $VEvent->{properties}->{updated}; |
1633
|
0
|
|
|
|
|
|
my $d = Data::Dumper->new([$VEvent]); |
1634
|
0
|
|
|
|
|
|
$d->Indent(0); |
1635
|
0
|
|
|
|
|
|
$d->Sortkeys(1); |
1636
|
0
|
|
|
|
|
|
my $Key = sha1_hex($d->Dump()); |
1637
|
0
|
0
|
|
|
|
|
$VEvent->{properties}->{updated} = $updated if defined $updated; |
1638
|
0
|
|
|
|
|
|
return $Key; |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
sub _saneuid { |
1642
|
0
|
|
|
0
|
|
|
my $uid = shift; |
1643
|
0
|
0
|
|
|
|
|
return unless $uid; |
1644
|
0
|
0
|
|
|
|
|
return if $uid =~ m/\s/; |
1645
|
0
|
0
|
|
|
|
|
return if $uid =~ m/[\x7f-\xff]/; |
1646
|
|
|
|
|
|
|
# any other sanity checks? |
1647
|
0
|
|
|
|
|
|
return 1; |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
sub _makeParticipant { |
1651
|
0
|
|
|
0
|
|
|
my ($Self, $Calendar, $Participants, $VAttendee, $role) = @_; |
1652
|
|
|
|
|
|
|
|
1653
|
0
|
|
|
|
|
|
my $id = $VAttendee->{value}; |
1654
|
0
|
0
|
|
|
|
|
return unless $id; |
1655
|
0
|
|
|
|
|
|
$id =~ s/^mailto://i; |
1656
|
0
|
0
|
|
|
|
|
return if $id eq ''; |
1657
|
|
|
|
|
|
|
|
1658
|
0
|
|
0
|
|
|
|
$Participants->{$id} ||= {}; |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
# XXX - if present on one but not the other, take the "best" version |
1661
|
0
|
|
0
|
|
|
|
$Participants->{$id}{name} = $VAttendee->{params}{"cn"}[0] // ""; |
1662
|
0
|
|
|
|
|
|
$Participants->{$id}{email} = $id; |
1663
|
|
|
|
|
|
|
$Participants->{$id}{kind} = lc $VAttendee->{params}{"cutype"}[0] |
1664
|
0
|
0
|
|
|
|
|
if $VAttendee->{params}{"cutype"}; |
1665
|
0
|
|
|
|
|
|
push @{$Participants->{$id}{roles}}, $role; |
|
0
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
# we don't support locationId yet |
1667
|
0
|
0
|
|
|
|
|
if ($VAttendee->{params}{"partstat"}) { |
1668
|
0
|
|
0
|
|
|
|
$Participants->{$id}{scheduleStatus} = lc($VAttendee->{params}{"partstat"}[0] // "needs-action"); |
1669
|
|
|
|
|
|
|
} |
1670
|
0
|
0
|
|
|
|
|
if ($VAttendee->{params}{"role"}) { |
1671
|
0
|
|
|
|
|
|
push @{$Participants->{$id}{roles}}, 'chair' |
1672
|
0
|
0
|
|
|
|
|
if uc $VAttendee->{params}{"role"}[0] eq 'CHAIR'; |
1673
|
|
|
|
|
|
|
$Participants->{$id}{schedulePriority} = 'optional' |
1674
|
0
|
0
|
|
|
|
|
if uc $VAttendee->{params}{"role"}[0] eq 'OPT-PARTICIPANT'; |
1675
|
|
|
|
|
|
|
$Participants->{$id}{schedulePriority} = 'non-participant' |
1676
|
0
|
0
|
|
|
|
|
if uc $VAttendee->{params}{"role"}[0] eq 'NON-PARTICIPANT'; |
1677
|
|
|
|
|
|
|
} |
1678
|
0
|
0
|
|
|
|
|
if ($VAttendee->{params}{"rsvp"}) { |
1679
|
0
|
0
|
0
|
|
|
|
$Participants->{$id}{scheduleRSVP} = lc($VAttendee->{params}{"rsvp"}[0] // "") eq 'yes' ? $JSON::true : $JSON::false; |
1680
|
|
|
|
|
|
|
} |
1681
|
0
|
0
|
|
|
|
|
if (exists $VAttendee->{params}{"x-dtstamp"}) { |
1682
|
0
|
|
|
|
|
|
my ($Date) = eval { $Self->_makeDateObj($VAttendee->{params}{"x-dtstamp"}[0], 'UTC', 'UTC') }; |
|
0
|
|
|
|
|
|
|
1683
|
0
|
0
|
|
|
|
|
$Participants->{$id}{"scheduleUpdated"} = $Date->iso8601() . 'Z' if $Date; |
1684
|
|
|
|
|
|
|
} |
1685
|
|
|
|
|
|
|
# memberOf is not supported |
1686
|
|
|
|
|
|
|
|
1687
|
0
|
0
|
|
|
|
|
if (exists $VAttendee->{params}{"x-sequence"}) { |
1688
|
0
|
|
0
|
|
|
|
$Participants->{$id}{"x-sequence"} = $VAttendee->{params}{"x-sequence"}[0] // ""; |
1689
|
|
|
|
|
|
|
} |
1690
|
|
|
|
|
|
|
} |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
sub _make_duration { |
1693
|
0
|
|
|
0
|
|
|
my ($Self, $dtdur, $IsAllDay) = @_; |
1694
|
|
|
|
|
|
|
|
1695
|
0
|
|
|
|
|
|
my ($w, $d, $H, $M, $S) = ( |
1696
|
|
|
|
|
|
|
$dtdur->weeks, |
1697
|
|
|
|
|
|
|
$dtdur->days, |
1698
|
|
|
|
|
|
|
$dtdur->hours, |
1699
|
|
|
|
|
|
|
$dtdur->minutes, |
1700
|
|
|
|
|
|
|
$dtdur->seconds, |
1701
|
|
|
|
|
|
|
); |
1702
|
|
|
|
|
|
|
|
1703
|
0
|
0
|
0
|
|
|
|
return 'PT0S' unless ($w || $d || $H || $M || $S); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1704
|
|
|
|
|
|
|
|
1705
|
0
|
|
|
|
|
|
my @bits = ('P'); |
1706
|
0
|
0
|
|
|
|
|
push @bits, ($w, 'W') if $w; |
1707
|
0
|
0
|
|
|
|
|
push @bits, ($d, 'D') if $d; |
1708
|
0
|
0
|
0
|
|
|
|
if (not $IsAllDay and ($H || $M || $S)) { |
|
|
|
0
|
|
|
|
|
1709
|
0
|
|
|
|
|
|
push @bits, 'T'; |
1710
|
0
|
0
|
|
|
|
|
push @bits, ($H, 'H') if $H; |
1711
|
0
|
0
|
|
|
|
|
push @bits, ($M, 'M') if $M; |
1712
|
0
|
0
|
|
|
|
|
push @bits, ($S, 'S') if $S; |
1713
|
|
|
|
|
|
|
} |
1714
|
|
|
|
|
|
|
|
1715
|
0
|
|
|
|
|
|
return join ('', @bits); |
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head2 $NewEvent = Net::CalDAVTalk->NormaliseEvent($Event); |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
Doesn't change the original event, but removes any keys which are the same as their default value |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
=cut |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
sub NormaliseEvent { |
1725
|
0
|
|
|
0
|
1
|
|
my ($class, $Event, $Root) = @_; |
1726
|
|
|
|
|
|
|
|
1727
|
0
|
|
0
|
|
|
|
$Root ||= ''; |
1728
|
|
|
|
|
|
|
|
1729
|
0
|
|
|
|
|
|
my %Copy = %$Event; |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
# XXX: patches need to be normalised as well... |
1732
|
0
|
|
|
|
|
|
my $Spec = $EventKeys{$Root}; |
1733
|
0
|
|
|
|
|
|
foreach my $key (keys %$Event) { |
1734
|
0
|
0
|
|
|
|
|
delete $Copy{$key} unless $Spec->{$key}; |
1735
|
|
|
|
|
|
|
} |
1736
|
0
|
|
|
|
|
|
foreach my $key (sort keys %$Spec) { |
1737
|
|
|
|
|
|
|
# remove if it's the default |
1738
|
0
|
0
|
|
|
|
|
if ($Spec->{$key}[1] eq 'object') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1739
|
0
|
|
|
|
|
|
my $Item = delete $Copy{$key}; |
1740
|
0
|
0
|
|
|
|
|
next unless $Item; # no object |
1741
|
0
|
0
|
|
|
|
|
if ($Spec->{$key}[0]) { |
1742
|
0
|
|
|
|
|
|
$Copy{$key} = [map { $class->NormaliseEvent($_, $key) } @$Item]; |
|
0
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
} |
1744
|
|
|
|
|
|
|
else { |
1745
|
0
|
|
|
|
|
|
$Copy{$key} = $class->NormaliseEvent($Item, $key); |
1746
|
|
|
|
|
|
|
} |
1747
|
|
|
|
|
|
|
} |
1748
|
|
|
|
|
|
|
elsif ($Spec->{$key}[1] eq 'bool') { |
1749
|
0
|
0
|
|
|
|
|
delete $Copy{$key} if !!$Spec->{$key}[3] == !!$Copy{$key}; |
1750
|
|
|
|
|
|
|
} |
1751
|
|
|
|
|
|
|
elsif ($Spec->{$key}[1] eq 'mailto') { |
1752
|
0
|
0
|
|
|
|
|
$Copy{$key} = lc $Copy{$key} if $Copy{$key}; |
1753
|
|
|
|
|
|
|
} |
1754
|
|
|
|
|
|
|
else { |
1755
|
0
|
0
|
|
|
|
|
delete $Copy{$key} if _safeeq($Spec->{$key}[3], $Copy{$key}); |
1756
|
|
|
|
|
|
|
} |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
|
1759
|
0
|
|
|
|
|
|
return \%Copy; |
1760
|
|
|
|
|
|
|
} |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
=head2 Net::CalDAVTalk->CompareEvents($Event1, $Event2); |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
Returns true if the events are identical |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
=cut |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
sub CompareEvents { |
1769
|
0
|
|
|
0
|
1
|
|
my ($class, $Event1, $Event2) = @_; |
1770
|
|
|
|
|
|
|
|
1771
|
0
|
|
|
|
|
|
my $E1 = $class->NormaliseEvent($Event1); |
1772
|
0
|
|
|
|
|
|
my $E2 = $class->NormaliseEvent($Event2); |
1773
|
|
|
|
|
|
|
|
1774
|
0
|
|
|
|
|
|
return _safeeq($E1, $E2); |
1775
|
|
|
|
|
|
|
} |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
sub _getEventsFromVCalendar { |
1779
|
0
|
|
|
0
|
|
|
my ($Self, $VCalendar) = @_; |
1780
|
|
|
|
|
|
|
|
1781
|
0
|
0
|
|
|
|
|
my $CalendarData = eval { vcard2hash($VCalendar, multival => ['rrule'], only_one => 1) } |
|
0
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
or confess "Error parsing VCalendar data: $@\n\n$VCalendar"; |
1783
|
|
|
|
|
|
|
|
1784
|
0
|
|
|
|
|
|
my @Events; |
1785
|
|
|
|
|
|
|
|
1786
|
0
|
0
|
|
|
|
|
foreach my $Calendar (@{$CalendarData->{objects} || []}) { |
|
0
|
|
|
|
|
|
|
1787
|
0
|
0
|
|
|
|
|
next unless lc $Calendar->{type} eq 'vcalendar'; |
1788
|
|
|
|
|
|
|
|
1789
|
0
|
|
|
|
|
|
my $method = $Calendar->{properties}{method}[0]{value}; |
1790
|
0
|
|
|
|
|
|
my $prodid = $Calendar->{properties}{prodid}[0]{value}; |
1791
|
|
|
|
|
|
|
|
1792
|
0
|
0
|
|
|
|
|
foreach my $VEvent (@{$Calendar->{objects} || []}) { |
|
0
|
|
|
|
|
|
|
1793
|
0
|
0
|
|
|
|
|
next unless lc $VEvent->{type} eq 'vevent'; |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
# parse simple component properties {{{ |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
my %Properties |
1798
|
0
|
|
|
|
|
|
= map { $_ => $VEvent->{properties}{$_}[0] } |
1799
|
0
|
|
|
|
|
|
keys %{$VEvent->{properties}}; |
|
0
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
|
1801
|
0
|
|
|
|
|
|
my $uid = $Properties{uid}{value}; |
1802
|
|
|
|
|
|
|
# Case: UID is badly broken or missing - |
1803
|
|
|
|
|
|
|
# let's just calculate a UID based on the incoming data. This |
1804
|
|
|
|
|
|
|
# is the 'ICS sync url with no UIDs in it' case from BTS-3205, |
1805
|
|
|
|
|
|
|
# http://mozorg.cdn.mozilla.net/media/caldata/DutchHolidays.ics |
1806
|
0
|
0
|
|
|
|
|
$uid = _hexkey($VEvent) . '-syncauto' unless _saneuid($uid); |
1807
|
|
|
|
|
|
|
|
1808
|
0
|
|
0
|
|
|
|
my $ShowAsFree = (lc($Properties{transp}{value} || '')) eq 'transparent'; |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
# clean up whitespace on text fields |
1811
|
0
|
|
|
|
|
|
foreach my $Property (qw{description location summary}) { |
1812
|
0
|
0
|
|
|
|
|
next unless defined $Properties{$Property}{value}; |
1813
|
0
|
|
|
|
|
|
$Properties{$Property}{value} =~ s/^\s+//gs; |
1814
|
0
|
|
|
|
|
|
$Properties{$Property}{value} =~ s/\s+$//gs; |
1815
|
|
|
|
|
|
|
} |
1816
|
|
|
|
|
|
|
|
1817
|
0
|
|
|
|
|
|
my @description; |
1818
|
|
|
|
|
|
|
push @description, $Properties{description}{value} |
1819
|
0
|
0
|
|
|
|
|
if defined $Properties{description}{value}; |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
# }}} |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
# parse time component properties {{{ |
1824
|
|
|
|
|
|
|
|
1825
|
0
|
|
|
|
|
|
my ($IsAllDay, $Start, $StartTimeZone, $End, $EndTimeZone) = ('') x 5; |
1826
|
|
|
|
|
|
|
|
1827
|
0
|
0
|
|
|
|
|
confess "$uid: DTSTART not specified" unless defined $Properties{dtstart}{value}; |
1828
|
|
|
|
|
|
|
|
1829
|
0
|
|
|
|
|
|
($Start, $StartTimeZone, $IsAllDay) = $Self->_getDateObj($Calendar, $Properties{dtstart}); |
1830
|
|
|
|
|
|
|
|
1831
|
0
|
0
|
|
|
|
|
if (defined $Properties{dtend}{value}) { |
|
|
0
|
|
|
|
|
|
1832
|
0
|
0
|
|
|
|
|
if (defined $Properties{duration}{value}) { |
1833
|
0
|
|
|
|
|
|
warn "$uid: DTEND and DURATION cannot both be set"; |
1834
|
|
|
|
|
|
|
} |
1835
|
|
|
|
|
|
|
|
1836
|
0
|
|
|
|
|
|
($End, $EndTimeZone) = $Self->_getDateObj($Calendar, $Properties{dtend}); |
1837
|
|
|
|
|
|
|
} |
1838
|
|
|
|
|
|
|
elsif (defined $Properties{duration}{value}) { |
1839
|
0
|
|
|
|
|
|
my $Duration = DateTime::Format::ICal->parse_duration(uc $Properties{duration}{value}); |
1840
|
0
|
|
|
|
|
|
$End = $Start->clone()->add($Duration); |
1841
|
0
|
|
|
|
|
|
$EndTimeZone = $StartTimeZone; |
1842
|
|
|
|
|
|
|
} |
1843
|
|
|
|
|
|
|
else { |
1844
|
0
|
|
|
|
|
|
$End = $Start->clone(); |
1845
|
0
|
|
|
|
|
|
$EndTimeZone = $StartTimeZone; |
1846
|
|
|
|
|
|
|
} |
1847
|
|
|
|
|
|
|
|
1848
|
0
|
0
|
|
|
|
|
if (DateTime->compare($Start, $End) > 0) { |
1849
|
|
|
|
|
|
|
# swap em! |
1850
|
0
|
|
|
|
|
|
($Start, $End) = ($End, $Start); |
1851
|
0
|
|
|
|
|
|
($StartTimeZone, $EndTimeZone) = ($EndTimeZone, $StartTimeZone); |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
|
1854
|
0
|
0
|
0
|
|
|
|
if ($IsAllDay and $StartTimeZone) { |
1855
|
0
|
|
|
|
|
|
warn "$uid: AllDay event with timezone $StartTimeZone specified"; |
1856
|
|
|
|
|
|
|
} |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
# if one is set, make sure they are both set |
1859
|
0
|
|
0
|
|
|
|
$StartTimeZone ||= $EndTimeZone; |
1860
|
0
|
|
0
|
|
|
|
$EndTimeZone ||= $StartTimeZone; |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
# }}} |
1863
|
|
|
|
|
|
|
|
1864
|
0
|
|
|
|
|
|
my %Recurrence; |
1865
|
|
|
|
|
|
|
|
1866
|
0
|
0
|
|
|
|
|
if (exists $Properties{rrule}) { |
1867
|
0
|
|
|
|
|
|
my %RRULE; |
1868
|
|
|
|
|
|
|
|
1869
|
0
|
|
|
|
|
|
foreach my $RRULE (@{$Properties{rrule}{values}}) { |
|
0
|
|
|
|
|
|
|
1870
|
0
|
|
|
|
|
|
my ($Key,$Value) = split '=', $RRULE; |
1871
|
0
|
0
|
|
|
|
|
next unless defined $Value; |
1872
|
|
|
|
|
|
|
|
1873
|
0
|
|
|
|
|
|
$RRULE{lc $Key} = $Value; |
1874
|
|
|
|
|
|
|
} |
1875
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
# parse simple recurrence properties {{{ |
1877
|
|
|
|
|
|
|
|
1878
|
0
|
0
|
|
|
|
|
if (exists $RRULE{freq}) { |
1879
|
0
|
|
|
|
|
|
my $freq = lc $RRULE{freq}; |
1880
|
0
|
0
|
|
|
|
|
unless (grep { $_ eq $freq } @Frequencies) { |
|
0
|
|
|
|
|
|
|
1881
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence FREQ ($RRULE{freq})"; |
1882
|
|
|
|
|
|
|
} |
1883
|
|
|
|
|
|
|
|
1884
|
0
|
|
|
|
|
|
$Recurrence{frequency} = $freq; |
1885
|
|
|
|
|
|
|
} |
1886
|
|
|
|
|
|
|
else { |
1887
|
2
|
|
|
2
|
|
20
|
use Data::Dumper; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
11776
|
|
1888
|
0
|
|
|
|
|
|
confess "$uid: Recurrence FREQ not specified"; |
1889
|
|
|
|
|
|
|
} |
1890
|
|
|
|
|
|
|
|
1891
|
0
|
0
|
|
|
|
|
if (exists $RRULE{interval}) { |
1892
|
0
|
0
|
|
|
|
|
unless ($RRULE{interval} =~ /^\d+$/) { |
1893
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence INTERVAL ($RRULE{interval})"; |
1894
|
|
|
|
|
|
|
} |
1895
|
0
|
|
|
|
|
|
my $interval = int $RRULE{interval}; |
1896
|
|
|
|
|
|
|
|
1897
|
0
|
0
|
|
|
|
|
if ($interval == 0) { |
1898
|
0
|
|
|
|
|
|
confess "$uid: Recurrence INTERVAL is out of range ($RRULE{interval})"; |
1899
|
|
|
|
|
|
|
} |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
# default == 1, so don't set a key for it |
1902
|
0
|
0
|
|
|
|
|
if ($interval > 1) { |
1903
|
0
|
|
|
|
|
|
$Recurrence{interval} = $interval; |
1904
|
|
|
|
|
|
|
} |
1905
|
|
|
|
|
|
|
} |
1906
|
|
|
|
|
|
|
|
1907
|
0
|
0
|
|
|
|
|
if (exists $RRULE{rscale}) { |
1908
|
0
|
|
|
|
|
|
$Recurrence{rscale} = lc $RRULE{rscale}; |
1909
|
0
|
0
|
|
|
|
|
$Recurrence{skip} = lc $RRULE{skip} if $RRULE{skip}; |
1910
|
|
|
|
|
|
|
} |
1911
|
|
|
|
|
|
|
|
1912
|
0
|
0
|
|
|
|
|
if (exists $RRULE{wkst}) { |
1913
|
0
|
|
|
|
|
|
my $wkst = lc $RRULE{wkst}; |
1914
|
0
|
0
|
|
|
|
|
unless ($WeekDayNames{$wkst}) { |
1915
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence WKST ($RRULE{wkst})"; |
1916
|
|
|
|
|
|
|
} |
1917
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
# default is Monday, so don't set a key for it |
1919
|
0
|
0
|
|
|
|
|
if ($wkst ne 'mo') { |
1920
|
0
|
|
|
|
|
|
$Recurrence{firstDayOfWeek} = $WeekDayNames{$wkst}; |
1921
|
|
|
|
|
|
|
} |
1922
|
|
|
|
|
|
|
} |
1923
|
|
|
|
|
|
|
|
1924
|
0
|
0
|
|
|
|
|
if (exists $RRULE{byday}) { |
1925
|
0
|
|
|
|
|
|
my @byDays; |
1926
|
|
|
|
|
|
|
|
1927
|
0
|
|
|
|
|
|
foreach my $BYDAY (split ',', $RRULE{byday}) { |
1928
|
0
|
|
|
|
|
|
push @byDays, _BYDAY2byDay(lc $BYDAY); |
1929
|
|
|
|
|
|
|
} |
1930
|
|
|
|
|
|
|
|
1931
|
0
|
0
|
|
|
|
|
$Recurrence{byDay} = \@byDays if @byDays; |
1932
|
|
|
|
|
|
|
} |
1933
|
|
|
|
|
|
|
|
1934
|
0
|
0
|
|
|
|
|
if (exists $RRULE{bymonth}) { |
1935
|
0
|
|
|
|
|
|
foreach my $BYMONTH (split ',', $RRULE{bymonth}) { |
1936
|
0
|
0
|
|
|
|
|
unless ($BYMONTH =~ /^\d+L?$/) { |
1937
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence BYMONTH ($BYMONTH, $RRULE{bymonth})"; |
1938
|
|
|
|
|
|
|
} |
1939
|
|
|
|
|
|
|
|
1940
|
0
|
|
|
|
|
|
push @{$Recurrence{byMonth}}, "$BYMONTH"; |
|
0
|
|
|
|
|
|
|
1941
|
|
|
|
|
|
|
} |
1942
|
|
|
|
|
|
|
} |
1943
|
|
|
|
|
|
|
|
1944
|
0
|
0
|
|
|
|
|
if (exists $RRULE{count}) { |
1945
|
0
|
0
|
|
|
|
|
if (exists $RRULE{until}) { |
1946
|
|
|
|
|
|
|
#confess "$uid: Recurrence COUNT and UNTIL cannot both be set"; |
1947
|
|
|
|
|
|
|
# seen in the wild: PRODID:-//dmfs.org//mimedir.icalendar//EN |
1948
|
0
|
|
|
|
|
|
delete $RRULE{until}; |
1949
|
|
|
|
|
|
|
} |
1950
|
|
|
|
|
|
|
|
1951
|
0
|
0
|
|
|
|
|
unless ($RRULE{count} =~ /^\d+$/) { |
1952
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence COUNT ($RRULE{count})"; |
1953
|
|
|
|
|
|
|
} |
1954
|
|
|
|
|
|
|
|
1955
|
0
|
|
|
|
|
|
$Recurrence{count} = int $RRULE{count}; |
1956
|
|
|
|
|
|
|
} |
1957
|
|
|
|
|
|
|
|
1958
|
0
|
0
|
|
|
|
|
if (exists $RRULE{until}) { |
1959
|
|
|
|
|
|
|
# rfc5545 3.3.10 - UNTIL must be in DTSTART timezone, but both |
1960
|
|
|
|
|
|
|
# google and iCloud store it in Z, so we will too as per rfc2445. |
1961
|
0
|
|
|
|
|
|
my ($Until, $IsAllDay) = $Self->_makeDateObj($RRULE{until}, $StartTimeZone, $StartTimeZone); |
1962
|
0
|
|
|
|
|
|
$Recurrence{until} = $Until->iso8601(); |
1963
|
|
|
|
|
|
|
} |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
# }}} |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
# parse generic recurrence properties {{{ |
1968
|
|
|
|
|
|
|
|
1969
|
0
|
|
|
|
|
|
foreach my $Property (keys %RecurrenceProperties) { |
1970
|
0
|
0
|
|
|
|
|
if (defined $RRULE{$Property}) { |
1971
|
0
|
|
|
|
|
|
foreach my $Value (split ',', $RRULE{$Property}) { |
1972
|
|
|
|
|
|
|
my ($Valid, $Min) = $RecurrenceProperties{$Property}{signed} |
1973
|
0
|
0
|
|
|
|
|
? ('[-+]?[1-9]\d*', ($RecurrenceProperties{$Property}{max} * -1)) |
1974
|
|
|
|
|
|
|
: ('\d+', 0); |
1975
|
|
|
|
|
|
|
|
1976
|
0
|
0
|
|
|
|
|
unless ($Value =~ /^$Valid$/) { |
1977
|
0
|
|
|
|
|
|
confess "$uid: Invalid recurrence $Property ($Value)"; |
1978
|
|
|
|
|
|
|
} |
1979
|
|
|
|
|
|
|
|
1980
|
0
|
0
|
0
|
|
|
|
unless (($Value >= $Min) and ($Value <= $RecurrenceProperties{$Property}{max})) { |
1981
|
0
|
|
|
|
|
|
confess "$uid: Recurrence $Property is out of range ($Value)"; |
1982
|
|
|
|
|
|
|
} |
1983
|
|
|
|
|
|
|
|
1984
|
0
|
|
|
|
|
|
push @{$Recurrence{$RecurrenceProperties{$Property}{name}}}, int $Value; |
|
0
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
} |
1986
|
|
|
|
|
|
|
} |
1987
|
|
|
|
|
|
|
} |
1988
|
|
|
|
|
|
|
|
1989
|
|
|
|
|
|
|
# }}} |
1990
|
|
|
|
|
|
|
} |
1991
|
|
|
|
|
|
|
|
1992
|
0
|
|
|
|
|
|
my %Overrides; |
1993
|
0
|
0
|
|
|
|
|
if (exists $VEvent->{properties}{exdate}) { |
1994
|
0
|
|
|
|
|
|
foreach my $Item (@{$VEvent->{properties}{exdate}}) { |
|
0
|
|
|
|
|
|
|
1995
|
0
|
|
|
|
|
|
foreach my $Date ($Self->_getDateObjMulti($Calendar, $Item, $StartTimeZone)) { |
1996
|
0
|
|
|
|
|
|
$Overrides{$Date->iso8601()} = $JSON::null; |
1997
|
|
|
|
|
|
|
} |
1998
|
|
|
|
|
|
|
} |
1999
|
|
|
|
|
|
|
} |
2000
|
|
|
|
|
|
|
|
2001
|
0
|
0
|
|
|
|
|
if ($VEvent->{properties}{rdate}) { |
2002
|
|
|
|
|
|
|
# rdate = "RDATE" rdtparam ":" rdtval *("," rdtval) CRLF |
2003
|
0
|
|
|
|
|
|
foreach my $Item (@{$VEvent->{properties}{rdate}}) { |
|
0
|
|
|
|
|
|
|
2004
|
0
|
|
|
|
|
|
foreach my $Date ($Self->_getDateObjMulti($Calendar, $Item, $StartTimeZone)) { |
2005
|
0
|
|
|
|
|
|
$Overrides{$Date->iso8601()} = {}; |
2006
|
|
|
|
|
|
|
} |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
# parse alarms {{{ |
2011
|
|
|
|
|
|
|
|
2012
|
0
|
|
|
|
|
|
my %Alerts; |
2013
|
0
|
0
|
|
|
|
|
foreach my $VAlarm (@{$VEvent->{objects} || []}) { |
|
0
|
|
|
|
|
|
|
2014
|
0
|
0
|
|
|
|
|
next unless lc $VAlarm->{type} eq 'valarm'; |
2015
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
my %AlarmProperties |
2017
|
0
|
|
|
|
|
|
= map { $_ => $VAlarm->{properties}{$_}[0] } |
2018
|
0
|
|
|
|
|
|
keys %{$VAlarm->{properties}}; |
|
0
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
|
2020
|
0
|
|
0
|
|
|
|
my $alarmuid = $AlarmProperties{uid}{value} || _hexkey($VAlarm) . '-alarmauto'; |
2021
|
|
|
|
|
|
|
|
2022
|
0
|
|
|
|
|
|
my %Alert; |
2023
|
|
|
|
|
|
|
|
2024
|
0
|
|
|
|
|
|
my $AlarmAction = lc $AlarmProperties{action}{value}; |
2025
|
0
|
0
|
|
|
|
|
next unless $AlarmAction; |
2026
|
|
|
|
|
|
|
|
2027
|
0
|
|
|
|
|
|
my %Action; |
2028
|
|
|
|
|
|
|
|
2029
|
0
|
0
|
|
|
|
|
if ($AlarmAction eq 'display') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2030
|
0
|
|
|
|
|
|
$Action{type} = 'display'; |
2031
|
|
|
|
|
|
|
} |
2032
|
|
|
|
|
|
|
elsif ($AlarmAction eq 'email') { |
2033
|
0
|
|
|
|
|
|
$Action{type} = 'email'; |
2034
|
|
|
|
|
|
|
|
2035
|
|
|
|
|
|
|
$Action{to} = [ |
2036
|
0
|
|
|
|
|
|
map { my ($x) = $_->{value} =~ m/^(?:mailto:)?(.*)/i; { email => $x } } |
|
0
|
|
|
|
|
|
|
2037
|
0
|
|
0
|
|
|
|
@{$VAlarm->{properties}{attendee} // []} |
|
0
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
]; |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
elsif ($AlarmAction eq 'uri') { |
2041
|
0
|
|
|
|
|
|
$Action{type} = 'uri'; |
2042
|
0
|
|
0
|
|
|
|
$Action{uri} = $VAlarm->{properties}{uri} // []; |
2043
|
|
|
|
|
|
|
} |
2044
|
|
|
|
|
|
|
elsif ($AlarmAction eq 'audio') { |
2045
|
|
|
|
|
|
|
# audio alerts aren't the same as popups, but for now... |
2046
|
0
|
|
|
|
|
|
$Action{type} = 'display'; |
2047
|
|
|
|
|
|
|
} |
2048
|
|
|
|
|
|
|
elsif ($AlarmAction eq 'none') { |
2049
|
0
|
|
|
|
|
|
next; |
2050
|
|
|
|
|
|
|
} |
2051
|
|
|
|
|
|
|
else { |
2052
|
0
|
|
|
|
|
|
warn "$uid: UNKNOWN VALARM ACTION $AlarmAction"; |
2053
|
0
|
|
|
|
|
|
next; |
2054
|
|
|
|
|
|
|
} |
2055
|
|
|
|
|
|
|
|
2056
|
0
|
0
|
|
|
|
|
if ($AlarmProperties{acknowledged}) { |
2057
|
0
|
|
|
|
|
|
my $date = $Self->_getDateObj($Calendar, $AlarmProperties{acknowledged}, 'UTC'); |
2058
|
0
|
|
|
|
|
|
$Action{acknowledged} = $date->iso8601() . 'Z'; |
2059
|
|
|
|
|
|
|
} |
2060
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
my $Trigger = $AlarmProperties{trigger}{value} |
2062
|
0
|
|
0
|
|
|
|
|| next; |
2063
|
|
|
|
|
|
|
|
2064
|
0
|
0
|
0
|
|
|
|
my $Related = (lc ($AlarmProperties{trigger}{params}{related}[0] || '') eq 'end') |
2065
|
|
|
|
|
|
|
? 'end' |
2066
|
|
|
|
|
|
|
: 'start'; |
2067
|
|
|
|
|
|
|
|
2068
|
0
|
|
|
|
|
|
my $Duration; |
2069
|
0
|
0
|
|
|
|
|
if ($Trigger =~ m/^[+-]?P/i) { |
2070
|
0
|
|
0
|
|
|
|
$Duration = eval { DateTime::Format::ICal->parse_duration(uc $Trigger) } |
2071
|
|
|
|
|
|
|
|| next; |
2072
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
} else { |
2074
|
0
|
|
|
|
|
|
my $AlertDate = $Self->_getDateObj($Calendar, $AlarmProperties{trigger}, $StartTimeZone); |
2075
|
0
|
0
|
|
|
|
|
$Duration = $AlertDate->subtract_datetime($Related eq 'end' ? $End : $Start); |
2076
|
|
|
|
|
|
|
} |
2077
|
|
|
|
|
|
|
|
2078
|
0
|
0
|
|
|
|
|
if ($Duration->is_negative()) { |
2079
|
0
|
|
|
|
|
|
$Duration = $Duration->inverse(); |
2080
|
0
|
|
|
|
|
|
$Alert{relativeTo} = "before-$Related"; |
2081
|
|
|
|
|
|
|
} |
2082
|
|
|
|
|
|
|
else { |
2083
|
0
|
|
|
|
|
|
$Alert{relativeTo} = "after-$Related"; |
2084
|
|
|
|
|
|
|
} |
2085
|
|
|
|
|
|
|
|
2086
|
0
|
|
|
|
|
|
$Alert{action} = \%Action; |
2087
|
0
|
|
|
|
|
|
$Alert{offset} = $Self->_make_duration($Duration); |
2088
|
|
|
|
|
|
|
|
2089
|
0
|
|
|
|
|
|
$Alerts{$alarmuid} = \%Alert; |
2090
|
|
|
|
|
|
|
} |
2091
|
|
|
|
|
|
|
|
2092
|
|
|
|
|
|
|
# }}} |
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
# parse attendees {{{ |
2095
|
|
|
|
|
|
|
|
2096
|
0
|
|
|
|
|
|
my %Participants; |
2097
|
0
|
0
|
|
|
|
|
for my $VOrganizer (@{$VEvent->{properties}{organizer} || []}) { |
|
0
|
|
|
|
|
|
|
2098
|
0
|
|
|
|
|
|
$Self->_makeParticipant($Calendar, \%Participants, $VOrganizer, 'owner'); |
2099
|
|
|
|
|
|
|
} |
2100
|
0
|
0
|
|
|
|
|
for my $VAttendee (@{$VEvent->{properties}{attendee} || []}) { |
|
0
|
|
|
|
|
|
|
2101
|
0
|
|
|
|
|
|
$Self->_makeParticipant($Calendar, \%Participants, $VAttendee, 'attendee'); |
2102
|
|
|
|
|
|
|
} |
2103
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
# }}} |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
# parse attachments {{{ |
2107
|
|
|
|
|
|
|
|
2108
|
0
|
|
|
|
|
|
my %Links; |
2109
|
0
|
0
|
|
|
|
|
foreach my $Attach (@{$VEvent->{properties}{attach} || []}) { |
|
0
|
|
|
|
|
|
|
2110
|
0
|
0
|
|
|
|
|
next unless $Attach->{value}; |
2111
|
0
|
0
|
|
|
|
|
next unless grep { $Attach->{value} =~ m{^$_://} } qw{http https ftp}; |
|
0
|
|
|
|
|
|
|
2112
|
|
|
|
|
|
|
|
2113
|
0
|
|
|
|
|
|
my $uri = $Attach->{value}; |
2114
|
0
|
|
|
|
|
|
my $filename = $Attach->{params}{filename}[0]; |
2115
|
|
|
|
|
|
|
# XXX - mime guessing? |
2116
|
0
|
|
|
|
|
|
my $mime = $Attach->{params}{fmttype}[0]; |
2117
|
0
|
0
|
|
|
|
|
if (not defined $mime) { |
2118
|
0
|
|
0
|
|
|
|
$::MimeTypes ||= MIME::Types->new; |
2119
|
0
|
|
|
|
|
|
my $MimeTypeObj = $::MimeTypes->mimeTypeOf($filename); |
2120
|
0
|
0
|
|
|
|
|
$mime = $MimeTypeObj->type() if $MimeTypeObj; |
2121
|
|
|
|
|
|
|
} |
2122
|
|
|
|
|
|
|
|
2123
|
0
|
|
|
|
|
|
my $size = $Attach->{params}{size}[0]; |
2124
|
|
|
|
|
|
|
|
2125
|
0
|
0
|
|
|
|
|
$Links{$uri} = { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
href => $uri, |
2127
|
|
|
|
|
|
|
rel => 'enclosure', |
2128
|
|
|
|
|
|
|
defined $filename ? (title => $filename) : (), |
2129
|
|
|
|
|
|
|
defined $mime ? (type => $mime) : (), |
2130
|
|
|
|
|
|
|
defined $size ? (size => 0+$size) : (), |
2131
|
|
|
|
|
|
|
}; |
2132
|
|
|
|
|
|
|
} |
2133
|
0
|
0
|
|
|
|
|
foreach my $URL (@{$VEvent->{properties}{url} || []}) { |
|
0
|
|
|
|
|
|
|
2134
|
0
|
|
|
|
|
|
my $uri = $URL->{value}; |
2135
|
0
|
0
|
|
|
|
|
next unless $uri; |
2136
|
0
|
|
|
|
|
|
$Links{$uri} = { href => $uri }; |
2137
|
|
|
|
|
|
|
} |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
# }}} |
2140
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
# ============= Metadata |
2142
|
0
|
|
|
|
|
|
my %Event = (uid => $uid); |
2143
|
|
|
|
|
|
|
# no support for relatedTo yet |
2144
|
0
|
|
|
|
|
|
$Event{prodId} = $prodid; |
2145
|
0
|
0
|
|
|
|
|
if ($Properties{created}{value}) { |
2146
|
|
|
|
|
|
|
# UTC item |
2147
|
0
|
|
|
|
|
|
my $Date = eval { $Self->_getDateObj($Calendar, $Properties{created}, 'UTC') }; |
|
0
|
|
|
|
|
|
|
2148
|
0
|
0
|
|
|
|
|
$Event{created} = $Date->iso8601() . 'Z' if $Date; |
2149
|
|
|
|
|
|
|
} |
2150
|
0
|
0
|
|
|
|
|
if ($Properties{dtstamp}{value}) { |
2151
|
|
|
|
|
|
|
# UTC item |
2152
|
0
|
|
|
|
|
|
my $Date = eval { $Self->_getDateObj($Calendar, $Properties{dtstamp}, 'UTC') }; |
|
0
|
|
|
|
|
|
|
2153
|
0
|
0
|
|
|
|
|
$Event{updated} = $Date->iso8601() . 'Z' if $Date; |
2154
|
|
|
|
|
|
|
} |
2155
|
0
|
|
0
|
|
|
|
$Event{updated} ||= DateTime->now->iso8601(); |
2156
|
0
|
0
|
|
|
|
|
$Event{sequence} = int($Properties{sequence}{value}) if $Properties{sequence}; |
2157
|
0
|
0
|
|
|
|
|
$Event{method} = $method if $method; |
2158
|
|
|
|
|
|
|
|
2159
|
|
|
|
|
|
|
# ============= What |
2160
|
0
|
0
|
|
|
|
|
$Event{title} = $Properties{summary}{value} if $Properties{summary}; |
2161
|
0
|
0
|
|
|
|
|
$Event{description} = join("\n", @description) if @description; |
2162
|
|
|
|
|
|
|
# htmlDescription is not supported |
2163
|
0
|
0
|
|
|
|
|
$Event{links} = \%Links if %Links; |
2164
|
0
|
|
|
|
|
|
my $language; |
2165
|
0
|
0
|
0
|
|
|
|
if ($Properties{description} and $Properties{description}{params}{language}) { |
2166
|
0
|
|
|
|
|
|
$language = $Properties{description}{params}{language}[0]; |
2167
|
|
|
|
|
|
|
} |
2168
|
0
|
0
|
0
|
|
|
|
if ($Properties{summary} and $Properties{summary}{params}{language}) { |
2169
|
0
|
|
|
|
|
|
$language = $Properties{summary}{params}{language}[0]; |
2170
|
|
|
|
|
|
|
} |
2171
|
0
|
0
|
|
|
|
|
$Event{locale} = $language if $language; |
2172
|
|
|
|
|
|
|
# translations is not supported |
2173
|
|
|
|
|
|
|
|
2174
|
|
|
|
|
|
|
# ============= Where |
2175
|
|
|
|
|
|
|
# XXX - support more structured representations from VEVENTs |
2176
|
0
|
0
|
|
|
|
|
if ($Properties{location}{value}) { |
2177
|
0
|
|
|
|
|
|
$Event{locations}{location} = { name => $Properties{location}{value} }; |
2178
|
|
|
|
|
|
|
} |
2179
|
0
|
0
|
0
|
|
|
|
if (not $IsAllDay and $StartTimeZone and $StartTimeZone ne $EndTimeZone) { |
|
|
|
0
|
|
|
|
|
2180
|
0
|
|
|
|
|
|
$Event{locations}{end} = { rel => 'end', timeZone => $EndTimeZone }; |
2181
|
|
|
|
|
|
|
} |
2182
|
|
|
|
|
|
|
|
2183
|
|
|
|
|
|
|
# ============= When |
2184
|
0
|
0
|
|
|
|
|
$Event{isAllDay} = $IsAllDay ? $JSON::true : $JSON::false; |
2185
|
0
|
0
|
|
|
|
|
$Event{start} = $Start->iso8601() if ref($Start); |
2186
|
0
|
0
|
|
|
|
|
$Event{timeZone} = $StartTimeZone if not $IsAllDay; |
2187
|
0
|
|
|
|
|
|
my $duration = $Self->_make_duration($End->subtract_datetime($Start), $IsAllDay); |
2188
|
0
|
0
|
|
|
|
|
$Event{duration} = $duration if $duration; |
2189
|
|
|
|
|
|
|
|
2190
|
0
|
0
|
|
|
|
|
$Event{recurrenceRule} = \%Recurrence if %Recurrence; |
2191
|
0
|
0
|
|
|
|
|
$Event{recurrenceOverrides} = \%Overrides if %Overrides; |
2192
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
# ============= Scheduling |
2194
|
0
|
0
|
|
|
|
|
if ($Properties{status}{value}) { |
2195
|
0
|
0
|
|
|
|
|
$Event{status} = lc($Properties{status}{value}) if lc($Properties{status}{value}) ne 'confirmed'; |
2196
|
|
|
|
|
|
|
} |
2197
|
0
|
0
|
|
|
|
|
if ($Properties{transp}{value}) { |
2198
|
0
|
0
|
|
|
|
|
$Event{showAsFree} = $JSON::true if lc($Properties{transp}{value}) eq 'transparent'; |
2199
|
|
|
|
|
|
|
} |
2200
|
0
|
|
|
|
|
|
foreach my $email (sort keys %Participants) { # later wins |
2201
|
0
|
0
|
|
|
|
|
$Event{replyTo} = { imip => "mailto:$email" } if grep { $_ eq 'owner' } @{$Participants{$email}{roles}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
} |
2203
|
0
|
0
|
|
|
|
|
$Event{participants} = \%Participants if %Participants; |
2204
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
# ============= Alerts |
2206
|
|
|
|
|
|
|
# useDefaultAlerts is not supported |
2207
|
0
|
0
|
|
|
|
|
$Event{alerts} = \%Alerts if %Alerts; |
2208
|
|
|
|
|
|
|
|
2209
|
0
|
0
|
|
|
|
|
if ($Properties{lastmodified}{value}) { |
2210
|
|
|
|
|
|
|
# UTC item |
2211
|
0
|
|
|
|
|
|
my $Date = eval { $Self->_getDateObj($Calendar, $Properties{lastmodified}, 'UTC') }; |
|
0
|
|
|
|
|
|
|
2212
|
0
|
|
|
|
|
|
$Event{lastModified} = $Date->iso8601() . 'Z'; |
2213
|
|
|
|
|
|
|
} |
2214
|
0
|
0
|
|
|
|
|
if ($Properties{'recurrence-id'}{value}) { |
2215
|
|
|
|
|
|
|
# in our system it's always in the timezone of the event, but iCloud |
2216
|
|
|
|
|
|
|
# returns it in UTC despite the event having a timezone. Super weird. |
2217
|
|
|
|
|
|
|
# Anyway, we need to format it to the StartTimeZone of the parent |
2218
|
|
|
|
|
|
|
# event if there is one, and we don't have that yet! |
2219
|
0
|
|
|
|
|
|
$Event{_recurrenceObj} = $Self->_getDateObj($Calendar, $Properties{'recurrence-id'}); |
2220
|
|
|
|
|
|
|
} |
2221
|
0
|
|
|
|
|
|
push @Events, \%Event; |
2222
|
|
|
|
|
|
|
} |
2223
|
|
|
|
|
|
|
} |
2224
|
|
|
|
|
|
|
|
2225
|
0
|
|
|
|
|
|
return \@Events; |
2226
|
|
|
|
|
|
|
} |
2227
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
sub _getTimeZone { |
2229
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2230
|
0
|
|
|
|
|
|
my ($Calendar, $Element) = @_; |
2231
|
|
|
|
|
|
|
|
2232
|
0
|
0
|
|
|
|
|
if ($Element->{value} =~ m/Z$/) { |
2233
|
0
|
|
|
|
|
|
return 'Etc/UTC'; |
2234
|
|
|
|
|
|
|
} |
2235
|
|
|
|
|
|
|
|
2236
|
0
|
|
|
|
|
|
my $TZID = $Element->{params}{tzid}[0]; |
2237
|
|
|
|
|
|
|
|
2238
|
0
|
0
|
|
|
|
|
return undef unless $TZID; |
2239
|
|
|
|
|
|
|
|
2240
|
0
|
0
|
|
|
|
|
return $Self->{_tznamemap}{$TZID} if exists $Self->{_tznamemap}{$TZID}; |
2241
|
|
|
|
|
|
|
|
2242
|
0
|
|
|
|
|
|
my %TzOffsets; |
2243
|
|
|
|
|
|
|
|
2244
|
0
|
0
|
|
|
|
|
foreach my $VTimeZone (@{$Calendar->{objects} || []}) { |
|
0
|
|
|
|
|
|
|
2245
|
0
|
0
|
|
|
|
|
next unless lc $VTimeZone->{type} eq 'vtimezone'; |
2246
|
0
|
0
|
0
|
|
|
|
next unless ($VTimeZone->{properties}{tzid}[0]{value} || '') eq $TZID; |
2247
|
|
|
|
|
|
|
|
2248
|
0
|
0
|
|
|
|
|
foreach my $Observance (@{$VTimeZone->{objects} || []}) { |
|
0
|
|
|
|
|
|
|
2249
|
0
|
0
|
0
|
|
|
|
next unless grep { (lc $Observance->{type} || '') eq $_ } qw{standard daylight}; |
|
0
|
|
|
|
|
|
|
2250
|
0
|
0
|
|
|
|
|
next unless defined $Observance->{properties}{tzoffsetto}[0]{value}; |
2251
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
$TzOffsets{lc $Observance->{type}} |
2253
|
0
|
|
|
|
|
|
= $Observance->{properties}{tzoffsetto}[0]{value}; |
2254
|
|
|
|
|
|
|
} |
2255
|
|
|
|
|
|
|
} |
2256
|
|
|
|
|
|
|
|
2257
|
0
|
0
|
|
|
|
|
return undef unless exists $TzOffsets{standard}; |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
my $TimeZone = Net::CalDAVTalk::TimeZones->GetTimeZone( |
2260
|
|
|
|
|
|
|
TZID => $TZID, |
2261
|
|
|
|
|
|
|
Time => $Element->{value}, |
2262
|
|
|
|
|
|
|
StandardTzOffsetTo => $TzOffsets{standard}, |
2263
|
|
|
|
|
|
|
($TzOffsets{daylight} |
2264
|
|
|
|
|
|
|
? (DaylightTzOffsetTo => $TzOffsets{daylight}) |
2265
|
0
|
|
0
|
|
|
|
: ()), |
2266
|
|
|
|
|
|
|
) || undef; |
2267
|
|
|
|
|
|
|
|
2268
|
0
|
|
|
|
|
|
$Self->{_tznamemap}{$TZID} = $TimeZone; |
2269
|
0
|
|
|
|
|
|
return $TimeZone; |
2270
|
|
|
|
|
|
|
} |
2271
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
sub _wireDate { |
2273
|
|
|
|
|
|
|
# format: YYYY-MM-DDTHH:MM:SS Z? |
2274
|
0
|
|
|
0
|
|
|
my $isoDate = shift; |
2275
|
0
|
|
0
|
|
|
|
my $timeZone = shift || $FLOATING; |
2276
|
0
|
0
|
|
|
|
|
confess "Invalid value '$isoDate' was not ISO8601" unless $isoDate =~ m/^(\d{4,})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)(Z?)$/i; |
2277
|
0
|
0
|
|
|
|
|
$timeZone = 'Etc/UTC' if $7; |
2278
|
|
|
|
|
|
|
|
2279
|
0
|
0
|
|
|
|
|
my $Date = DateTime->_new( |
2280
|
|
|
|
|
|
|
year => $1, |
2281
|
|
|
|
|
|
|
month => $2, |
2282
|
|
|
|
|
|
|
day => $3, |
2283
|
|
|
|
|
|
|
hour => $4, |
2284
|
|
|
|
|
|
|
minute => $5, |
2285
|
|
|
|
|
|
|
second => $6, |
2286
|
|
|
|
|
|
|
time_zone => $timeZone, |
2287
|
|
|
|
|
|
|
locale => $LOCALE, |
2288
|
|
|
|
|
|
|
) or confess "Invalid value '$isoDate'"; |
2289
|
|
|
|
|
|
|
|
2290
|
0
|
|
|
|
|
|
return $Date; |
2291
|
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
sub _vDate { |
2294
|
|
|
|
|
|
|
# format: :YYYYMMDDTHHMMSS (floating) |
2295
|
|
|
|
|
|
|
# format: :YYYYMMDDTHHMMSSZ (UTC) |
2296
|
|
|
|
|
|
|
# format: ;TZID=X/Y:YYMMDDTHHMMSS (zoned) |
2297
|
|
|
|
|
|
|
# format: ;TYPE=DATE:YYYYMMDD (but we don't know about that) |
2298
|
0
|
|
|
0
|
|
|
my $vDate = shift; |
2299
|
|
|
|
|
|
|
|
2300
|
0
|
0
|
|
|
|
|
if ($vDate =~ m/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)(\.\d+)?(Z?)$/i) { |
2301
|
0
|
0
|
|
|
|
|
my $Date = DateTime->_new( |
|
|
0
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
year => $1, |
2303
|
|
|
|
|
|
|
month => $2, |
2304
|
|
|
|
|
|
|
day => $3, |
2305
|
|
|
|
|
|
|
hour => $4, |
2306
|
|
|
|
|
|
|
minute => $5, |
2307
|
|
|
|
|
|
|
second => $6, |
2308
|
|
|
|
|
|
|
# ignore milliseconds in $7 |
2309
|
|
|
|
|
|
|
time_zone => ($8 eq 'Z' ? $UTC : $FLOATING), |
2310
|
|
|
|
|
|
|
locale => $LOCALE, |
2311
|
|
|
|
|
|
|
) or confess "Invalid value '$vDate' for DATETIME"; |
2312
|
|
|
|
|
|
|
|
2313
|
0
|
|
|
|
|
|
return ($Date, 1); |
2314
|
|
|
|
|
|
|
} |
2315
|
|
|
|
|
|
|
|
2316
|
0
|
0
|
|
|
|
|
if ($vDate =~ m/^(\d\d\d\d)(\d\d)(\d\d)$/) { |
2317
|
|
|
|
|
|
|
# all day |
2318
|
0
|
0
|
|
|
|
|
my $Date = DateTime->_new( |
2319
|
|
|
|
|
|
|
year => $1, |
2320
|
|
|
|
|
|
|
month => $2, |
2321
|
|
|
|
|
|
|
day => $3, |
2322
|
|
|
|
|
|
|
time_zone => $FLOATING, |
2323
|
|
|
|
|
|
|
locale => $LOCALE, |
2324
|
|
|
|
|
|
|
) or confess "Invalid value '$vDate' for DATE"; |
2325
|
|
|
|
|
|
|
|
2326
|
0
|
|
|
|
|
|
return ($Date, 0); |
2327
|
|
|
|
|
|
|
} |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
# we only support those two patterns |
2330
|
0
|
|
|
|
|
|
confess "Date '$vDate' was neither a DATE or DATETIME value"; |
2331
|
|
|
|
|
|
|
} |
2332
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
sub _makeVTime { |
2334
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2335
|
0
|
|
|
|
|
|
my ($TimeZones, $wire, $tz, $IsAllDay) = @_; |
2336
|
|
|
|
|
|
|
|
2337
|
0
|
|
|
|
|
|
my $date = _wireDate($wire, $tz); |
2338
|
|
|
|
|
|
|
|
2339
|
0
|
|
|
|
|
|
return $Self->_makeVTimeObj($TimeZones, $date, $tz, $IsAllDay); |
2340
|
|
|
|
|
|
|
} |
2341
|
|
|
|
|
|
|
|
2342
|
|
|
|
|
|
|
sub _makeVTimeObj { |
2343
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2344
|
0
|
|
|
|
|
|
my ($TimeZones, $date, $tz, $IsAllDay) = @_; |
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
# all day? |
2347
|
0
|
0
|
|
|
|
|
if ($IsAllDay) { |
2348
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%d'), { VALUE => 'DATE' }]; |
2349
|
|
|
|
|
|
|
} |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
# floating? |
2352
|
0
|
0
|
|
|
|
|
unless ($tz) { |
2353
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%S')]; |
2354
|
|
|
|
|
|
|
} |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
# UTC? |
2357
|
0
|
0
|
|
|
|
|
if ($UTCLinks{$tz}) { |
2358
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%SZ')]; |
2359
|
|
|
|
|
|
|
} |
2360
|
|
|
|
|
|
|
|
2361
|
0
|
|
|
|
|
|
my $zone = $Self->tz($tz); |
2362
|
|
|
|
|
|
|
|
2363
|
0
|
|
|
|
|
|
$TimeZones->{$zone->name()} = 1; |
2364
|
|
|
|
|
|
|
|
2365
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%S'), { TZID => $zone->name() }]; |
2366
|
|
|
|
|
|
|
} |
2367
|
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
|
sub _makeZTime { |
2369
|
0
|
|
|
0
|
|
|
my ($Self, $date) = @_; |
2370
|
0
|
|
|
|
|
|
return $Self->_makeVTime({}, $date, 'UTC'); |
2371
|
|
|
|
|
|
|
} |
2372
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
sub _makeLTime { |
2374
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2375
|
0
|
|
|
|
|
|
my ($TimeZones, $ltime, $tz, $IsAllDay) = @_; |
2376
|
|
|
|
|
|
|
|
2377
|
0
|
|
|
|
|
|
my $date = _wireDate($ltime, $Self->tz($tz)); |
2378
|
|
|
|
|
|
|
|
2379
|
0
|
0
|
|
|
|
|
return [$date->strftime('%Y%m%d'), { VALUE => 'DATE' }] if $IsAllDay; |
2380
|
|
|
|
|
|
|
|
2381
|
0
|
0
|
|
|
|
|
unless ($tz) { |
2382
|
|
|
|
|
|
|
# floating |
2383
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%S')]; |
2384
|
|
|
|
|
|
|
} |
2385
|
|
|
|
|
|
|
|
2386
|
0
|
0
|
|
|
|
|
if ($tz =~ m/UTC/i) { |
2387
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%SZ')]; |
2388
|
|
|
|
|
|
|
} |
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
# XXX - factor this crap out |
2391
|
0
|
|
|
|
|
|
$TimeZones->{$tz} = 1; |
2392
|
|
|
|
|
|
|
|
2393
|
|
|
|
|
|
|
# XXX - use our cache |
2394
|
0
|
|
|
|
|
|
my $zone = $Self->tz($tz); |
2395
|
|
|
|
|
|
|
|
2396
|
0
|
|
|
|
|
|
return [$date->strftime('%Y%m%dT%H%M%S'), { TZID => $zone->name() }]; |
2397
|
|
|
|
|
|
|
} |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
sub _argsToVEvents { |
2400
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2401
|
0
|
|
|
|
|
|
my ($TimeZones, $Args, $recurrenceData) = @_; |
2402
|
0
|
|
|
|
|
|
my @VEvents; |
2403
|
|
|
|
|
|
|
|
2404
|
0
|
|
|
|
|
|
my $VEvent = Data::ICal::Entry::Event->new(); |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
# required properties |
2407
|
|
|
|
|
|
|
$VEvent->add_properties( |
2408
|
|
|
|
|
|
|
uid => $Args->{uid}, |
2409
|
|
|
|
|
|
|
sequence => ($Args->{sequence} || 0), |
2410
|
0
|
0
|
0
|
|
|
|
transp => ($Args->{showAsFree} ? 'TRANSPARENT' : 'OPAQUE'), |
2411
|
|
|
|
|
|
|
); |
2412
|
|
|
|
|
|
|
|
2413
|
0
|
0
|
|
|
|
|
if ($recurrenceData) { |
2414
|
0
|
|
|
|
|
|
my ($recurrenceId, $TopLevel) = @$recurrenceData; |
2415
|
0
|
|
|
|
|
|
$VEvent->add_property('recurrence-id' => $Self->_makeLTime($TimeZones, $recurrenceId, $TopLevel->{timeZone}, $TopLevel->{isAllDay})); |
2416
|
|
|
|
|
|
|
} |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
# direct copy if properties exist |
2419
|
0
|
|
|
|
|
|
foreach my $Property (qw{description title}) { |
2420
|
0
|
|
0
|
|
|
|
my $Prop = $Args->{$Property} // ''; |
2421
|
0
|
0
|
|
|
|
|
next if $Prop eq ''; |
2422
|
0
|
|
|
|
|
|
my %lang; |
2423
|
0
|
0
|
|
|
|
|
$lang{language} = $Args->{locale} if exists $Args->{locale}; |
2424
|
0
|
|
|
|
|
|
my $key = $Property; |
2425
|
0
|
0
|
|
|
|
|
$key = 'summary' if $Property eq 'title'; |
2426
|
0
|
|
|
|
|
|
$VEvent->add_property($key => [$Prop, \%lang]); |
2427
|
|
|
|
|
|
|
} |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
# dates in UTC - stored in UTC |
2430
|
0
|
0
|
|
|
|
|
$VEvent->add_property(created => $Self->_makeZTime($Args->{created})) if $Args->{created}; |
2431
|
0
|
|
0
|
|
|
|
$VEvent->add_property(dtstamp => $Self->_makeZTime($Args->{updated} || DateTime->now->iso8601())); |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
# dates in localtime - zones based on location |
2434
|
0
|
|
|
|
|
|
my $EndTimeZone; |
2435
|
0
|
|
0
|
|
|
|
my $locations = $Args->{locations} || {}; |
2436
|
0
|
|
|
|
|
|
foreach my $id (sort keys %$locations) { |
2437
|
0
|
0
|
0
|
|
|
|
if ($locations->{$id}{rel} and $locations->{id}{rel} eq 'end') { |
2438
|
0
|
|
|
|
|
|
$EndTimeZone = $locations->{end}{timeZone}; |
2439
|
|
|
|
|
|
|
} |
2440
|
0
|
0
|
|
|
|
|
if ($locations->{$id}{name}) { |
2441
|
0
|
|
|
|
|
|
$VEvent->add_property(location => $locations->{$id}{name}); |
2442
|
|
|
|
|
|
|
} |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
0
|
|
|
|
|
|
my $StartTimeZone = $Args->{timeZone}; |
2446
|
0
|
|
|
|
|
|
my $Start = _wireDate($Args->{start}, $StartTimeZone); |
2447
|
0
|
|
|
|
|
|
$VEvent->add_property(dtstart => $Self->_makeVTimeObj($TimeZones, $Start, $StartTimeZone, $Args->{isAllDay})); |
2448
|
0
|
0
|
|
|
|
|
if ($Args->{duration}) { |
2449
|
0
|
|
0
|
|
|
|
$EndTimeZone //= $StartTimeZone; |
2450
|
0
|
|
|
|
|
|
my $Duration = eval { DateTime::Format::ICal->parse_duration($Args->{duration}) }; |
|
0
|
|
|
|
|
|
|
2451
|
0
|
0
|
|
|
|
|
my $End = $Start->clone()->add($Duration) if $Duration; |
2452
|
0
|
|
|
|
|
|
$VEvent->add_property(dtend => $Self->_makeVTimeObj($TimeZones, $End, $EndTimeZone, $Args->{isAllDay})); |
2453
|
|
|
|
|
|
|
} |
2454
|
|
|
|
|
|
|
|
2455
|
0
|
0
|
|
|
|
|
if ($Args->{recurrenceRule}) { |
2456
|
0
|
|
|
|
|
|
my %Recurrence = $Self->_makeRecurrence($Args->{recurrenceRule}, $Args->{isAllDay}, $StartTimeZone); |
2457
|
|
|
|
|
|
|
|
2458
|
|
|
|
|
|
|
# RFC 2445 4.3.10 - FREQ is the first part of the RECUR value type. |
2459
|
|
|
|
|
|
|
# RFC 5545 3.3.10 - FREQ should be first to ensure backward compatibility. |
2460
|
|
|
|
|
|
|
my $rule = join(';', |
2461
|
|
|
|
|
|
|
('FREQ=' . delete($Recurrence{FREQ})), |
2462
|
0
|
|
|
|
|
|
(map { "$_=$Recurrence{$_}" } keys %Recurrence), |
|
0
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
); |
2464
|
0
|
|
|
|
|
|
$VEvent->add_property(rrule => $rule); |
2465
|
|
|
|
|
|
|
} |
2466
|
|
|
|
|
|
|
|
2467
|
0
|
0
|
|
|
|
|
if ($Args->{recurrenceOverrides}) { |
2468
|
0
|
|
|
|
|
|
foreach my $recurrenceId (sort keys %{$Args->{recurrenceOverrides}}) { |
|
0
|
|
|
|
|
|
|
2469
|
0
|
|
|
|
|
|
my $val = $Args->{recurrenceOverrides}{$recurrenceId}; |
2470
|
0
|
0
|
|
|
|
|
if ($val) { |
2471
|
0
|
0
|
|
|
|
|
if (keys %$val) { |
2472
|
0
|
|
|
|
|
|
my $SubEvent = $Self->_maximise($Args, $val, $recurrenceId); |
2473
|
0
|
|
|
|
|
|
push @VEvents, $Self->_argsToVEvents($TimeZones, $SubEvent, [$recurrenceId, $Args]); |
2474
|
|
|
|
|
|
|
} |
2475
|
|
|
|
|
|
|
else { |
2476
|
0
|
|
|
|
|
|
$VEvent->add_property(rdate => $Self->_makeLTime($TimeZones, $recurrenceId, $StartTimeZone, $Args->{isAllDay})); |
2477
|
|
|
|
|
|
|
} |
2478
|
|
|
|
|
|
|
} |
2479
|
|
|
|
|
|
|
else { |
2480
|
0
|
|
|
|
|
|
$VEvent->add_property(exdate => $Self->_makeLTime($TimeZones, $recurrenceId, $StartTimeZone, $Args->{isAllDay})); |
2481
|
|
|
|
|
|
|
} |
2482
|
|
|
|
|
|
|
} |
2483
|
|
|
|
|
|
|
} |
2484
|
|
|
|
|
|
|
|
2485
|
0
|
0
|
|
|
|
|
if ($Args->{alerts}) { |
2486
|
0
|
|
|
|
|
|
for my $id (sort keys %{$Args->{alerts}}) { |
|
0
|
|
|
|
|
|
|
2487
|
0
|
|
|
|
|
|
my $Alert = $Args->{alerts}{$id}; |
2488
|
|
|
|
|
|
|
|
2489
|
0
|
|
0
|
|
|
|
my $Type = $Alert->{action}{type} // ''; |
2490
|
0
|
|
0
|
|
|
|
my $Recipients = $Alert->{action}{recipients} // []; |
2491
|
0
|
|
0
|
|
|
|
my $Uri = $Alert->{action}{uri} // ''; |
2492
|
0
|
|
|
|
|
|
my $Offset = $Alert->{offset}; |
2493
|
0
|
0
|
|
|
|
|
my $Sign = $Alert->{relativeTo} =~ m/before/ ? '-' : ''; |
2494
|
0
|
0
|
|
|
|
|
my $Loc1 = $Alert->{relativeTo} =~ m/end/ ? "ends" : "starts"; |
2495
|
0
|
0
|
|
|
|
|
my $Loc2 = $Alert->{relativeTo} =~ m/end/ ? "ended" : "started"; |
2496
|
0
|
|
|
|
|
|
my $Minutes = DateTime::Format::ICal->parse_duration(uc $Offset)->in_units('minutes'); |
2497
|
|
|
|
|
|
|
|
2498
|
0
|
|
|
|
|
|
my $VAlarm; |
2499
|
|
|
|
|
|
|
|
2500
|
0
|
0
|
0
|
|
|
|
if ($Type eq 'display') { |
|
|
0
|
|
|
|
|
|
2501
|
0
|
|
|
|
|
|
$VAlarm = Data::ICal::Entry::Alarm::Display->new(); |
2502
|
0
|
0
|
|
|
|
|
$VAlarm->add_properties( |
2503
|
|
|
|
|
|
|
description => (($Sign eq '-') |
2504
|
|
|
|
|
|
|
? "'$Args->{title}' $Loc1 in $Minutes minutes" |
2505
|
|
|
|
|
|
|
: "'$Args->{title}' $Loc2 $Minutes minutes ago"), |
2506
|
|
|
|
|
|
|
); |
2507
|
|
|
|
|
|
|
} |
2508
|
|
|
|
|
|
|
elsif ($Type eq 'email' || $Type eq 'uri') { |
2509
|
0
|
|
|
|
|
|
my ($Summary, $Description); |
2510
|
|
|
|
|
|
|
|
2511
|
0
|
0
|
|
|
|
|
if ($Sign eq '-') { |
2512
|
0
|
|
|
|
|
|
$Summary = "Event alert: '$Args->{title}' $Loc1 in $Minutes minutes"; |
2513
|
0
|
|
|
|
|
|
$Description = "Your event '$Args->{title}' $Loc1 in $Minutes minutes"; |
2514
|
|
|
|
|
|
|
} |
2515
|
|
|
|
|
|
|
else { |
2516
|
0
|
|
|
|
|
|
$Summary = "Event alert: '$Args->{title}' $Loc2 $Minutes minutes ago"; |
2517
|
0
|
|
|
|
|
|
$Description = "Your event '$Args->{title}' $Loc2 $Minutes minutes ago"; |
2518
|
|
|
|
|
|
|
} |
2519
|
|
|
|
|
|
|
|
2520
|
0
|
|
|
|
|
|
$VAlarm = Data::ICal::Entry::Alarm::Email->new(); |
2521
|
|
|
|
|
|
|
$VAlarm->add_properties( |
2522
|
|
|
|
|
|
|
summary => $Summary, |
2523
|
|
|
|
|
|
|
description => join("\n", |
2524
|
|
|
|
|
|
|
$Description, |
2525
|
|
|
|
|
|
|
"", |
2526
|
|
|
|
|
|
|
"Description:", |
2527
|
|
|
|
|
|
|
$Args->{description}, |
2528
|
|
|
|
|
|
|
# XXX more |
2529
|
|
|
|
|
|
|
), |
2530
|
0
|
|
|
|
|
|
(map { ( attendee => "MAILTO:$_" ) } @$Recipients), # XXX naive? |
|
0
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
); |
2532
|
|
|
|
|
|
|
|
2533
|
0
|
0
|
|
|
|
|
if ($Type eq 'uri') { |
2534
|
0
|
|
|
|
|
|
$VAlarm->add_property("X-URI", $Uri); |
2535
|
|
|
|
|
|
|
} |
2536
|
|
|
|
|
|
|
} |
2537
|
|
|
|
|
|
|
else { |
2538
|
0
|
|
|
|
|
|
confess "Unknown alarm type $Type"; |
2539
|
|
|
|
|
|
|
} |
2540
|
|
|
|
|
|
|
|
2541
|
0
|
|
|
|
|
|
$VAlarm->add_property(uid => $id); |
2542
|
0
|
|
|
|
|
|
$VAlarm->add_property(trigger => "${Sign}$Offset"); |
2543
|
0
|
0
|
|
|
|
|
$VAlarm->add_property(related => 'end') if $Alert->{relativeTo} =~ m/end/; |
2544
|
|
|
|
|
|
|
|
2545
|
0
|
0
|
|
|
|
|
if ($Alert->{action}{acknowledged}) { |
2546
|
0
|
|
|
|
|
|
$VAlarm->add_property(acknowledged => $Self->_makeZTime($Alert->{action}{acknowledged})); |
2547
|
|
|
|
|
|
|
} |
2548
|
|
|
|
|
|
|
|
2549
|
0
|
|
|
|
|
|
$VEvent->add_entry($VAlarm); |
2550
|
|
|
|
|
|
|
} |
2551
|
|
|
|
|
|
|
} |
2552
|
|
|
|
|
|
|
|
2553
|
0
|
|
|
|
|
|
my %namemap; |
2554
|
0
|
0
|
|
|
|
|
if ($Args->{participants}) { |
2555
|
0
|
|
|
|
|
|
foreach my $Address (sort keys %{$Args->{participants}}) { |
|
0
|
|
|
|
|
|
|
2556
|
0
|
|
|
|
|
|
my $Attendee = $Args->{participants}{$Address}; |
2557
|
0
|
|
0
|
|
|
|
my $Email = $Attendee->{email} || $Address; |
2558
|
0
|
|
|
|
|
|
my $Rsvp = $Attendee->{rsvp}; |
2559
|
|
|
|
|
|
|
|
2560
|
0
|
|
|
|
|
|
my %AttendeeProps; |
2561
|
0
|
0
|
|
|
|
|
if ($Attendee->{"name"}) { |
2562
|
0
|
|
|
|
|
|
$AttendeeProps{"CN"} = $Attendee->{"name"}; |
2563
|
0
|
|
|
|
|
|
$namemap{lc "mailto:$Email"}= $Attendee->{"name"}; |
2564
|
|
|
|
|
|
|
} |
2565
|
|
|
|
|
|
|
|
2566
|
0
|
0
|
|
|
|
|
next unless grep { $_ eq 'attendee' } @{$Attendee->{roles}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
2567
|
|
|
|
|
|
|
|
2568
|
0
|
0
|
|
|
|
|
$AttendeeProps{"CUTYPE"} = uc $Attendee->{"kind"} if defined $Attendee->{"kind"}; |
2569
|
0
|
0
|
|
|
|
|
$AttendeeProps{"RSVP"} = uc $Attendee->{"scheduleRSVP"} if defined $Attendee->{"scheduleRSVP"}; |
2570
|
0
|
0
|
|
|
|
|
$AttendeeProps{"X-SEQUENCE"} = $Attendee->{"x-sequence"} if defined $Attendee->{"x-sequence"}; |
2571
|
0
|
0
|
|
|
|
|
$AttendeeProps{"X-DTSTAMP"} = $Self->_makeZTime($Attendee->{"scheduleUpdated"}) if defined $Attendee->{"scheduleUpdated"}; |
2572
|
0
|
|
|
|
|
|
foreach my $prop (keys %AttendeeProps) { |
2573
|
0
|
0
|
|
|
|
|
delete $AttendeeProps{$prop} if $AttendeeProps{$prop} eq ''; |
2574
|
|
|
|
|
|
|
} |
2575
|
0
|
0
|
0
|
|
|
|
if (grep { $_ eq 'chair' } @{$Attendee->{roles}}) { |
|
0
|
0
|
0
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
2576
|
0
|
|
|
|
|
|
$Attendee->{ROLE} = 'CHAIR'; |
2577
|
|
|
|
|
|
|
} |
2578
|
|
|
|
|
|
|
elsif ($Attendee->{schedulePriority} and $Attendee->{schedulePriority} eq 'optional') { |
2579
|
0
|
|
|
|
|
|
$Attendee->{ROLE} = 'OPT-PARTICIPANT'; |
2580
|
|
|
|
|
|
|
} |
2581
|
|
|
|
|
|
|
elsif ($Attendee->{schedulePriority} and $Attendee->{schedulePriority} eq 'non-participant') { |
2582
|
0
|
|
|
|
|
|
$Attendee->{ROLE} = 'NON-PARTICIPANT'; |
2583
|
|
|
|
|
|
|
} |
2584
|
|
|
|
|
|
|
# default is REQ-PARTICIPANT |
2585
|
|
|
|
|
|
|
|
2586
|
0
|
0
|
|
|
|
|
$AttendeeProps{PARTSTAT} = uc $Attendee->{"scheduleStatus"} if $Attendee->{"scheduleStatus"}; |
2587
|
|
|
|
|
|
|
|
2588
|
0
|
|
|
|
|
|
$VEvent->add_property(attendee => [ "MAILTO:$Email", \%AttendeeProps ]); |
2589
|
|
|
|
|
|
|
} |
2590
|
|
|
|
|
|
|
} |
2591
|
0
|
0
|
|
|
|
|
if ($Args->{replyTo}) { |
2592
|
0
|
0
|
|
|
|
|
if ($Args->{replyTo}{imip}) { |
2593
|
0
|
|
|
|
|
|
my $CN = $namemap{lc $Args->{replyTo}{imip}}; |
2594
|
0
|
0
|
|
|
|
|
$VEvent->add_property(organizer => [ $Args->{replyTo}{imip}, $CN ? {CN => $CN} : () ]); |
2595
|
|
|
|
|
|
|
} |
2596
|
|
|
|
|
|
|
} |
2597
|
|
|
|
|
|
|
|
2598
|
0
|
0
|
|
|
|
|
if ($Args->{links}) { |
2599
|
0
|
|
|
|
|
|
foreach my $uri (sort keys %{$Args->{links}}) { |
|
0
|
|
|
|
|
|
|
2600
|
0
|
|
|
|
|
|
my $Attach = $Args->{links}{$uri}; |
2601
|
0
|
|
0
|
|
|
|
my $Url = $Attach->{href} || $uri; |
2602
|
0
|
0
|
0
|
|
|
|
if ($Attach->{rel} && $Attach->{rel} eq 'enclosure') { |
2603
|
0
|
|
|
|
|
|
my $FileName = $Attach->{title}; |
2604
|
0
|
|
|
|
|
|
my $Mime = $Attach->{type}; |
2605
|
0
|
|
|
|
|
|
my $Size = $Attach->{size}; |
2606
|
|
|
|
|
|
|
|
2607
|
0
|
|
|
|
|
|
my %AttachProps; |
2608
|
0
|
0
|
|
|
|
|
$AttachProps{FMTTYPE} = $Mime if defined $Mime; |
2609
|
0
|
0
|
|
|
|
|
$AttachProps{SIZE} = $Size if defined $Size; |
2610
|
0
|
0
|
|
|
|
|
$AttachProps{FILENAME} = $FileName if defined $FileName; |
2611
|
0
|
|
|
|
|
|
$VEvent->add_property(attach => [ $Url, \%AttachProps ]); |
2612
|
|
|
|
|
|
|
} |
2613
|
|
|
|
|
|
|
# otherwise it's just a URL |
2614
|
|
|
|
|
|
|
else { |
2615
|
0
|
|
|
|
|
|
$VEvent->add_property(url => [ $Url ]); |
2616
|
|
|
|
|
|
|
} |
2617
|
|
|
|
|
|
|
} |
2618
|
|
|
|
|
|
|
} |
2619
|
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
# detect if this is a dummy top-level event and skip it |
2621
|
0
|
0
|
0
|
|
|
|
unshift @VEvents, $VEvent unless ($Args->{replyTo} and not $Args->{participants}); |
2622
|
|
|
|
|
|
|
|
2623
|
0
|
|
|
|
|
|
return @VEvents; |
2624
|
|
|
|
|
|
|
} |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
sub _argsToVCalendar { |
2627
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2628
|
0
|
|
|
|
|
|
my $Item = shift; |
2629
|
0
|
|
|
|
|
|
my %ExtraProp = @_; |
2630
|
|
|
|
|
|
|
|
2631
|
0
|
|
|
|
|
|
my $VCalendar = Data::ICal->new(); |
2632
|
0
|
|
|
|
|
|
my $havepid = 0; |
2633
|
|
|
|
|
|
|
|
2634
|
0
|
|
|
|
|
|
foreach my $extra (keys %ExtraProp) { |
2635
|
0
|
|
|
|
|
|
$VCalendar->add_properties($extra => $ExtraProp{$extra}); |
2636
|
|
|
|
|
|
|
} |
2637
|
0
|
|
|
|
|
|
$VCalendar->add_properties(calscale => 'GREGORIAN'); |
2638
|
|
|
|
|
|
|
|
2639
|
0
|
|
|
|
|
|
my @VEvents; |
2640
|
|
|
|
|
|
|
my %TimeZones; |
2641
|
0
|
0
|
|
|
|
|
foreach my $Args (ref $Item eq 'ARRAY' ? @$Item : $Item) { |
2642
|
0
|
0
|
0
|
|
|
|
if (not $havepid and $Args->{prodId}) { |
2643
|
0
|
|
|
|
|
|
$VCalendar->add_properties('prodid' => $Args->{prodId}); |
2644
|
0
|
|
|
|
|
|
$havepid = 1; |
2645
|
|
|
|
|
|
|
} |
2646
|
|
|
|
|
|
|
# initialise timestamp if not given one |
2647
|
0
|
|
0
|
|
|
|
$Args->{dtstamp} //= DateTime->now()->strftime('%Y-%m-%dT%H:%M:%S'); |
2648
|
0
|
|
|
|
|
|
push @VEvents, $Self->_argsToVEvents(\%TimeZones, $Args); |
2649
|
|
|
|
|
|
|
} |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
# add timezone parts first |
2652
|
0
|
|
|
|
|
|
foreach my $Zone (sort keys %TimeZones) { |
2653
|
0
|
|
|
|
|
|
my $VTimeZone = Net::CalDAVTalk::TimeZones->GetVTimeZone($Zone); |
2654
|
0
|
0
|
|
|
|
|
next unless $VTimeZone; |
2655
|
0
|
|
|
|
|
|
$VCalendar->add_entry($VTimeZone); |
2656
|
|
|
|
|
|
|
} |
2657
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
# then the events |
2659
|
0
|
|
|
|
|
|
foreach my $VEvent (@VEvents) { |
2660
|
0
|
|
|
|
|
|
$VCalendar->add_entry($VEvent); |
2661
|
|
|
|
|
|
|
} |
2662
|
|
|
|
|
|
|
|
2663
|
0
|
|
|
|
|
|
return $VCalendar; |
2664
|
|
|
|
|
|
|
} |
2665
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
sub _makeRecurrence { |
2667
|
0
|
|
|
0
|
|
|
my $Self = shift; |
2668
|
0
|
|
|
|
|
|
my ($Args, $IsAllDay, $TZ) = @_; |
2669
|
|
|
|
|
|
|
|
2670
|
0
|
|
|
|
|
|
my %Recurrence; |
2671
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
# validate simple recurrence properties {{{ |
2673
|
|
|
|
|
|
|
|
2674
|
0
|
0
|
|
|
|
|
unless (ref($Args) eq 'HASH') { |
2675
|
0
|
|
|
|
|
|
confess 'Invalid recurrence'; |
2676
|
|
|
|
|
|
|
} |
2677
|
|
|
|
|
|
|
|
2678
|
0
|
0
|
|
|
|
|
if ($Args->{frequency}) { |
2679
|
0
|
0
|
|
|
|
|
unless (grep { $_ eq $Args->{frequency} } @Frequencies) { |
|
0
|
|
|
|
|
|
|
2680
|
0
|
|
|
|
|
|
confess "Invalid recurrence frequency ($Args->{frequency})"; |
2681
|
|
|
|
|
|
|
} |
2682
|
|
|
|
|
|
|
|
2683
|
0
|
|
|
|
|
|
$Recurrence{FREQ} = uc($Args->{frequency}); |
2684
|
|
|
|
|
|
|
} |
2685
|
|
|
|
|
|
|
else { |
2686
|
0
|
|
|
|
|
|
confess 'Recurrence frequency not specified'; |
2687
|
|
|
|
|
|
|
} |
2688
|
|
|
|
|
|
|
|
2689
|
0
|
0
|
|
|
|
|
if (defined $Args->{interval}) { |
2690
|
0
|
0
|
|
|
|
|
unless ($Args->{interval} =~ /^\d+$/) { |
2691
|
0
|
|
|
|
|
|
confess "Invalid recurrence interval ($Args->{interval})"; |
2692
|
|
|
|
|
|
|
} |
2693
|
|
|
|
|
|
|
|
2694
|
0
|
0
|
|
|
|
|
if ($Args->{interval} == 0) { |
2695
|
0
|
|
|
|
|
|
confess "Recurrence interval is out of range ($Args->{interval})"; |
2696
|
|
|
|
|
|
|
} |
2697
|
|
|
|
|
|
|
|
2698
|
0
|
0
|
|
|
|
|
if ($Args->{interval} > 1) { |
2699
|
0
|
|
|
|
|
|
$Recurrence{INTERVAL} = $Args->{interval}; |
2700
|
|
|
|
|
|
|
} |
2701
|
|
|
|
|
|
|
} |
2702
|
|
|
|
|
|
|
|
2703
|
0
|
0
|
|
|
|
|
if (defined $Args->{firstDayOfWeek}) { |
2704
|
0
|
0
|
|
|
|
|
unless (exists $DaysByIndex{$Args->{firstDayOfWeek}}) { |
2705
|
0
|
|
|
|
|
|
confess "Invalid recurrence firstDayOfWeek ($Args->{firstDayOfWeek})"; |
2706
|
|
|
|
|
|
|
} |
2707
|
|
|
|
|
|
|
|
2708
|
0
|
0
|
|
|
|
|
unless ($Args->{firstDayOfWeek} == 1){ |
2709
|
0
|
|
|
|
|
|
$Recurrence{WKST} = uc $DaysByIndex{$Args->{firstDayOfWeek}}; |
2710
|
|
|
|
|
|
|
} |
2711
|
|
|
|
|
|
|
} |
2712
|
|
|
|
|
|
|
|
2713
|
0
|
0
|
|
|
|
|
if ($Args->{byDay}) { |
2714
|
0
|
0
|
|
|
|
|
unless (ref($Args->{byDay}) eq 'ARRAY') { |
2715
|
0
|
|
|
|
|
|
confess 'Invalid recurrence byDay'; |
2716
|
|
|
|
|
|
|
} |
2717
|
|
|
|
|
|
|
|
2718
|
0
|
0
|
|
|
|
|
unless (@{$Args->{byDay}}) { |
|
0
|
|
|
|
|
|
|
2719
|
0
|
|
|
|
|
|
confess 'Recurrence byDay is empty'; |
2720
|
|
|
|
|
|
|
} |
2721
|
|
|
|
|
|
|
|
2722
|
0
|
|
|
|
|
|
$Recurrence{BYDAY} = join(',', map{ _byDay2BYDAY($_) } @{$Args->{byDay}}); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
} |
2724
|
|
|
|
|
|
|
|
2725
|
0
|
0
|
|
|
|
|
if ($Args->{byMonth}) { |
2726
|
0
|
0
|
|
|
|
|
unless (ref($Args->{byMonth}) eq 'ARRAY') { |
2727
|
0
|
|
|
|
|
|
confess 'Invalid recurrence byMonth'; |
2728
|
|
|
|
|
|
|
} |
2729
|
|
|
|
|
|
|
|
2730
|
0
|
0
|
|
|
|
|
unless (@{$Args->{byMonth}}) { |
|
0
|
|
|
|
|
|
|
2731
|
0
|
|
|
|
|
|
confess 'Recurrence byMonth is empty'; |
2732
|
|
|
|
|
|
|
} |
2733
|
|
|
|
|
|
|
|
2734
|
0
|
|
|
|
|
|
my @BYMONTHS; |
2735
|
|
|
|
|
|
|
|
2736
|
0
|
|
|
|
|
|
foreach my $byMonth (@{$Args->{byMonth}}) { |
|
0
|
|
|
|
|
|
|
2737
|
0
|
0
|
|
|
|
|
unless ($byMonth =~ /^(\d+)L?$/i) { |
2738
|
0
|
|
|
|
|
|
confess "Recurrence byMonth is not a number with optional L ($byMonth)"; |
2739
|
|
|
|
|
|
|
} |
2740
|
0
|
|
|
|
|
|
my $monthNum = $1; |
2741
|
0
|
0
|
0
|
|
|
|
unless ($monthNum >= 1 and $monthNum <= 13) { |
2742
|
|
|
|
|
|
|
# not sure if 13 is OK |
2743
|
0
|
|
|
|
|
|
confess "Recurrence byMonth is too high ($monthNum)"; |
2744
|
|
|
|
|
|
|
} |
2745
|
|
|
|
|
|
|
|
2746
|
0
|
|
|
|
|
|
push @BYMONTHS, $byMonth; |
2747
|
|
|
|
|
|
|
} |
2748
|
|
|
|
|
|
|
|
2749
|
0
|
|
|
|
|
|
$Recurrence{BYMONTH} = join ',', @BYMONTHS; |
2750
|
|
|
|
|
|
|
} |
2751
|
|
|
|
|
|
|
|
2752
|
0
|
0
|
|
|
|
|
if (defined $Args->{count}) { |
2753
|
0
|
0
|
|
|
|
|
if (defined $Args->{until}) { |
2754
|
0
|
|
|
|
|
|
confess 'Recurrence count and until cannot both be set'; |
2755
|
|
|
|
|
|
|
} |
2756
|
|
|
|
|
|
|
|
2757
|
0
|
0
|
|
|
|
|
unless ($Args->{count} =~ /^\d+$/) { |
2758
|
0
|
|
|
|
|
|
confess "Invalid recurrence count ($Args->{count})"; |
2759
|
|
|
|
|
|
|
} |
2760
|
|
|
|
|
|
|
|
2761
|
0
|
|
|
|
|
|
$Recurrence{COUNT} = $Args->{count}; |
2762
|
|
|
|
|
|
|
} |
2763
|
|
|
|
|
|
|
|
2764
|
0
|
0
|
|
|
|
|
if ($Args->{until}) { |
2765
|
0
|
|
|
|
|
|
my $Until = _wireDate($Args->{until}, $Self->tz($TZ)); |
2766
|
|
|
|
|
|
|
|
2767
|
0
|
0
|
|
|
|
|
if ($IsAllDay) { |
2768
|
0
|
|
|
|
|
|
$Recurrence{UNTIL} = $Until->strftime('%Y%m%d'); |
2769
|
|
|
|
|
|
|
} |
2770
|
|
|
|
|
|
|
else { |
2771
|
|
|
|
|
|
|
# API is in Localtime, but both iCloud and Google use 'Z' times as per |
2772
|
|
|
|
|
|
|
# rfc2445, so we'll copy them for compatibility. |
2773
|
0
|
|
|
|
|
|
$Until->set_time_zone($UTC); |
2774
|
0
|
|
|
|
|
|
$Recurrence{UNTIL} = $Until->strftime('%Y%m%dT%H%M%SZ'); |
2775
|
|
|
|
|
|
|
} |
2776
|
|
|
|
|
|
|
} |
2777
|
|
|
|
|
|
|
|
2778
|
|
|
|
|
|
|
# }}} |
2779
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
# validate generic recurrence properties {{{ |
2781
|
|
|
|
|
|
|
|
2782
|
0
|
|
|
|
|
|
foreach my $Property (keys %RecurrenceProperties) { |
2783
|
0
|
|
|
|
|
|
my $Name = $RecurrenceProperties{$Property}{name}; |
2784
|
|
|
|
|
|
|
|
2785
|
0
|
0
|
|
|
|
|
if ($Args->{$Name}) { |
2786
|
0
|
0
|
|
|
|
|
unless (ref($Args->{$Name}) eq 'ARRAY') { |
2787
|
0
|
|
|
|
|
|
confess "Invalid recurrence $Name"; |
2788
|
|
|
|
|
|
|
} |
2789
|
|
|
|
|
|
|
|
2790
|
0
|
0
|
|
|
|
|
unless (@{$Args->{$Name}}) { |
|
0
|
|
|
|
|
|
|
2791
|
0
|
|
|
|
|
|
confess "Recurrence $Name is empty"; |
2792
|
|
|
|
|
|
|
} |
2793
|
|
|
|
|
|
|
|
2794
|
0
|
|
|
|
|
|
my @Values; |
2795
|
|
|
|
|
|
|
|
2796
|
0
|
|
|
|
|
|
foreach my $Value (@{$Args->{$Name}}) { |
|
0
|
|
|
|
|
|
|
2797
|
|
|
|
|
|
|
my ($Valid, $Min) = $RecurrenceProperties{$Property}{signed} |
2798
|
0
|
0
|
|
|
|
|
? ('[-+]?[1-9]\d*', ($RecurrenceProperties{$Property}{max} * -1)) |
2799
|
|
|
|
|
|
|
: ('\d+', 0); |
2800
|
|
|
|
|
|
|
|
2801
|
0
|
0
|
|
|
|
|
unless ($Value =~ /^$Valid$/) { |
2802
|
0
|
|
|
|
|
|
confess "Invalid recurrence $Name ($Value)"; |
2803
|
|
|
|
|
|
|
} |
2804
|
|
|
|
|
|
|
|
2805
|
0
|
0
|
0
|
|
|
|
unless (($Min <= $Value) and ($Value <= $RecurrenceProperties{$Property}{max})) { |
2806
|
0
|
|
|
|
|
|
confess "Recurrence $Name is out of range ($Value)"; |
2807
|
|
|
|
|
|
|
} |
2808
|
|
|
|
|
|
|
|
2809
|
0
|
|
|
|
|
|
push @Values, $Value; |
2810
|
|
|
|
|
|
|
} |
2811
|
|
|
|
|
|
|
|
2812
|
0
|
|
|
|
|
|
$Recurrence{uc $Property} = join ',', @Values; |
2813
|
|
|
|
|
|
|
} |
2814
|
|
|
|
|
|
|
} |
2815
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
# }}} |
2817
|
|
|
|
|
|
|
|
2818
|
0
|
|
|
|
|
|
return %Recurrence; |
2819
|
|
|
|
|
|
|
} |
2820
|
|
|
|
|
|
|
|
2821
|
|
|
|
|
|
|
=head2 $self->vcalendarToEvents($Data) |
2822
|
|
|
|
|
|
|
|
2823
|
|
|
|
|
|
|
Convert a text vcalendar (either a single event or an entire ical file) into an array of events. |
2824
|
|
|
|
|
|
|
|
2825
|
|
|
|
|
|
|
Returns an array (not arrayref) of Events in UID order. |
2826
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
e.g. |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
foreach my $Event ($CalDAV->vcalendarToEvents($Data)) { |
2830
|
|
|
|
|
|
|
# ... |
2831
|
|
|
|
|
|
|
} |
2832
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
=cut |
2834
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
sub _insert_override { |
2836
|
0
|
|
|
0
|
|
|
my $Event = shift; |
2837
|
0
|
|
|
|
|
|
my $recurrenceId = shift; |
2838
|
0
|
|
|
|
|
|
my $Recurrence = shift; |
2839
|
|
|
|
|
|
|
|
2840
|
0
|
|
|
|
|
|
my %override; |
2841
|
0
|
|
|
|
|
|
my %oldkeys = map { $_ => 1 } keys %$Event; |
|
0
|
|
|
|
|
|
|
2842
|
0
|
|
|
|
|
|
foreach my $Key (sort keys %$Recurrence) { |
2843
|
0
|
|
|
|
|
|
delete $oldkeys{$Key}; |
2844
|
0
|
0
|
|
|
|
|
next if $MustBeTopLevel{$Key}; # XXX - check safeeq and die? |
2845
|
0
|
0
|
|
|
|
|
if ($Key eq 'start') { |
2846
|
|
|
|
|
|
|
# special case, it's the recurrence-id |
2847
|
0
|
0
|
|
|
|
|
next if _safeeq($Recurrence->{start}, $recurrenceId); |
2848
|
0
|
|
|
|
|
|
$override{start} = $Recurrence->{start}; |
2849
|
0
|
|
|
|
|
|
next; |
2850
|
|
|
|
|
|
|
} |
2851
|
0
|
0
|
|
|
|
|
next if _safeeq($Recurrence->{$Key}, $Event->{$Key}); |
2852
|
0
|
|
|
|
|
|
_add_override(\%override, _quotekey($Key), $Recurrence->{$Key}, $Event->{$Key}); |
2853
|
|
|
|
|
|
|
} |
2854
|
|
|
|
|
|
|
|
2855
|
0
|
|
|
|
|
|
foreach my $Key (sort keys %oldkeys) { |
2856
|
0
|
0
|
|
|
|
|
next if $MustBeTopLevel{$Key}; |
2857
|
0
|
|
|
|
|
|
$override{$Key} = $JSON::null; |
2858
|
|
|
|
|
|
|
} |
2859
|
|
|
|
|
|
|
|
2860
|
|
|
|
|
|
|
# in theory should never happen, but you could edit something back to be identical |
2861
|
0
|
0
|
|
|
|
|
return unless %override; |
2862
|
0
|
|
|
|
|
|
$Event->{recurrenceOverrides}{$recurrenceId} = \%override; |
2863
|
|
|
|
|
|
|
} |
2864
|
|
|
|
|
|
|
|
2865
|
|
|
|
|
|
|
sub vcalendarToEvents { |
2866
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
2867
|
0
|
|
|
|
|
|
my $Data = shift; |
2868
|
|
|
|
|
|
|
|
2869
|
|
|
|
|
|
|
# Internal caches need to be invalidated on each item read! A bit evil really... |
2870
|
0
|
|
|
|
|
|
delete $Self->{_tznamemap}; |
2871
|
|
|
|
|
|
|
|
2872
|
0
|
|
|
|
|
|
my %map; |
2873
|
|
|
|
|
|
|
my %exceptions; |
2874
|
0
|
|
|
|
|
|
my $Events = $Self->_getEventsFromVCalendar($Data); |
2875
|
|
|
|
|
|
|
|
2876
|
0
|
|
|
|
|
|
foreach my $Event (@$Events) { |
2877
|
0
|
|
|
|
|
|
my $uid = $Event->{uid}; |
2878
|
0
|
0
|
|
|
|
|
if ($Event->{_recurrenceObj}) { |
|
|
0
|
|
|
|
|
|
2879
|
0
|
|
|
|
|
|
push @{$exceptions{$uid}}, $Event; |
|
0
|
|
|
|
|
|
|
2880
|
|
|
|
|
|
|
} |
2881
|
|
|
|
|
|
|
elsif ($map{$uid}) { |
2882
|
|
|
|
|
|
|
# it looks like sometimes Google doesn't remember to put the Recurrence ID |
2883
|
|
|
|
|
|
|
# on additional recurrences after the first one, which is going to screw up |
2884
|
|
|
|
|
|
|
# pretty badly because if the date has changed, then we can't even notice |
2885
|
|
|
|
|
|
|
# which recurrent it was SUPPOSED to be. *sigh*. |
2886
|
0
|
|
|
|
|
|
warn "DUPLICATE EVENT FOR $uid\n" . Dumper($map{$uid}, $Event); |
2887
|
0
|
|
|
|
|
|
push @{$exceptions{$uid}}, $Event; |
|
0
|
|
|
|
|
|
|
2888
|
0
|
|
|
|
|
|
$map{$uid}{_dirty} = 1; |
2889
|
|
|
|
|
|
|
} |
2890
|
|
|
|
|
|
|
else { |
2891
|
0
|
|
|
|
|
|
$map{$uid} = $Event; |
2892
|
|
|
|
|
|
|
} |
2893
|
|
|
|
|
|
|
} |
2894
|
|
|
|
|
|
|
|
2895
|
0
|
|
|
|
|
|
foreach my $uid (keys %exceptions) { |
2896
|
0
|
0
|
|
|
|
|
unless ($map{$uid}) { |
2897
|
|
|
|
|
|
|
# create a synthetic top-level |
2898
|
0
|
|
|
|
|
|
my $First = $exceptions{$uid}[0]; |
2899
|
|
|
|
|
|
|
$map{$uid} = { |
2900
|
|
|
|
|
|
|
uid => $uid, |
2901
|
|
|
|
|
|
|
# these two are required at top level, but may be different |
2902
|
|
|
|
|
|
|
# in recurrences so aren't in MustBeTopLevel |
2903
|
|
|
|
|
|
|
start => $First->{start}, |
2904
|
|
|
|
|
|
|
updated => $First->{updated}, |
2905
|
0
|
|
|
|
|
|
}; |
2906
|
0
|
0
|
|
|
|
|
$map{$uid}{timeZone} = $First->{timeZone} unless $First->{isAllDay}; |
2907
|
0
|
|
|
|
|
|
foreach my $key (keys %MustBeTopLevel) { |
2908
|
0
|
0
|
|
|
|
|
$map{$uid}{$key} = $First->{$key} if exists $First->{$key}; |
2909
|
|
|
|
|
|
|
} |
2910
|
|
|
|
|
|
|
} |
2911
|
0
|
|
|
|
|
|
foreach my $SubEvent (@{$exceptions{$uid}}) { |
|
0
|
|
|
|
|
|
|
2912
|
0
|
|
|
|
|
|
my $recurrenceId = $SubEvent->{start}; |
2913
|
0
|
0
|
|
|
|
|
if ($SubEvent->{_recurrenceObj}) { |
2914
|
0
|
|
|
|
|
|
my $Date = delete $SubEvent->{_recurrenceObj}; |
2915
|
0
|
0
|
|
|
|
|
$Date->set_time_zone($map{$uid}{timeZone}) if $map{$uid}{timeZone}; |
2916
|
0
|
|
|
|
|
|
$recurrenceId = $Date->iso8601(); |
2917
|
|
|
|
|
|
|
} |
2918
|
0
|
|
|
|
|
|
_insert_override($map{$uid}, $recurrenceId, $SubEvent); |
2919
|
|
|
|
|
|
|
} |
2920
|
|
|
|
|
|
|
} |
2921
|
|
|
|
|
|
|
|
2922
|
0
|
|
|
|
|
|
return map { $map{$_} } sort keys %map; |
|
0
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
} |
2924
|
|
|
|
|
|
|
|
2925
|
|
|
|
|
|
|
=head2 $self->UpdateAddressSet($DisplayName, $EmailAddress) |
2926
|
|
|
|
|
|
|
|
2927
|
|
|
|
|
|
|
Set the address set and display name for the calendar user (if supported) |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
=cut |
2930
|
|
|
|
|
|
|
|
2931
|
|
|
|
|
|
|
sub UpdateAddressSet { |
2932
|
0
|
|
|
0
|
1
|
|
my ($Self, $NewDisplayName, $NewAddressSet) = @_; |
2933
|
|
|
|
|
|
|
|
2934
|
0
|
|
|
|
|
|
my ($DisplayName, $AddressSet) = $Self->GetProps(\$Self->{principal}, 'D:displayname', [ 'C:calendar-user-address-set', 'D:href' ]); |
2935
|
|
|
|
|
|
|
|
2936
|
0
|
0
|
0
|
|
|
|
if (!$AddressSet || $AddressSet ne "mailto:" . $NewAddressSet || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2937
|
|
|
|
|
|
|
!$DisplayName || $DisplayName ne $NewDisplayName) { |
2938
|
0
|
|
|
|
|
|
$Self->Request( |
2939
|
|
|
|
|
|
|
'PROPPATCH', |
2940
|
|
|
|
|
|
|
"", |
2941
|
|
|
|
|
|
|
x('D:propertyupdate', $Self->NS(), |
2942
|
|
|
|
|
|
|
x('D:set', |
2943
|
|
|
|
|
|
|
x('D:prop', |
2944
|
|
|
|
|
|
|
x('D:displayname', $NewDisplayName), |
2945
|
|
|
|
|
|
|
x('C:calendar-user-address-set', "mailto:" . $NewAddressSet), |
2946
|
|
|
|
|
|
|
) |
2947
|
|
|
|
|
|
|
) |
2948
|
|
|
|
|
|
|
) |
2949
|
|
|
|
|
|
|
); |
2950
|
0
|
|
|
|
|
|
return 1; |
2951
|
|
|
|
|
|
|
} |
2952
|
|
|
|
|
|
|
|
2953
|
0
|
|
|
|
|
|
return 0; |
2954
|
|
|
|
|
|
|
} |
2955
|
|
|
|
|
|
|
|
2956
|
|
|
|
|
|
|
=head2 $self->GetICal($calendarId, $isFreeBusy) |
2957
|
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
Given a calender, fetch all the events and generate an ical format file |
2959
|
|
|
|
|
|
|
suitable for import into a client. |
2960
|
|
|
|
|
|
|
|
2961
|
|
|
|
|
|
|
=cut |
2962
|
|
|
|
|
|
|
|
2963
|
|
|
|
|
|
|
sub GetICal { |
2964
|
0
|
|
|
0
|
1
|
|
my $Self = shift; |
2965
|
0
|
|
|
|
|
|
my $calendarId = shift; |
2966
|
0
|
|
|
|
|
|
my $isFreeBusy = shift; |
2967
|
|
|
|
|
|
|
|
2968
|
0
|
0
|
|
|
|
|
confess "Need a calendarId" unless $calendarId; |
2969
|
|
|
|
|
|
|
|
2970
|
0
|
|
|
|
|
|
my $Calendars = $Self->GetCalendars(); |
2971
|
0
|
|
|
|
|
|
foreach my $Cal (@$Calendars) { |
2972
|
0
|
0
|
|
|
|
|
next unless $calendarId eq $Cal->{id}; |
2973
|
0
|
0
|
|
|
|
|
my ($Events, $Errors) = $isFreeBusy ? |
2974
|
|
|
|
|
|
|
$Self->GetFreeBusy($calendarId) : |
2975
|
|
|
|
|
|
|
$Self->GetEvents($calendarId); |
2976
|
0
|
0
|
|
|
|
|
return undef if @$Errors; |
2977
|
0
|
|
|
|
|
|
$Self->_stripNonICal($_) for @$Events; |
2978
|
|
|
|
|
|
|
my $VCalendar = $Self->_argsToVCalendar($Events, |
2979
|
|
|
|
|
|
|
method => 'PUBLISH', |
2980
|
|
|
|
|
|
|
'x-wr-calname' => $Cal->{name}, |
2981
|
|
|
|
|
|
|
'x-wr-timezone' => $Cal->{timeZone}, |
2982
|
|
|
|
|
|
|
'x-apple-calendar-color' => $Cal->{color}, |
2983
|
|
|
|
|
|
|
# XXX - do we want to add our sync-token here or something? |
2984
|
0
|
|
|
|
|
|
); |
2985
|
0
|
|
|
|
|
|
return ($VCalendar->as_string(), $Cal); |
2986
|
|
|
|
|
|
|
} |
2987
|
0
|
|
|
|
|
|
return undef; # 404 |
2988
|
|
|
|
|
|
|
} |
2989
|
|
|
|
|
|
|
|
2990
|
|
|
|
|
|
|
sub _quotekey { |
2991
|
0
|
|
|
0
|
|
|
my $key = shift; |
2992
|
0
|
|
|
|
|
|
$key =~ s/\~/~0/gs; |
2993
|
0
|
|
|
|
|
|
$key =~ s/\//~1/gs; |
2994
|
0
|
|
|
|
|
|
return $key; |
2995
|
|
|
|
|
|
|
} |
2996
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
sub _unquotekey { |
2998
|
0
|
|
|
0
|
|
|
my $key = shift; |
2999
|
0
|
|
|
|
|
|
$key =~ s/\~1/\//gs; |
3000
|
0
|
|
|
|
|
|
$key =~ s/\~0/~/gs; |
3001
|
0
|
|
|
|
|
|
return $key; |
3002
|
|
|
|
|
|
|
} |
3003
|
|
|
|
|
|
|
|
3004
|
|
|
|
|
|
|
sub _add_override { |
3005
|
0
|
|
|
0
|
|
|
my ($override, $prefix, $New, $Old) = @_; |
3006
|
|
|
|
|
|
|
|
3007
|
|
|
|
|
|
|
# basic case - it's not an object, so we just override |
3008
|
0
|
0
|
0
|
|
|
|
if ($ENV{JMAP_ALWAYS_FULL} or ref($New) ne 'HASH' or ref($Old) or 'HASH') { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3009
|
0
|
|
|
|
|
|
$override->{$prefix} = $New; |
3010
|
0
|
|
|
|
|
|
return; |
3011
|
|
|
|
|
|
|
} |
3012
|
|
|
|
|
|
|
|
3013
|
|
|
|
|
|
|
# XXX - if too many, we could just abort... |
3014
|
0
|
|
|
|
|
|
my %subover; |
3015
|
0
|
|
|
|
|
|
my %oldkeys = map { $_ => 1 } keys %$Old; |
|
0
|
|
|
|
|
|
|
3016
|
0
|
|
|
|
|
|
foreach my $Key (sort keys %$New) { |
3017
|
0
|
|
|
|
|
|
delete $oldkeys{$Key}; |
3018
|
0
|
0
|
|
|
|
|
next if _safeeq($New->{$Key}, $Old->{$Key}); |
3019
|
0
|
|
|
|
|
|
_add_override(\%subover, "$prefix/" . _quotekey($Key), $New->{$Key}, $Old->{$Key}); |
3020
|
|
|
|
|
|
|
} |
3021
|
0
|
|
|
|
|
|
foreach my $Key (sort keys %oldkeys) { |
3022
|
0
|
|
|
|
|
|
$subover{"$prefix/" . _quotekey($Key)} = $JSON::null; |
3023
|
|
|
|
|
|
|
} |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
# which one is better? |
3026
|
0
|
0
|
|
|
|
|
if (length(encode_json($New)) < length(encode_json(\%subover))) { |
3027
|
0
|
|
|
|
|
|
$override->{$prefix} = $New; # cheaper to just encode the whole object |
3028
|
|
|
|
|
|
|
} |
3029
|
|
|
|
|
|
|
else { |
3030
|
0
|
|
|
|
|
|
$override->{$_} = $subover{$_} for keys %subover; |
3031
|
|
|
|
|
|
|
} |
3032
|
|
|
|
|
|
|
} |
3033
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
sub _apply_patch { |
3035
|
0
|
|
|
0
|
|
|
my $path = shift; |
3036
|
0
|
|
|
|
|
|
my $hash = shift; |
3037
|
0
|
|
|
|
|
|
my $value = shift; |
3038
|
|
|
|
|
|
|
|
3039
|
0
|
0
|
|
|
|
|
return unless $path =~ s{^([^/]+)(/?)}{}; |
3040
|
0
|
0
|
|
|
|
|
return unless ref($hash) eq 'HASH'; |
3041
|
0
|
|
|
|
|
|
my $qkey = $1; |
3042
|
0
|
|
|
|
|
|
my $slash = $2; |
3043
|
0
|
|
|
|
|
|
my $key = _unquotekey($qkey); |
3044
|
0
|
0
|
|
|
|
|
if ($slash) { |
|
|
0
|
|
|
|
|
|
3045
|
0
|
|
|
|
|
|
_apply_patch($path, $hash->{$key}, $value); |
3046
|
|
|
|
|
|
|
} |
3047
|
|
|
|
|
|
|
elsif(defined $value) { |
3048
|
0
|
|
|
|
|
|
$hash->{$key} = $value; |
3049
|
|
|
|
|
|
|
} |
3050
|
|
|
|
|
|
|
else { |
3051
|
0
|
|
|
|
|
|
delete $hash->{$key}; |
3052
|
|
|
|
|
|
|
} |
3053
|
|
|
|
|
|
|
} |
3054
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
sub _maximise { |
3056
|
0
|
|
|
0
|
|
|
my $Self = shift; |
3057
|
0
|
|
|
|
|
|
my $Event = shift; |
3058
|
0
|
|
|
|
|
|
my $Recurrence = shift; |
3059
|
0
|
|
|
|
|
|
my $recurrenceId = shift; |
3060
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
#warn "MAXIMIZING EVENT INTO RECURRENCE: " . Dumper($Event, $Recurrence); |
3062
|
|
|
|
|
|
|
|
3063
|
0
|
|
|
|
|
|
my $new = _deepcopy($Event); |
3064
|
0
|
|
|
|
|
|
$new->{start} = $recurrenceId; |
3065
|
0
|
|
|
|
|
|
delete $new->{recurrenceRule}; |
3066
|
0
|
|
|
|
|
|
delete $new->{recurrenceOverrides}; |
3067
|
|
|
|
|
|
|
|
3068
|
0
|
|
|
|
|
|
foreach my $path (sort keys %$Recurrence) { |
3069
|
0
|
|
|
|
|
|
my $value = $Recurrence->{$path}; |
3070
|
0
|
|
|
|
|
|
_apply_patch($path, $new, $value); |
3071
|
|
|
|
|
|
|
} |
3072
|
|
|
|
|
|
|
|
3073
|
0
|
|
|
|
|
|
return $new; |
3074
|
|
|
|
|
|
|
} |
3075
|
|
|
|
|
|
|
|
3076
|
|
|
|
|
|
|
sub _stripNonICal { |
3077
|
0
|
|
|
0
|
|
|
my $Self = shift; |
3078
|
0
|
|
|
|
|
|
my $Event = shift; |
3079
|
|
|
|
|
|
|
|
3080
|
0
|
|
|
|
|
|
delete $Event->{alerts}; |
3081
|
0
|
|
|
|
|
|
delete $Event->{attendees}; |
3082
|
0
|
|
|
|
|
|
delete $Event->{organizer}; |
3083
|
|
|
|
|
|
|
|
3084
|
0
|
|
|
|
|
|
foreach my $exception (values %{$Event->{exceptions}}) { |
|
0
|
|
|
|
|
|
|
3085
|
0
|
0
|
|
|
|
|
next unless $exception; |
3086
|
0
|
|
|
|
|
|
$Self->_stripNonICal($exception); |
3087
|
|
|
|
|
|
|
} |
3088
|
|
|
|
|
|
|
} |
3089
|
|
|
|
|
|
|
|
3090
|
|
|
|
|
|
|
sub _safeeq { |
3091
|
0
|
|
|
0
|
|
|
my ($a, $b) = @_; |
3092
|
0
|
|
|
|
|
|
my $json = JSON::XS->new->canonical; |
3093
|
0
|
|
|
|
|
|
return $json->encode([$a]) eq $json->encode([$b]); |
3094
|
|
|
|
|
|
|
} |
3095
|
|
|
|
|
|
|
|
3096
|
|
|
|
|
|
|
sub _deepcopy { |
3097
|
0
|
|
|
0
|
|
|
my $data = shift; |
3098
|
0
|
|
|
|
|
|
my $json = JSON::XS->new->canonical; |
3099
|
0
|
|
|
|
|
|
my $enc = $json->encode([$data]); |
3100
|
0
|
|
|
|
|
|
my $copy = $json->decode($enc); |
3101
|
0
|
|
|
|
|
|
return $copy->[0]; |
3102
|
|
|
|
|
|
|
} |
3103
|
|
|
|
|
|
|
|
3104
|
|
|
|
|
|
|
|
3105
|
|
|
|
|
|
|
=head1 AUTHOR |
3106
|
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
|
Bron Gondwana, C<< <brong at cpan.org> >> |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
=head1 BUGS |
3110
|
|
|
|
|
|
|
|
3111
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-net-caldavtalk at rt.cpan.org>, or through |
3112
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-CalDAVTalk>. I will be notified, and then you'll |
3113
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
3114
|
|
|
|
|
|
|
|
3115
|
|
|
|
|
|
|
|
3116
|
|
|
|
|
|
|
|
3117
|
|
|
|
|
|
|
|
3118
|
|
|
|
|
|
|
=head1 SUPPORT |
3119
|
|
|
|
|
|
|
|
3120
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
3121
|
|
|
|
|
|
|
|
3122
|
|
|
|
|
|
|
perldoc Net::CalDAVTalk |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
|
3125
|
|
|
|
|
|
|
You can also look for information at: |
3126
|
|
|
|
|
|
|
|
3127
|
|
|
|
|
|
|
=over 4 |
3128
|
|
|
|
|
|
|
|
3129
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
3130
|
|
|
|
|
|
|
|
3131
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-CalDAVTalk> |
3132
|
|
|
|
|
|
|
|
3133
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
3134
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Net-CalDAVTalk> |
3136
|
|
|
|
|
|
|
|
3137
|
|
|
|
|
|
|
=item * CPAN Ratings |
3138
|
|
|
|
|
|
|
|
3139
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Net-CalDAVTalk> |
3140
|
|
|
|
|
|
|
|
3141
|
|
|
|
|
|
|
=item * Search CPAN |
3142
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Net-CalDAVTalk/> |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
=back |
3146
|
|
|
|
|
|
|
|
3147
|
|
|
|
|
|
|
|
3148
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
3149
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
|
3151
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
3152
|
|
|
|
|
|
|
|
3153
|
|
|
|
|
|
|
Copyright 2015 FastMail Pty Ltd. |
3154
|
|
|
|
|
|
|
|
3155
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
3156
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
3157
|
|
|
|
|
|
|
copy of the full license at: |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
L<http://www.perlfoundation.org/artistic_license_2_0> |
3160
|
|
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
3162
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
3163
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
3164
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
3165
|
|
|
|
|
|
|
|
3166
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
3167
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
3168
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
3169
|
|
|
|
|
|
|
|
3170
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
3171
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
3172
|
|
|
|
|
|
|
|
3173
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
3174
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
3175
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
3176
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
3177
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
3178
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
3179
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
3180
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
3181
|
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
3183
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
3184
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
3185
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
3186
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
3187
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
3188
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
3189
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
3190
|
|
|
|
|
|
|
|
3191
|
|
|
|
|
|
|
|
3192
|
|
|
|
|
|
|
=cut |
3193
|
|
|
|
|
|
|
|
3194
|
|
|
|
|
|
|
1; # End of Net::CalDAVTalk |