line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
9
|
|
|
9
|
|
221593
|
use warnings; |
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
331
|
|
2
|
9
|
|
|
9
|
|
40
|
use strict; |
|
9
|
|
|
|
|
13
|
|
|
9
|
|
|
|
|
357
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Data::ICal; |
5
|
9
|
|
|
9
|
|
38
|
use base qw/Data::ICal::Entry/; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
4362
|
|
6
|
|
|
|
|
|
|
|
7
|
9
|
|
|
9
|
|
4111
|
use Class::ReturnValue; |
|
9
|
|
|
|
|
111290
|
|
|
9
|
|
|
|
|
971
|
|
8
|
9
|
|
|
9
|
|
4608
|
use Text::vFile::asData; |
|
9
|
|
|
|
|
23935
|
|
|
9
|
|
|
|
|
80
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.22'; |
11
|
|
|
|
|
|
|
|
12
|
9
|
|
|
9
|
|
433
|
use Carp; |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
7124
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Data::ICal - Generates iCalendar (RFC 2445) calendar files |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Data::ICal; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $calendar = Data::ICal->new(); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $vtodo = Data::ICal::Entry::Todo->new(); |
25
|
|
|
|
|
|
|
$vtodo->add_properties( |
26
|
|
|
|
|
|
|
# ... see Data::ICal::Entry::Todo documentation |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# ... or |
30
|
|
|
|
|
|
|
$calendar = Data::ICal->new(filename => 'foo.ics'); # parse existing file |
31
|
|
|
|
|
|
|
$calendar = Data::ICal->new(data => 'BEGIN:VCALENDAR...'); # parse from scalar |
32
|
|
|
|
|
|
|
$calendar->add_entry($vtodo); |
33
|
|
|
|
|
|
|
print $calendar->as_string; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
A L object represents a C object as defined in the |
38
|
|
|
|
|
|
|
iCalendar protocol (RFC 2445, MIME type "text/calendar"), as implemented in many |
39
|
|
|
|
|
|
|
popular calendaring programs such as Apple's iCal. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Each L object is a collection of "entries", which are objects of a |
42
|
|
|
|
|
|
|
subclass of L. The types of entries defined by iCalendar |
43
|
|
|
|
|
|
|
(which refers to them as "components") include events, to-do items, journal |
44
|
|
|
|
|
|
|
entries, free/busy time indicators, and time zone descriptors; in addition, |
45
|
|
|
|
|
|
|
events and to-do items can contain alarm entries. (Currently, L |
46
|
|
|
|
|
|
|
only implements to-do items and events.) |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
L is a subclass of L; see its manpage for more |
49
|
|
|
|
|
|
|
methods applicable to L. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 METHODS |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head2 new [ data => $data, ] [ filename => $file ], [ calname => $string ], [ vcal10 => $bool ], [ rfc_strict => $bool ], [ auto_uid => $bool ] |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Creates a new L object. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
If it is given a filename or data argument is passed, then this parses the |
60
|
|
|
|
|
|
|
content of the file or string into the object. If the C flag is passed, |
61
|
|
|
|
|
|
|
parses it according to vCalendar 1.0, not iCalendar 2.0; this in particular impacts |
62
|
|
|
|
|
|
|
the parsing of continuation lines in quoted-printable sections. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
If a calname is passed, sets x-wr-calname to the given string. Although |
65
|
|
|
|
|
|
|
not specified in RFC2445, most calendar software respects x-wr-calname |
66
|
|
|
|
|
|
|
as the displayed name of the calendar. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
If the C flag is set to true, will require Data::ICal to |
69
|
|
|
|
|
|
|
include UIDs, as per RFC2445: |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
4.8.4.7 Unique Identifier |
72
|
|
|
|
|
|
|
... The property MUST be specified in the "VEVENT", "VTODO", |
73
|
|
|
|
|
|
|
"VJOURNAL" or "VFREEBUSY" calendar components" |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
If the C flag is set to true, will automatically generate a |
76
|
|
|
|
|
|
|
default UID for each type which requires it, based on the RFC-suggested |
77
|
|
|
|
|
|
|
algorithm. Explicitly-set UID attributes will override this |
78
|
|
|
|
|
|
|
auto-generated value. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
If a filename or data argument is not passed, this just sets the |
81
|
|
|
|
|
|
|
object's C and C properties to "2.0" (or "1.0" if the |
82
|
|
|
|
|
|
|
C flag is passed) and the value of the C method |
83
|
|
|
|
|
|
|
respectively. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Returns a false value upon failure to open or parse the file or data; this false |
86
|
|
|
|
|
|
|
value is a L object and can be queried as to its |
87
|
|
|
|
|
|
|
C. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub new { |
92
|
22
|
|
|
22
|
1
|
6194
|
my $class = shift; |
93
|
22
|
|
|
|
|
149
|
my $self = $class->SUPER::new(@_); |
94
|
|
|
|
|
|
|
|
95
|
22
|
|
|
|
|
132
|
my %args = ( |
96
|
|
|
|
|
|
|
filename => undef, |
97
|
|
|
|
|
|
|
calname => undef, |
98
|
|
|
|
|
|
|
data => undef, |
99
|
|
|
|
|
|
|
vcal10 => 0, |
100
|
|
|
|
|
|
|
rfc_strict => 0, |
101
|
|
|
|
|
|
|
auto_uid => 0, |
102
|
|
|
|
|
|
|
@_ |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
|
105
|
22
|
|
|
|
|
141
|
$self->vcal10( $args{vcal10} ); |
106
|
22
|
|
|
|
|
211
|
$self->rfc_strict( $args{rfc_strict} ); |
107
|
22
|
|
|
|
|
165
|
$self->auto_uid( $args{auto_uid} ); |
108
|
|
|
|
|
|
|
|
109
|
22
|
100
|
100
|
|
|
206
|
if ( defined $args{filename} or defined $args{data} ) { |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# might return a Class::ReturnValue if parsing fails |
112
|
15
|
|
|
|
|
79
|
return $self->parse(%args); |
113
|
|
|
|
|
|
|
} else { |
114
|
7
|
100
|
|
|
|
28
|
$self->add_properties( |
115
|
|
|
|
|
|
|
version => ( $self->vcal10 ? '1.0' : '2.0' ), |
116
|
|
|
|
|
|
|
prodid => $self->product_id, |
117
|
|
|
|
|
|
|
); |
118
|
7
|
50
|
|
|
|
24
|
$self->add_property('x-wr-calname' => $args{calname}) |
119
|
|
|
|
|
|
|
if defined $args{calname}; |
120
|
|
|
|
|
|
|
|
121
|
7
|
|
|
|
|
29
|
return $self; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 parse [ data => $data, ] [ filename => $file, ] |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Parse a C<.ics> file or string containing one, and populate C<$self> |
128
|
|
|
|
|
|
|
with its contents. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Should only be called once on a given object, and will be automatically |
131
|
|
|
|
|
|
|
called by C if you provide arguments to C. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Returns C<$self> on success. Returns a false value upon failure to |
134
|
|
|
|
|
|
|
open or parse the file or data; this false value is a |
135
|
|
|
|
|
|
|
L object and can be queried as to its |
136
|
|
|
|
|
|
|
C. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub parse { |
141
|
15
|
|
|
15
|
1
|
24
|
my $self = shift; |
142
|
15
|
|
|
|
|
57
|
my %args = ( |
143
|
|
|
|
|
|
|
filename => undef, |
144
|
|
|
|
|
|
|
data => undef, |
145
|
|
|
|
|
|
|
@_ |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
|
148
|
15
|
50
|
66
|
|
|
65
|
unless ( defined $args{filename} or defined $args{data} ) { |
149
|
0
|
|
|
|
|
0
|
return $self->_error( |
150
|
|
|
|
|
|
|
"parse called with no filename or data specified"); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
15
|
|
|
|
|
13
|
my @lines; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# open the file (checking as we go, like good little Perl mongers) |
156
|
15
|
100
|
|
|
|
32
|
if ( defined $args{filename} ) { |
157
|
10
|
100
|
|
|
|
320
|
open my $fh, '<', $args{filename} |
158
|
|
|
|
|
|
|
or return $self->_error("could not open '$args{filename}': $!"); |
159
|
9
|
|
|
|
|
250
|
@lines = map { chomp; $_ } <$fh>; |
|
365
|
|
|
|
|
230
|
|
|
365
|
|
|
|
|
425
|
|
160
|
|
|
|
|
|
|
} else { |
161
|
5
|
|
|
|
|
142
|
@lines = split /\r?\n/, $args{data}; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
14
|
100
|
|
|
|
100
|
@lines = $self->_vcal10_input_cleanup(@lines) if $self->vcal10; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Parse the lines; Text::vFile doesn't want trailing newlines |
167
|
14
|
|
|
|
|
125
|
my $cal = eval { Text::vFile::asData->new->parse_lines(@lines) }; |
|
14
|
|
|
|
|
112
|
|
168
|
14
|
50
|
|
|
|
55971
|
return $self->_error("parse failure: $@") if $@; |
169
|
|
|
|
|
|
|
|
170
|
14
|
100
|
66
|
|
|
90
|
return $self->_error("parse failure") |
171
|
|
|
|
|
|
|
unless $cal and exists $cal->{objects}; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# loop through all the vcards |
174
|
13
|
|
|
|
|
18
|
foreach my $object ( @{ $cal->{objects} } ) { |
|
13
|
|
|
|
|
35
|
|
175
|
13
|
|
|
|
|
67
|
$self->parse_object($object); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
13
|
|
|
|
|
54
|
my $version_ref = $self->property("version"); |
179
|
13
|
100
|
|
|
|
49
|
my $version = $version_ref ? $version_ref->[0]->value : undef; |
180
|
13
|
100
|
|
|
|
93
|
unless ( defined $version ) { |
181
|
1
|
|
|
|
|
2
|
return $self->_error("data does not specify a version property"); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
12
|
100
|
100
|
|
|
88
|
if ( $version eq '1.0' and not $self->vcal10 |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
185
|
|
|
|
|
|
|
or $version eq '2.0' and $self->vcal10 ) |
186
|
|
|
|
|
|
|
{ |
187
|
2
|
100
|
|
|
|
23
|
return $self->_error( 'application claims data is' |
188
|
|
|
|
|
|
|
. ( $self->vcal10 ? '' : ' not' ) |
189
|
|
|
|
|
|
|
. ' vCal 1.0 but doc contains VERSION:' |
190
|
|
|
|
|
|
|
. $version ); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
10
|
|
|
|
|
317
|
return $self; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _error { |
197
|
5
|
|
|
5
|
|
25
|
my $self = shift; |
198
|
5
|
|
|
|
|
5
|
my $msg = shift; |
199
|
|
|
|
|
|
|
|
200
|
5
|
|
|
|
|
30
|
my $ret = Class::ReturnValue->new; |
201
|
5
|
|
|
|
|
35
|
$ret->as_error( errno => 1, message => $msg ); |
202
|
5
|
|
|
|
|
4934
|
return $ret; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 ical_entry_type |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Returns C, its iCalendar entry name. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=cut |
210
|
|
|
|
|
|
|
|
211
|
38
|
|
|
38
|
1
|
2141
|
sub ical_entry_type {'VCALENDAR'} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 product_id |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Returns the product ID used in the calendar's C property; you may |
216
|
|
|
|
|
|
|
wish to override this in a subclass for your own application. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=cut |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub product_id { |
221
|
7
|
|
|
7
|
1
|
105
|
my $self = shift; |
222
|
7
|
|
|
|
|
52
|
return "Data::ICal $VERSION"; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head2 mandatory_unique_properties |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
According to the iCalendar standard, the following properties must be specified |
228
|
|
|
|
|
|
|
exactly one time for a calendar: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
prodid version |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub mandatory_unique_properties { |
235
|
104
|
|
|
104
|
1
|
269
|
qw( |
236
|
|
|
|
|
|
|
prodid version |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head2 optional_unique_properties |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
According to the iCalendar standard, the following properties may be specified |
243
|
|
|
|
|
|
|
at most one time for a calendar: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
calscale method |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=cut |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub optional_unique_properties { |
250
|
88
|
|
|
88
|
1
|
202
|
qw( |
251
|
|
|
|
|
|
|
calscale method |
252
|
|
|
|
|
|
|
); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# In quoted-printable sections, convert from vcal10 "=\n" line endings to |
256
|
|
|
|
|
|
|
# ical20 "\n ". |
257
|
|
|
|
|
|
|
sub _vcal10_input_cleanup { |
258
|
5
|
|
|
5
|
|
81
|
my $self = shift; |
259
|
5
|
|
|
|
|
26
|
my @in_lines = @_; |
260
|
|
|
|
|
|
|
|
261
|
5
|
|
|
|
|
5
|
my @out_lines; |
262
|
|
|
|
|
|
|
|
263
|
5
|
|
|
|
|
6
|
my $in_qp = 0; |
264
|
5
|
|
|
|
|
15
|
LINE: while (@in_lines) { |
265
|
177
|
|
|
|
|
140
|
my $line = shift @in_lines; |
266
|
|
|
|
|
|
|
|
267
|
177
|
100
|
100
|
|
|
549
|
if ( not $in_qp and $line =~ /^[^:]+;ENCODING=QUOTED-PRINTABLE/i ) { |
268
|
4
|
|
|
|
|
6
|
$in_qp = 1; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
177
|
100
|
|
|
|
221
|
unless ($in_qp) { |
272
|
166
|
|
|
|
|
128
|
push @out_lines, $line; |
273
|
166
|
|
|
|
|
242
|
next LINE; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
11
|
100
|
|
|
|
32
|
if ( $line =~ s/=$// ) { |
277
|
7
|
|
|
|
|
7
|
push @out_lines, $line; |
278
|
7
|
50
|
|
|
|
22
|
$in_lines[0] = ' ' . $in_lines[0] if @in_lines; |
279
|
|
|
|
|
|
|
} else { |
280
|
4
|
|
|
|
|
5
|
push @out_lines, $line; |
281
|
4
|
|
|
|
|
9
|
$in_qp = 0; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
5
|
|
|
|
|
58
|
return @out_lines; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
L requires L, L, |
291
|
|
|
|
|
|
|
L, and L. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
L does not support time zone daylight or standard entries, |
296
|
|
|
|
|
|
|
so time zone components are basically useless. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
While L tries to check which properties are required and |
299
|
|
|
|
|
|
|
repeatable, this only works in simple cases; it does not check for |
300
|
|
|
|
|
|
|
properties that must either both exist or both not exist, or for |
301
|
|
|
|
|
|
|
mutually exclusive properties. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
L does not check to see if property parameter names are |
304
|
|
|
|
|
|
|
known in general or allowed on the particular property. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
L does not check to see if nested entries are nested |
307
|
|
|
|
|
|
|
properly (alarms in todos and events only, everything else in |
308
|
|
|
|
|
|
|
calendars only). |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
The only property encoding supported by L is quoted |
311
|
|
|
|
|
|
|
printable. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
314
|
|
|
|
|
|
|
C, or through the web interface at |
315
|
|
|
|
|
|
|
L. |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head1 AUTHOR |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Best Practical Solutions, LLC Emodules@bestpractical.comE |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Copyright (c) 2005 - 2015, Best Practical Solutions, LLC. All rights reserved. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
327
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. See L. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
1; |