line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
13
|
|
|
13
|
|
67
|
use warnings; |
|
13
|
|
|
|
|
17
|
|
|
13
|
|
|
|
|
419
|
|
2
|
13
|
|
|
13
|
|
49
|
use strict; |
|
13
|
|
|
|
|
24
|
|
|
13
|
|
|
|
|
508
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Data::ICal::Entry; |
5
|
13
|
|
|
13
|
|
54
|
use base qw/Class::Accessor/; |
|
13
|
|
|
|
|
17
|
|
|
13
|
|
|
|
|
7526
|
|
6
|
13
|
|
|
13
|
|
25940
|
use Data::ICal::Property; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
84
|
|
7
|
13
|
|
|
13
|
|
6810
|
use Sys::Hostname qw(); # For unique UIDs for entries |
|
13
|
|
|
|
|
11391
|
|
|
13
|
|
|
|
|
292
|
|
8
|
13
|
|
|
13
|
|
72
|
use Carp; |
|
13
|
|
|
|
|
16
|
|
|
13
|
|
|
|
|
776
|
|
9
|
|
|
|
|
|
|
|
10
|
13
|
|
|
13
|
|
65
|
use constant CRLF => "\x0d\x0a"; |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
22173
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Data::ICal::Entry - Represents an entry in an iCalendar file |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 SYNOPSIS |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $vtodo = Data::ICal::Entry::Todo->new(); |
19
|
|
|
|
|
|
|
$vtodo->add_property( |
20
|
|
|
|
|
|
|
# ... see Data::ICal::Entry::Todo documentation |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
$vtodo->add_properties( ... ); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$calendar->add_entry($vtodo); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$event->add_entry($alarm); |
27
|
|
|
|
|
|
|
$event->add_entries($alarm1, ...); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# or all in one go |
30
|
|
|
|
|
|
|
my $vtodo = Data::ICal::Entry::Todo->new( \%props, \@entries ); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 DESCRIPTION |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
A L object represents a single entry in an |
35
|
|
|
|
|
|
|
iCalendar file. (Note that the iCalendar RFC refers to entries as |
36
|
|
|
|
|
|
|
"components".) iCalendar defines several types of entries, such as |
37
|
|
|
|
|
|
|
events and to-do lists; each of these corresponds to a subclass of |
38
|
|
|
|
|
|
|
L (though only to-do lists and events are currently |
39
|
|
|
|
|
|
|
implemented). L should be treated as an abstract |
40
|
|
|
|
|
|
|
base class -- all objects created should be of its subclasses. The |
41
|
|
|
|
|
|
|
entire calendar itself (the L object) is also represented |
42
|
|
|
|
|
|
|
as a L object. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Each entry has an entry type (such as C or C), a |
45
|
|
|
|
|
|
|
series of "properties", and possibly some sub-entries. (Only the root |
46
|
|
|
|
|
|
|
L object can have sub-entries, except for alarm entries |
47
|
|
|
|
|
|
|
contained in events and to-dos (not yet implemented).) |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 METHODS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=cut |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head2 new |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Creates a new entry object with no properties or sub-entries. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=cut |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub new { |
60
|
87
|
|
|
87
|
1
|
1282
|
my $class = shift; |
61
|
87
|
|
|
|
|
329
|
my $self = $class->SUPER::new(); |
62
|
|
|
|
|
|
|
# ALLOW passing arguments here! |
63
|
87
|
|
|
|
|
940
|
$self->set( properties => {} ); |
64
|
87
|
|
|
|
|
721
|
$self->set( entries => [] ); |
65
|
87
|
|
|
|
|
377
|
for (@_) { |
66
|
43
|
100
|
|
|
|
84
|
ref $_ eq "HASH" and $self->add_properties( %$_ ); |
67
|
43
|
50
|
|
|
|
101
|
ref $_ eq "ARRAY" and $self->add_entries( @$_ ); |
68
|
|
|
|
|
|
|
} |
69
|
87
|
|
|
|
|
151
|
return $self; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 as_string [ crlf => C ] |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Returns the entry as an appropriately formatted string (with trailing |
75
|
|
|
|
|
|
|
newline). |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Properties are returned in alphabetical order, with multiple |
78
|
|
|
|
|
|
|
properties of the same name returned in the order added. (Property |
79
|
|
|
|
|
|
|
order is unimportant in iCalendar, and this makes testing easier.) |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
If any mandatory property is missing, issues a warning. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
The string to use as a newline can optionally be specified by giving |
84
|
|
|
|
|
|
|
the a C argument, which defaults to C<\x0d\x0a>, per RFC 2445 |
85
|
|
|
|
|
|
|
spec; this option is primarily for backwards compatibility with |
86
|
|
|
|
|
|
|
versions of this module before 0.16. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my $uid = 0; |
91
|
|
|
|
|
|
|
sub as_string { |
92
|
57
|
|
|
57
|
1
|
3930
|
my $self = shift; |
93
|
57
|
|
|
|
|
146
|
my %args = ( |
94
|
|
|
|
|
|
|
crlf => CRLF, |
95
|
|
|
|
|
|
|
@_ |
96
|
|
|
|
|
|
|
); |
97
|
57
|
|
|
|
|
202
|
my $output = $self->header(%args); |
98
|
|
|
|
|
|
|
|
99
|
57
|
|
|
|
|
171
|
my @mandatory = ( |
100
|
|
|
|
|
|
|
$self->mandatory_unique_properties, |
101
|
|
|
|
|
|
|
$self->mandatory_repeatable_properties, |
102
|
|
|
|
|
|
|
); |
103
|
|
|
|
|
|
|
|
104
|
57
|
0
|
33
|
|
|
115
|
if (grep {$_ eq "uid"} @mandatory and !defined $self->properties->{uid} |
|
74
|
|
33
|
|
|
172
|
|
105
|
|
|
|
|
|
|
and $self->auto_uid) { |
106
|
|
|
|
|
|
|
# Per the RFC, create a "persistent, globally unique" UID for this |
107
|
|
|
|
|
|
|
# event; "persistent" in this context does not mean consistent |
108
|
|
|
|
|
|
|
# across time, but rather "unique across all time" |
109
|
0
|
|
|
|
|
0
|
$self->add_property( |
110
|
|
|
|
|
|
|
uid => time() . '-' .$$ . '-' . $uid++ . '@' . Sys::Hostname::hostname() |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
57
|
|
|
|
|
89
|
for my $name ( @mandatory ) { |
115
|
74
|
|
|
|
|
625
|
carp "Mandatory property for " . ( ref $self ) . " missing: $name" |
116
|
|
|
|
|
|
|
unless $self->properties->{$name} |
117
|
74
|
100
|
66
|
|
|
922
|
and @{ $self->properties->{$name} }; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
290
|
100
|
|
|
|
783
|
my @properties = sort { |
121
|
|
|
|
|
|
|
# RFC2445 implies an order (see 4.6 Calendar Components) but does not |
122
|
|
|
|
|
|
|
# require it. However, some applications break if VERSION is not first |
123
|
|
|
|
|
|
|
# (see http://icalvalid.cloudapp.net/Default.aspx and [rt.cpan.org # #65447]). |
124
|
57
|
|
|
|
|
138
|
return -1 if $a eq 'version'; |
125
|
284
|
100
|
|
|
|
371
|
return 1 if $b eq 'version'; |
126
|
274
|
|
|
|
|
262
|
return $a cmp $b; |
127
|
57
|
|
|
|
|
276
|
} keys %{ $self->properties }; |
128
|
|
|
|
|
|
|
|
129
|
57
|
|
|
|
|
144
|
for my $name (@properties) { |
130
|
202
|
|
|
|
|
1537
|
$output .= $_ |
131
|
197
|
|
|
|
|
177
|
for map { $_->as_string(%args) } @{ $self->properties->{$name} }; |
|
197
|
|
|
|
|
366
|
|
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
57
|
|
|
|
|
66
|
for my $entry ( @{ $self->entries } ) { |
|
57
|
|
|
|
|
189
|
|
135
|
33
|
|
|
|
|
284
|
$output .= $entry->as_string(%args); |
136
|
|
|
|
|
|
|
} |
137
|
57
|
|
|
|
|
416
|
$output .= $self->footer(%args); |
138
|
|
|
|
|
|
|
|
139
|
57
|
|
|
|
|
284
|
return $output; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head2 add_entry $entry |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Adds an entry to this entry. (According to the standard, this should |
145
|
|
|
|
|
|
|
only be called on either a to-do or event entry with an alarm entry, |
146
|
|
|
|
|
|
|
or on a calendar entry (L) with a to-do, event, journal, |
147
|
|
|
|
|
|
|
timezone, or free/busy entry.) |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Returns true if the entry was successfully added, and false otherwise |
150
|
|
|
|
|
|
|
(perhaps because you tried to add an entry of an invalid type, but |
151
|
|
|
|
|
|
|
this check hasn't been implemented yet). |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub add_entry { |
156
|
60
|
|
|
60
|
1
|
714
|
my $self = shift; |
157
|
60
|
|
|
|
|
62
|
my $entry = shift; |
158
|
60
|
|
|
|
|
51
|
push @{ $self->{entries} }, $entry; |
|
60
|
|
|
|
|
105
|
|
159
|
|
|
|
|
|
|
|
160
|
60
|
|
|
|
|
117
|
$entry->vcal10( $self->vcal10 ); |
161
|
60
|
|
|
|
|
657
|
$entry->rfc_strict( $self->rfc_strict ); |
162
|
60
|
|
|
|
|
662
|
$entry->auto_uid( $self->auto_uid ); |
163
|
|
|
|
|
|
|
|
164
|
60
|
|
|
|
|
593
|
return $self; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 add_entries $entry1, [$entry2, ...] |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Convenience function to call C several times with a list |
170
|
|
|
|
|
|
|
of entries. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub add_entries { |
175
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
176
|
0
|
|
|
|
|
0
|
$self->add_entry( $_ ) for @_; |
177
|
0
|
|
|
|
|
0
|
return $self; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head2 entries |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Returns a reference to the array of subentries of this entry. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=cut |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
__PACKAGE__->mk_ro_accessors('entries'); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 properties |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Returns a reference to the hash of properties of this entry. The keys |
191
|
|
|
|
|
|
|
are property names and the values are array references containing |
192
|
|
|
|
|
|
|
L objects. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=cut |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
__PACKAGE__->mk_ro_accessors('properties'); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head2 property |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Given a property name returns a reference to the array of |
201
|
|
|
|
|
|
|
L objects. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=cut |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub property { |
206
|
44
|
|
|
44
|
1
|
9001
|
my $self = shift; |
207
|
44
|
|
|
|
|
76
|
my $prop = lc shift; |
208
|
44
|
|
|
|
|
159
|
return $self->{'properties'}->{$prop}; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 add_property $propname => $propval |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Creates a new L object with name C<$propname> |
214
|
|
|
|
|
|
|
and value C<$propval> and adds it to the event. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
If the property is not known to exist for that object type and does |
217
|
|
|
|
|
|
|
not begin with C, issues a warning. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
If the property is known to be unique, replaces the original property. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
To specify parameters for the property, let C<$propval> be a |
222
|
|
|
|
|
|
|
two-element array reference where the first element is the property |
223
|
|
|
|
|
|
|
value and the second element is a hash reference. The keys of the |
224
|
|
|
|
|
|
|
hash are parameter names; the values should be either strings or array |
225
|
|
|
|
|
|
|
references of strings, depending on whether the parameter should have |
226
|
|
|
|
|
|
|
one or multiple (to be comma-separated) values. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Examples of setting parameters: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# Add a property with a parameter of VALUE set to 'DATE' |
231
|
|
|
|
|
|
|
$event->add_property( rdate => [ $date, { VALUE => 'DATE' } ] ); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=cut |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub add_property { |
236
|
361
|
|
|
361
|
1
|
2897
|
my $self = shift; |
237
|
361
|
|
|
|
|
375
|
my $prop = lc shift; |
238
|
361
|
|
|
|
|
322
|
my $val = shift; |
239
|
|
|
|
|
|
|
|
240
|
361
|
50
|
|
|
|
568
|
return unless defined $prop; |
241
|
|
|
|
|
|
|
|
242
|
361
|
100
|
100
|
|
|
576
|
unless ( $self->is_property($prop) or $prop =~ /^x-/i ) { |
243
|
4
|
|
|
|
|
73
|
carp "Unknown property for " . ( ref $self ) . ": $prop"; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
361
|
100
|
|
|
|
4459
|
if ( $self->is_unique($prop) ) { |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# It should be unique, so clear out anything we might have first |
249
|
264
|
|
|
|
|
612
|
$self->properties->{$prop} = []; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
361
|
100
|
|
|
|
2544
|
$val = [ $val, {} ] unless ref $val eq 'ARRAY'; |
253
|
|
|
|
|
|
|
|
254
|
361
|
|
|
|
|
436
|
my ( $prop_value, $param_hash ) = @$val; |
255
|
|
|
|
|
|
|
|
256
|
361
|
|
|
|
|
896
|
my $p = Data::ICal::Property->new( $prop => $prop_value, $param_hash ); |
257
|
361
|
|
|
|
|
612
|
$p->vcal10( $self->vcal10 ); |
258
|
|
|
|
|
|
|
|
259
|
361
|
|
|
|
|
3247
|
push @{ $self->properties->{$prop} }, $p; |
|
361
|
|
|
|
|
551
|
|
260
|
361
|
|
|
|
|
2914
|
return $self; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head2 add_properties $propname1 => $propval1, [$propname2 => $propname2, ...] |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Convenience function to call C several times with a list |
266
|
|
|
|
|
|
|
of properties. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
This method is guaranteed to call add C on them in the |
269
|
|
|
|
|
|
|
order given, so that unique properties given later in the call will |
270
|
|
|
|
|
|
|
take precedence over those given earlier. (This is unrelated to the |
271
|
|
|
|
|
|
|
order of properties when the entry is rendered as a string, though.) |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Parameters for the properties are specified in the same way as in |
274
|
|
|
|
|
|
|
C. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=cut |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub add_properties { |
279
|
13
|
|
|
13
|
1
|
2207
|
my $self = shift; |
280
|
|
|
|
|
|
|
|
281
|
13
|
50
|
|
|
|
52
|
if ( @_ % 2 ) { |
282
|
0
|
|
|
|
|
0
|
carp "Odd number of elements in add_properties call"; |
283
|
0
|
|
|
|
|
0
|
return; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
13
|
|
|
|
|
42
|
while (@_) { |
287
|
32
|
|
|
|
|
40
|
my $prop = shift; |
288
|
32
|
|
|
|
|
39
|
my $val = shift; |
289
|
32
|
|
|
|
|
74
|
$self->add_property( $prop => $val ); |
290
|
|
|
|
|
|
|
} |
291
|
13
|
|
|
|
|
22
|
return $self; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=head2 mandatory_unique_properties |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
Subclasses should override this method (which returns an empty list by |
297
|
|
|
|
|
|
|
default) to provide a list of lower case strings identifying the |
298
|
|
|
|
|
|
|
properties which must appear exactly once in the subclass's entry |
299
|
|
|
|
|
|
|
type. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=cut |
302
|
|
|
|
|
|
|
|
303
|
0
|
|
|
0
|
1
|
0
|
sub mandatory_unique_properties { () } |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=head2 mandatory_repeatable_properties |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Subclasses should override this method (which returns an empty list by |
308
|
|
|
|
|
|
|
default) to provide a list of lower case strings identifying the |
309
|
|
|
|
|
|
|
properties which must appear at least once in the subclass's entry |
310
|
|
|
|
|
|
|
type. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=cut |
313
|
|
|
|
|
|
|
|
314
|
418
|
|
|
418
|
1
|
1885
|
sub mandatory_repeatable_properties { () } |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=head2 optional_unique_properties |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Subclasses should override this method (which returns an empty list by |
319
|
|
|
|
|
|
|
default) to provide a list of lower case strings identifying the |
320
|
|
|
|
|
|
|
properties which must appear at most once in the subclass's entry |
321
|
|
|
|
|
|
|
type. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|
325
|
240
|
|
|
240
|
1
|
321
|
sub optional_unique_properties { () } |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head2 optional_repeatable_properties |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Subclasses should override this method (which returns an empty list by |
330
|
|
|
|
|
|
|
default) to provide a list of lower case strings identifying the |
331
|
|
|
|
|
|
|
properties which may appear zero, one, or more times in the subclass's |
332
|
|
|
|
|
|
|
entry type. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=cut |
335
|
|
|
|
|
|
|
|
336
|
84
|
|
|
84
|
1
|
103
|
sub optional_repeatable_properties { () } |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head2 is_property $name |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
Returns a boolean value indicating whether or not the property |
341
|
|
|
|
|
|
|
C<$name> is known to the class (that is, if it's listed in |
342
|
|
|
|
|
|
|
C<(mandatory/optional)_(unique/repeatable)_properties>). |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=cut |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub is_property { |
347
|
361
|
|
|
361
|
1
|
281
|
my $self = shift; |
348
|
361
|
|
|
|
|
300
|
my $name = shift; |
349
|
361
|
|
|
|
|
681
|
return scalar grep { $_ eq $name } $self->mandatory_unique_properties, |
|
5973
|
|
|
|
|
6110
|
|
350
|
|
|
|
|
|
|
$self->mandatory_repeatable_properties, |
351
|
|
|
|
|
|
|
$self->optional_unique_properties, |
352
|
|
|
|
|
|
|
$self->optional_repeatable_properties; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head2 is_mandatory $name |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Returns a boolean value indicating whether or not the property |
358
|
|
|
|
|
|
|
C<$name> is known to the class as mandatory (that is, if it's listed |
359
|
|
|
|
|
|
|
in C). |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=cut |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub is_mandatory { |
364
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
365
|
0
|
|
|
|
|
0
|
my $name = shift; |
366
|
0
|
|
|
|
|
0
|
return scalar grep { $_ eq $name } $self->mandatory_unique_properties, |
|
0
|
|
|
|
|
0
|
|
367
|
|
|
|
|
|
|
$self->mandatory_repeatable_properties; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 is_optional $name |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Returns a boolean value indicating whether or not the property |
373
|
|
|
|
|
|
|
C<$name> is known to the class as optional (that is, if it's listed in |
374
|
|
|
|
|
|
|
C). |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=cut |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub is_optional { |
379
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
380
|
0
|
|
|
|
|
0
|
my $name = shift; |
381
|
0
|
|
|
|
|
0
|
return scalar grep { $_ eq $name } $self->optional_unique_properties, |
|
0
|
|
|
|
|
0
|
|
382
|
|
|
|
|
|
|
$self->optional_repeatable_properties; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 is_unique $name |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Returns a boolean value indicating whether or not the property |
388
|
|
|
|
|
|
|
C<$name> is known to the class as unique (that is, if it's listed in |
389
|
|
|
|
|
|
|
C<(mandatory/optional)_unique_properties>). |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=cut |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub is_unique { |
394
|
361
|
|
|
361
|
1
|
300
|
my $self = shift; |
395
|
361
|
|
|
|
|
307
|
my $name = shift; |
396
|
361
|
|
|
|
|
597
|
return scalar grep { $_ eq $name } $self->mandatory_unique_properties, |
|
3532
|
|
|
|
|
3642
|
|
397
|
|
|
|
|
|
|
$self->optional_unique_properties; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head2 is_repeatable $name |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Returns a boolean value indicating whether or not the property |
403
|
|
|
|
|
|
|
C<$name> is known to the class as repeatable (that is, if it's listed |
404
|
|
|
|
|
|
|
in C<(mandatory/optional)_repeatable_properties>). |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=cut |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub is_repeatable { |
409
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
410
|
0
|
|
|
|
|
0
|
my $name = shift; |
411
|
0
|
|
|
|
|
0
|
return scalar grep { $_ eq $name } $self->mandatory_repeatable_properties, |
|
0
|
|
|
|
|
0
|
|
412
|
|
|
|
|
|
|
$self->optional_repeatable_properties; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=head2 ical_entry_type |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
Subclasses should override this method to provide the identifying type |
418
|
|
|
|
|
|
|
name of the entry (such as C or C). |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=cut |
421
|
|
|
|
|
|
|
|
422
|
0
|
|
|
0
|
1
|
0
|
sub ical_entry_type {'UNDEFINED'} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head2 vcal10 [$bool] |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Gets or sets a boolean saying whether this entry should be interpreted |
427
|
|
|
|
|
|
|
as vCalendar 1.0 (as opposed to iCalendar 2.0). Generally, you can |
428
|
|
|
|
|
|
|
just set this on your main L object when you construct it; |
429
|
|
|
|
|
|
|
C automatically makes sure that sub-entries end up with the |
430
|
|
|
|
|
|
|
same value as their parents. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=cut |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('vcal10'); |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head2 rfc_strict [$bool] |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Gets or sets a boolean saying whether this entry will complain about |
439
|
|
|
|
|
|
|
missing UIDs as per RFC2446. Defaults to false, for backwards |
440
|
|
|
|
|
|
|
compatibility. Generally, you can just set this on your main |
441
|
|
|
|
|
|
|
L object when you construct it; C automatically |
442
|
|
|
|
|
|
|
makes sure that sub-entries end up with the same value as their parents. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=cut |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('rfc_strict'); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=head2 auto_uid [$bool] |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Gets or sets a boolean saying whether this entry should automatically |
451
|
|
|
|
|
|
|
generate its own persistently unique UIDs. Defaults to false. |
452
|
|
|
|
|
|
|
Generally, you can just set this on your main L object when |
453
|
|
|
|
|
|
|
you construct it; C automatically makes sure that sub-entries |
454
|
|
|
|
|
|
|
end up with the same value as their parents. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=cut |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('auto_uid'); |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head2 header |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Returns the header line for the entry (including trailing newline). |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=cut |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub header { |
467
|
57
|
|
|
57
|
1
|
61
|
my $self = shift; |
468
|
57
|
|
|
|
|
100
|
my %args = ( |
469
|
|
|
|
|
|
|
crlf => CRLF, |
470
|
|
|
|
|
|
|
@_ |
471
|
|
|
|
|
|
|
); |
472
|
57
|
|
|
|
|
158
|
return 'BEGIN:' . $self->ical_entry_type . $args{crlf}; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=head2 footer |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
Returns the footer line for the entry (including trailing newline). |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=cut |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub footer { |
482
|
57
|
|
|
57
|
1
|
64
|
my $self = shift; |
483
|
57
|
|
|
|
|
120
|
my %args = ( |
484
|
|
|
|
|
|
|
crlf => CRLF, |
485
|
|
|
|
|
|
|
@_ |
486
|
|
|
|
|
|
|
); |
487
|
57
|
|
|
|
|
137
|
return 'END:' . $self->ical_entry_type . $args{crlf}; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
# mapping of event types to class (under the Data::Ical::Event namespace) |
491
|
|
|
|
|
|
|
my %_generic = ( |
492
|
|
|
|
|
|
|
vevent => 'Event', |
493
|
|
|
|
|
|
|
vtodo => 'Todo', |
494
|
|
|
|
|
|
|
vjournal => 'Journal', |
495
|
|
|
|
|
|
|
vfreebusy => 'FreeBusy', |
496
|
|
|
|
|
|
|
vtimezone => 'TimeZone', |
497
|
|
|
|
|
|
|
standard => 'TimeZone::Standard', |
498
|
|
|
|
|
|
|
daylight => 'TimeZone::Daylight', |
499
|
|
|
|
|
|
|
); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=head2 parse_object |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Translate a L sub object into the appropriate |
504
|
|
|
|
|
|
|
L subtype. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=cut |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
# TODO: this is currently recursive which could blow the stack - |
509
|
|
|
|
|
|
|
# it might be worth refactoring to make it sequential |
510
|
|
|
|
|
|
|
sub parse_object { |
511
|
66
|
|
|
66
|
1
|
73
|
my ( $self, $object ) = @_; |
512
|
|
|
|
|
|
|
|
513
|
66
|
|
|
|
|
88
|
my $type = $object->{type}; |
514
|
|
|
|
|
|
|
|
515
|
66
|
|
|
|
|
60
|
my $new_self; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# First check to see if it's generic long name just in case there |
518
|
|
|
|
|
|
|
# event turns out to be a VGENERIC entry type |
519
|
66
|
100
|
|
|
|
270
|
if ( my $class = $_generic{ lc($type) } ) { |
|
|
50
|
|
|
|
|
|
520
|
48
|
|
|
|
|
117
|
$new_self = $self->_parse_data_ical_generic( $class, $object ); |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# then look for specific overrides |
523
|
|
|
|
|
|
|
} elsif ( my $sub = $self->can( '_parse_' . lc($type) ) ) { |
524
|
18
|
|
|
|
|
45
|
$new_self = $self->$sub($object); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# complain |
527
|
|
|
|
|
|
|
} else { |
528
|
0
|
|
|
|
|
0
|
warn "Can't parse type $type yet"; |
529
|
0
|
|
|
|
|
0
|
return; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# recurse through sub-objects |
533
|
66
|
|
|
|
|
82
|
foreach my $sub_object ( @{ $object->{objects} } ) { |
|
66
|
|
|
|
|
166
|
|
534
|
53
|
|
|
|
|
112
|
$new_self->parse_object($sub_object); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
66
|
|
|
|
|
147
|
return $self; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# special because we want to use ourselves as the parent |
541
|
|
|
|
|
|
|
sub _parse_vcalendar { |
542
|
13
|
|
|
13
|
|
16
|
my ( $self, $object ) = @_; |
543
|
13
|
|
|
|
|
47
|
$self->_parse_generic_event( $self, $object ); |
544
|
13
|
|
|
|
|
25
|
return $self; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# mapping of action types to class (under the Data::Ical::Event::Alarm namespace) |
548
|
|
|
|
|
|
|
my %_action_map = ( |
549
|
|
|
|
|
|
|
AUDIO => 'Audio', |
550
|
|
|
|
|
|
|
DISPLAY => 'Display', |
551
|
|
|
|
|
|
|
EMAIL => 'Email', |
552
|
|
|
|
|
|
|
PROCEDURE => 'Procedure', |
553
|
|
|
|
|
|
|
NONE => 'None', |
554
|
|
|
|
|
|
|
URI => 'URI', |
555
|
|
|
|
|
|
|
); |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# alarms have actions |
558
|
|
|
|
|
|
|
sub _parse_valarm { |
559
|
5
|
|
|
5
|
|
7
|
my ( $parent, $object ) = @_; |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# ick |
562
|
5
|
|
|
|
|
11
|
my $action = $object->{properties}->{ACTION}->[0]->{value}; |
563
|
5
|
50
|
|
|
|
14
|
die "Can't parse VALARM with action $action" |
564
|
|
|
|
|
|
|
unless exists $_action_map{$action}; |
565
|
|
|
|
|
|
|
|
566
|
5
|
|
|
|
|
7
|
$action = $_action_map{$action}; |
567
|
5
|
|
|
|
|
9
|
my $alarm_class = "Data::ICal::Entry::Alarm::$action"; |
568
|
5
|
|
|
|
|
279
|
eval "require $alarm_class"; |
569
|
5
|
50
|
|
|
|
20
|
die "Failed to require $alarm_class : $@" if $@; |
570
|
|
|
|
|
|
|
|
571
|
5
|
|
|
|
|
34
|
$alarm_class->import; |
572
|
5
|
|
|
|
|
66
|
my $alarm = $alarm_class->new; |
573
|
5
|
|
|
|
|
15
|
$parent->_parse_generic_event( $alarm, $object ); |
574
|
5
|
|
|
|
|
17
|
$parent->add_entry($alarm); |
575
|
5
|
|
|
|
|
9
|
return $alarm; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
# generic event handler |
579
|
|
|
|
|
|
|
sub _parse_data_ical_generic { |
580
|
48
|
|
|
48
|
|
47
|
my ( $parent, $class, $object ) = @_; |
581
|
|
|
|
|
|
|
|
582
|
48
|
|
|
|
|
78
|
my $entry_class = "Data::ICal::Entry::$class"; |
583
|
48
|
|
|
|
|
2676
|
eval "require $entry_class"; |
584
|
48
|
50
|
|
|
|
182
|
die "Failed to require $entry_class : $@" if $@; |
585
|
|
|
|
|
|
|
|
586
|
48
|
|
|
|
|
231
|
$entry_class->import; |
587
|
48
|
|
|
|
|
634
|
my $entry = $entry_class->new; |
588
|
48
|
|
|
|
|
113
|
$entry->vcal10($parent->vcal10); |
589
|
48
|
|
|
|
|
615
|
$parent->_parse_generic_event( $entry, $object ); |
590
|
48
|
|
|
|
|
117
|
$parent->add_entry($entry); |
591
|
48
|
|
|
|
|
70
|
return $entry; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# handle transferring of properties |
595
|
|
|
|
|
|
|
sub _parse_generic_event { |
596
|
66
|
|
|
66
|
|
89
|
my ( $parent, $entry, $object ) = @_; |
597
|
|
|
|
|
|
|
|
598
|
66
|
|
|
|
|
83
|
my $p = $object->{properties}; |
599
|
66
|
|
|
|
|
324
|
for my $key ( sort keys %$p ) { |
600
|
315
|
|
|
|
|
254
|
foreach my $occurence (@{ $p->{$key} }) { |
|
315
|
|
|
|
|
457
|
|
601
|
315
|
|
|
|
|
210
|
my $prop; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# Unescapes, but only in v2, and not if it's explicitly not TEXT |
604
|
315
|
100
|
66
|
|
|
567
|
if (not $parent->vcal10 |
|
|
|
66
|
|
|
|
|
605
|
|
|
|
|
|
|
and ( not $occurence->{param} |
606
|
|
|
|
|
|
|
or not defined $occurence->{param}{VALUE} |
607
|
|
|
|
|
|
|
or $occurence->{param}{VALUE} eq "TEXT" ) |
608
|
|
|
|
|
|
|
) |
609
|
|
|
|
|
|
|
{ |
610
|
189
|
|
|
|
|
1740
|
$occurence->{value} =~ s/\\([;,\\])/$1/g; |
611
|
189
|
|
|
|
|
296
|
$occurence->{value} =~ s/\\n/\n/ig; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# handle optional params and 'normal' key/value pairs |
615
|
|
|
|
|
|
|
# TODO: line wrapping? |
616
|
315
|
100
|
|
|
|
1208
|
if ( $occurence->{param} ) { |
617
|
30
|
|
|
|
|
96
|
$prop = [ $occurence->{value}, $occurence->{param} ]; |
618
|
|
|
|
|
|
|
} else { |
619
|
285
|
|
|
|
|
316
|
$prop = $occurence->{value}; |
620
|
|
|
|
|
|
|
} |
621
|
315
|
|
|
|
|
815
|
$entry->add_property( lc($key) => $prop ); |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
} |
624
|
66
|
|
|
|
|
111
|
return $entry; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head1 AUTHOR |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Best Practical Solutions, LLC Emodules@bestpractical.comE |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Copyright (c) 2005 - 2015, Best Practical Solutions, LLC. All rights reserved. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
636
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. See L. |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=cut |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
1; |