line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::ICal::RDF; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# le pragma |
4
|
1
|
|
|
1
|
|
22182
|
use 5.010; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
5
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings FATAL => 'all'; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
44
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# le moo and friends |
9
|
1
|
|
|
1
|
|
509
|
use Moo; |
|
1
|
|
|
|
|
16823
|
|
|
1
|
|
|
|
|
6
|
|
10
|
1
|
|
|
1
|
|
2548
|
use namespace::autoclean; |
|
1
|
|
|
|
|
13485
|
|
|
1
|
|
|
|
|
4
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# we do need these symbols |
13
|
1
|
|
|
1
|
|
333
|
use RDF::Trine qw(statement iri literal); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use UUID::Tiny qw(UUID_V4); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# but don't screw around loading symbols on these |
17
|
|
|
|
|
|
|
use DateTime (); |
18
|
|
|
|
|
|
|
use DateTime::Duration (); |
19
|
|
|
|
|
|
|
use DateTime::Format::W3CDTF (); |
20
|
|
|
|
|
|
|
use DateTime::Format::ICal (); |
21
|
|
|
|
|
|
|
use DateTime::TimeZone::ICal (); |
22
|
|
|
|
|
|
|
use Data::ICal (); |
23
|
|
|
|
|
|
|
use MIME::Base64 (); |
24
|
|
|
|
|
|
|
use IO::Scalar (); |
25
|
|
|
|
|
|
|
use Path::Class (); |
26
|
|
|
|
|
|
|
use Scalar::Util (); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# oh and our buddy: |
29
|
|
|
|
|
|
|
with 'Throwable'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 NAME |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Data::ICal::RDF - Turn iCal files into an RDF graph |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 VERSION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Version 0.03 |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# built-in ref types for our robust type checker |
44
|
|
|
|
|
|
|
my %CORE = map { $_ => 1 } qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE |
45
|
|
|
|
|
|
|
FORMAT IO VSTRING Regexp); |
46
|
|
|
|
|
|
|
sub _is_really { |
47
|
|
|
|
|
|
|
my ($val, $type) = @_; |
48
|
|
|
|
|
|
|
# bail out early on undef |
49
|
|
|
|
|
|
|
return unless defined $val; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# bail out early on literals |
52
|
|
|
|
|
|
|
my $ref = ref $val or return; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
if (Scalar::Util::blessed($val)) { |
55
|
|
|
|
|
|
|
# only do ->isa on non-core reftypes |
56
|
|
|
|
|
|
|
return $CORE{$type} ? |
57
|
|
|
|
|
|
|
Scalar::Util::reftype($val) eq $type : $val->isa($type); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
else { |
60
|
|
|
|
|
|
|
# only return true if supplied reftype is in core |
61
|
|
|
|
|
|
|
return $CORE{$type} && $ref eq $type; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# shorthands for UUID functions |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub _uuid () { |
68
|
|
|
|
|
|
|
lc UUID::Tiny::create_uuid_as_string(UUID_V4); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub _uuid_urn () { |
72
|
|
|
|
|
|
|
'urn:uuid:' . _uuid; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# this thing has been copied a million and one times |
76
|
|
|
|
|
|
|
my $NS = RDF::Trine::NamespaceMap->new({ |
77
|
|
|
|
|
|
|
rdf => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#', |
78
|
|
|
|
|
|
|
rdfs => 'http://www.w3.org/2000/01/rdf-schema#', |
79
|
|
|
|
|
|
|
owl => 'http://www.w3.org/2002/07/owl#', |
80
|
|
|
|
|
|
|
xsd => 'http://www.w3.org/2001/XMLSchema#', |
81
|
|
|
|
|
|
|
dct => 'http://purl.org/dc/terms/', |
82
|
|
|
|
|
|
|
foaf => 'http://xmlns.com/foaf/0.1/', |
83
|
|
|
|
|
|
|
ical => 'http://www.w3.org/2002/12/cal/icaltzd#', |
84
|
|
|
|
|
|
|
geo => 'http://www.w3.org/2003/01/geo/wgs84_pos#', |
85
|
|
|
|
|
|
|
}); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# this will capture the segments of a properly-formed v4 uuid |
88
|
|
|
|
|
|
|
my $UUID4 = qr/([0-9A-Fa-f]{8}) |
89
|
|
|
|
|
|
|
-?([0-9A-Fa-f]{4}) |
90
|
|
|
|
|
|
|
-?(4[0-9A-Fa-f]{3}) |
91
|
|
|
|
|
|
|
-?([89ABab][0-9A-Fa-f]{3}) |
92
|
|
|
|
|
|
|
-?([0-9A-Fa-f]{12})/x; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# iCal properties and their default datatypes. types with a star are |
95
|
|
|
|
|
|
|
# overrides |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my %PROPS = ( |
98
|
|
|
|
|
|
|
CALSCALE => 'TEXT', |
99
|
|
|
|
|
|
|
METHOD => 'TEXT', |
100
|
|
|
|
|
|
|
PRODID => 'TEXT', |
101
|
|
|
|
|
|
|
VERSION => 'TEXT', |
102
|
|
|
|
|
|
|
ATTACH => 'URI', |
103
|
|
|
|
|
|
|
CATEGORIES => 'LIST*', # TEXT |
104
|
|
|
|
|
|
|
CLASS => 'TEXT', |
105
|
|
|
|
|
|
|
COMMENT => 'TEXT', |
106
|
|
|
|
|
|
|
DESCRIPTION => 'TEXT', |
107
|
|
|
|
|
|
|
GEO => 'COORDS*', # FLOAT |
108
|
|
|
|
|
|
|
LOCATION => 'TEXT', |
109
|
|
|
|
|
|
|
'PERCENT-COMPLETE' => 'INTEGER', |
110
|
|
|
|
|
|
|
PRIORITY => 'INTEGER', |
111
|
|
|
|
|
|
|
RESOURCES => 'LIST*', # TEXT |
112
|
|
|
|
|
|
|
STATUS => 'LIST*', # actually an enum |
113
|
|
|
|
|
|
|
SUMMARY => 'TEXT', |
114
|
|
|
|
|
|
|
COMPLETED => 'DATE-TIME', |
115
|
|
|
|
|
|
|
DTEND => 'DATE-TIME', |
116
|
|
|
|
|
|
|
DUE => 'DATE-TIME', |
117
|
|
|
|
|
|
|
DTSTART => 'DATE-TIME', |
118
|
|
|
|
|
|
|
DURATION => 'DURATION', |
119
|
|
|
|
|
|
|
FREEBUSY => 'PERIOD', |
120
|
|
|
|
|
|
|
TRANSP => 'LIST*', # actually enum |
121
|
|
|
|
|
|
|
TZID => 'TEXT', |
122
|
|
|
|
|
|
|
TZNAME => 'TEXT', |
123
|
|
|
|
|
|
|
TZOFFSETFROM => 'UTC-OFFSET', |
124
|
|
|
|
|
|
|
TZOFFSETTO => 'UTC-OFFSET', |
125
|
|
|
|
|
|
|
TZURL => 'URI', |
126
|
|
|
|
|
|
|
ATTENDEE => 'CAL-ADDRESS', |
127
|
|
|
|
|
|
|
CONTACT => 'TEXT', |
128
|
|
|
|
|
|
|
ORGANIZER => 'CAL-ADDRES', |
129
|
|
|
|
|
|
|
'RECURRENCE-ID' => 'DATE-TIME', |
130
|
|
|
|
|
|
|
'RELATED-TO' => 'TEXT', # actually UID |
131
|
|
|
|
|
|
|
URL => 'URI', |
132
|
|
|
|
|
|
|
UID => 'TEXT', |
133
|
|
|
|
|
|
|
EXDATE => 'DATE-TIME', |
134
|
|
|
|
|
|
|
RDATE => 'DATE-TIME', |
135
|
|
|
|
|
|
|
RRULE => 'RECUR', |
136
|
|
|
|
|
|
|
ACTION => 'LIST*', # actually enum |
137
|
|
|
|
|
|
|
REPEAT => 'INTEGER', |
138
|
|
|
|
|
|
|
TRIGGER => 'DURATION', |
139
|
|
|
|
|
|
|
CREATED => 'DATE-TIME', |
140
|
|
|
|
|
|
|
DTSTAMP => 'DATE-TIME', |
141
|
|
|
|
|
|
|
'LAST-MODIFIED' => 'DATE-TIME', |
142
|
|
|
|
|
|
|
SEQUENCE => 'INTEGER', |
143
|
|
|
|
|
|
|
'REQUEST-STATUS' => 'TEXT', |
144
|
|
|
|
|
|
|
); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# the icaltzd spec (http://www.w3.org/2002/12/cal/icaltzd#) is pretty |
147
|
|
|
|
|
|
|
# much derived deterministically from rfc 2445 (now 5445). properties |
148
|
|
|
|
|
|
|
# are lower case unless hyphenated, in which event they are camelCased. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# however we don't want to use the ical properties on everything, |
151
|
|
|
|
|
|
|
# notably: created, last modified, geo coords |
152
|
|
|
|
|
|
|
my %PRED = ( |
153
|
|
|
|
|
|
|
CREATED => $NS->dct->created, |
154
|
|
|
|
|
|
|
'LAST-MODIFIED' => $NS->dct->modified, |
155
|
|
|
|
|
|
|
); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# this gives us the correct predicate |
158
|
|
|
|
|
|
|
sub _predicate_for { |
159
|
|
|
|
|
|
|
my ($self, $prop) = @_; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# get the name |
162
|
|
|
|
|
|
|
my $name = lc $prop->key; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
return $PRED{uc $name} if $PRED{uc $name}; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my ($first, @rest) = split /-/, $name; |
167
|
|
|
|
|
|
|
$name = $first . join '', map { ucfirst $_ } @rest if @rest; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
$NS->ical->uri($name); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# this is a helper for BINARY values. |
173
|
|
|
|
|
|
|
sub _decode_property { |
174
|
|
|
|
|
|
|
my $prop = shift; |
175
|
|
|
|
|
|
|
my $enc = uc($prop->parameters->{ENCODING} || 'BASE64'); |
176
|
|
|
|
|
|
|
if ($enc eq 'BASE64') { |
177
|
|
|
|
|
|
|
# for some reason base64 is not built into Data::ICal. |
178
|
|
|
|
|
|
|
return MIME::Base64::decode($prop->value); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
elsif ($enc eq 'QUOTED-PRINTABLE') { |
181
|
|
|
|
|
|
|
# QP *is* built in, however. |
182
|
|
|
|
|
|
|
return $prop->decoded_value; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
else { |
185
|
|
|
|
|
|
|
return; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# these get run as faux methods and their job is to insert statements |
190
|
|
|
|
|
|
|
# into the temporary store. |
191
|
|
|
|
|
|
|
my %VALS = ( |
192
|
|
|
|
|
|
|
BINARY => sub { |
193
|
|
|
|
|
|
|
# ohhhhhh this one's gonna be fun. |
194
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# get the literal value |
197
|
|
|
|
|
|
|
my $val = _decode_property($prop); |
198
|
|
|
|
|
|
|
return unless defined $val; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $param = $prop->parameters; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# get a suitable content type |
203
|
|
|
|
|
|
|
my ($type) = (lc($param->{FMTTYPE} || 'application/octet-stream') =~ |
204
|
|
|
|
|
|
|
/^\s*(.*?)(?:\s*;.*)?$/); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# too bad there isn't a standardized parameter for file names |
207
|
|
|
|
|
|
|
my $name = $param->{'X-FILENAME'} || $param->{'X-APPLE-FILENAME'}; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# this is where the securi-tah happens, folks. |
210
|
|
|
|
|
|
|
if (defined $name) { |
211
|
|
|
|
|
|
|
# remove any space padding |
212
|
|
|
|
|
|
|
$name =~ s/^\s*(.*?)\s*$/$1/; |
213
|
|
|
|
|
|
|
# scrub the filename of any naughty path info |
214
|
|
|
|
|
|
|
$name = Path::Class::File->new($name)->basename if $name ne ''; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# kill the name if all that's left is an empty string |
217
|
|
|
|
|
|
|
undef $name if $name eq ''; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# turn the val into an IO object |
221
|
|
|
|
|
|
|
my $io = IO::Scalar->new(\$val); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# now try to resolve the attachment |
224
|
|
|
|
|
|
|
my $o = eval { $self->resolve_binary->($self, $io, $type, $name) }; |
225
|
|
|
|
|
|
|
$self->throw("resolve_binary callback failed: $@") if $@; |
226
|
|
|
|
|
|
|
$self->throw('resolve_binary callback returned an invalid value') |
227
|
|
|
|
|
|
|
unless _is_really($o, 'RDF::Trine::Node'); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
230
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
$val; |
233
|
|
|
|
|
|
|
}, |
234
|
|
|
|
|
|
|
BOOLEAN => sub { |
235
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# postel's law |
238
|
|
|
|
|
|
|
my $x = 1 if $prop->value =~ /1|true|on|yes/i; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# output |
241
|
|
|
|
|
|
|
my $o = literal($x ? 'true' : 'false', undef, $NS->xsd->boolean); |
242
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
243
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# now return proper boolean |
246
|
|
|
|
|
|
|
$x || 0; |
247
|
|
|
|
|
|
|
}, |
248
|
|
|
|
|
|
|
'CAL-ADDRESS' => sub {}, |
249
|
|
|
|
|
|
|
DATE => sub { |
250
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# this will croak a proper error |
253
|
|
|
|
|
|
|
my $dt = DateTime::Format::ICal->parse_datetime($prop->value); |
254
|
|
|
|
|
|
|
my $o = literal($dt->ymd, undef, $NS->xsd->date); |
255
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
256
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# maybe make this a DateTime::Incomplete? |
259
|
|
|
|
|
|
|
$dt; |
260
|
|
|
|
|
|
|
}, |
261
|
|
|
|
|
|
|
'DATE-TIME' => sub { |
262
|
|
|
|
|
|
|
# this needs access to tz |
263
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
my $dt = DateTime::Format::ICal->parse_datetime($prop->value); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
my $tzid = $prop->parameters->{TZID}; |
268
|
|
|
|
|
|
|
#warn "TZID: $tzid" if $tzid; |
269
|
|
|
|
|
|
|
#require Data::Dumper; |
270
|
|
|
|
|
|
|
#warn Data::Dumper::Dumper($self->tz); |
271
|
|
|
|
|
|
|
if ($tzid and my $tz = $self->tz->{$tzid}) { |
272
|
|
|
|
|
|
|
#warn 'hooray that whole effort worked!'; |
273
|
|
|
|
|
|
|
$dt->set_time_zone($tz); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
my $dtf = DateTime::Format::W3CDTF->new; |
277
|
|
|
|
|
|
|
my $o = literal($dtf->format_datetime($dt), |
278
|
|
|
|
|
|
|
undef, $NS->xsd->dateTime); |
279
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
280
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
281
|
|
|
|
|
|
|
}, |
282
|
|
|
|
|
|
|
DURATION => sub { |
283
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
284
|
|
|
|
|
|
|
}, |
285
|
|
|
|
|
|
|
FLOAT => sub { |
286
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
287
|
|
|
|
|
|
|
my ($f) = ($prop->value =~ /([+-]?\d+(?:\.\d+)?)/); |
288
|
|
|
|
|
|
|
return unless defined $f; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
291
|
|
|
|
|
|
|
my $o = literal($f += 0.0, undef, $NS->xsd->decimal); |
292
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
$f; |
295
|
|
|
|
|
|
|
}, |
296
|
|
|
|
|
|
|
INTEGER => sub { |
297
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
298
|
|
|
|
|
|
|
my ($d) = ($prop->value =~ /([+-]?\d+)/); |
299
|
|
|
|
|
|
|
return unless defined $d; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
302
|
|
|
|
|
|
|
my $o = literal($d += 0, undef, $NS->xsd->integer); |
303
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
$d; |
306
|
|
|
|
|
|
|
}, |
307
|
|
|
|
|
|
|
PERIOD => sub { |
308
|
|
|
|
|
|
|
# this needs access to tz |
309
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
310
|
|
|
|
|
|
|
}, |
311
|
|
|
|
|
|
|
RECUR => sub { |
312
|
|
|
|
|
|
|
# this needs access to dtstart which may itself need tz |
313
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
314
|
|
|
|
|
|
|
}, |
315
|
|
|
|
|
|
|
TEXT => sub { |
316
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
317
|
|
|
|
|
|
|
# get the property |
318
|
|
|
|
|
|
|
my $val = $prop->value; |
319
|
|
|
|
|
|
|
return unless defined $val; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# trim whitespace |
322
|
|
|
|
|
|
|
$val =~ s/^\s*(.*?)\s*$/$1/sm; |
323
|
|
|
|
|
|
|
return if $val eq ''; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# prep the statement |
326
|
|
|
|
|
|
|
my $lang = $prop->parameters->{LANGUAGE}; |
327
|
|
|
|
|
|
|
my $o = literal($val, $lang); |
328
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
329
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, $o)); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# return the value just cause |
332
|
|
|
|
|
|
|
$val; |
333
|
|
|
|
|
|
|
}, |
334
|
|
|
|
|
|
|
TIME => sub { |
335
|
|
|
|
|
|
|
# this needs access to tz |
336
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
337
|
|
|
|
|
|
|
}, |
338
|
|
|
|
|
|
|
URI => sub { |
339
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
my $uri = URI->new($prop->value)->canonical; |
342
|
|
|
|
|
|
|
my $p = $self->_predicate_for($prop); |
343
|
|
|
|
|
|
|
$self->model->add_statement(statement($s, $p, iri($uri->as_string))); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
$uri; |
346
|
|
|
|
|
|
|
}, |
347
|
|
|
|
|
|
|
'UTC-OFFSET' => sub {}, |
348
|
|
|
|
|
|
|
# now for my own pseudo-types |
349
|
|
|
|
|
|
|
COORDS => sub { |
350
|
|
|
|
|
|
|
#my ($self, $prop, $s) = @_; |
351
|
|
|
|
|
|
|
}, |
352
|
|
|
|
|
|
|
LIST => sub { |
353
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
354
|
|
|
|
|
|
|
# so it turns out that Data::ICal or whatever it inherits from |
355
|
|
|
|
|
|
|
# can't tell the difference between an escaped comma and an |
356
|
|
|
|
|
|
|
# actual syntactical comma, meaning that this will always be |
357
|
|
|
|
|
|
|
# broken for strings that contain (literal) commas. |
358
|
|
|
|
|
|
|
my $x; |
359
|
|
|
|
|
|
|
}, |
360
|
|
|
|
|
|
|
); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
# this marshals the contents of %VALS |
363
|
|
|
|
|
|
|
sub _process_property { |
364
|
|
|
|
|
|
|
my ($self, $prop, $s) = @_; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# XXX the two early exits in here would only happen if either of |
367
|
|
|
|
|
|
|
# the two hashes were wrong. i'm ambivalent about going to the |
368
|
|
|
|
|
|
|
# trouble of making them throw. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# find the default type for the content |
371
|
|
|
|
|
|
|
my $key = uc $prop->key; |
372
|
|
|
|
|
|
|
my $type = $PROPS{$key} or return; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# star means override |
375
|
|
|
|
|
|
|
if ($type =~ /^(.*?)\*$/) { |
376
|
|
|
|
|
|
|
$type = $1; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
else { |
379
|
|
|
|
|
|
|
# otherwise override the default from a param if it exists |
380
|
|
|
|
|
|
|
my $v = $prop->parameters->{VALUE}; |
381
|
|
|
|
|
|
|
$type = $v if $v; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# find the processor for this value |
385
|
|
|
|
|
|
|
my $sub = $VALS{$type} or return; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# now run the content processor against the property and the |
388
|
|
|
|
|
|
|
# subject node. note the return value of this method is set by |
389
|
|
|
|
|
|
|
# whatever receives the dispatch. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# we don't want uninitialized value errors in here (even |
392
|
|
|
|
|
|
|
# though all properties should have a defined value). |
393
|
|
|
|
|
|
|
$sub->($self, $prop, $s) if defined $prop->value; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head1 SYNOPSIS |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
use Data::ICal::RDF; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# Instantiate a processing context with the appropriate handlers: |
402
|
|
|
|
|
|
|
my $context = Data::ICal::RDF->new( |
403
|
|
|
|
|
|
|
resolve_uid => sub { |
404
|
|
|
|
|
|
|
# returns an RDF node for the UID... |
405
|
|
|
|
|
|
|
}, |
406
|
|
|
|
|
|
|
resolve_binary => sub { |
407
|
|
|
|
|
|
|
# stores a binary object and resolves any relations |
408
|
|
|
|
|
|
|
# between it and its supplied file name; returns either an |
409
|
|
|
|
|
|
|
# identifier for the content or an identifier for the |
410
|
|
|
|
|
|
|
# relation between the name and the content. |
411
|
|
|
|
|
|
|
}, |
412
|
|
|
|
|
|
|
); |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# Process a Data::ICal object... |
415
|
|
|
|
|
|
|
$context->process($ical); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# Successive calls to 'process' against different iCal objects |
418
|
|
|
|
|
|
|
# will accumulate statements in the context's internal model. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# Now you can do whatever you like with the model. |
421
|
|
|
|
|
|
|
my $result = $context->model; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head1 DESCRIPTION |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
This module is a processor context for turning L<Data::ICal> objects |
426
|
|
|
|
|
|
|
into RDF data. By default it uses version 4 (i.e., random) UUIDs as |
427
|
|
|
|
|
|
|
subject nodes. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head1 METHODS |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head2 new %PARAMS |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Initialize the processor context. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=over 4 |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=item resolve_uid |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
Supply a callback function to resolve the C<UID> property of an iCal |
440
|
|
|
|
|
|
|
object. This function I<must> return a L<RDF::Trine::Node::Resource> |
441
|
|
|
|
|
|
|
or L<RDF::Trine::Node::Blank>. The function is handed: |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=over 4 |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=item 1. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
The context object itself, meaning the function should be written as |
448
|
|
|
|
|
|
|
if it were a mixin of L<Data::ICal::RDF>, |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item 2. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
The C<UID> of the iCal entry as a string literal. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=back |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
This function is used in L</subject_for>, which is used by |
457
|
|
|
|
|
|
|
L</process_events>, which is used by L</process>. If the function is |
458
|
|
|
|
|
|
|
not reliable for any reason, such as a failure to access hardware or |
459
|
|
|
|
|
|
|
network resources, those methods may C<croak>. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
By default the processor will automatically convert iCal UIDs which |
462
|
|
|
|
|
|
|
are V4 UUIDs into C<urn:uuid:> URIs and use them as the subjects of |
463
|
|
|
|
|
|
|
the resulting RDF statements. Furthermore, this is checked I<before> |
464
|
|
|
|
|
|
|
running this function to mitigate any database overhead (see |
465
|
|
|
|
|
|
|
L</no_uuids>). A V4 UUID URN is also generated as the iCal data's |
466
|
|
|
|
|
|
|
subject if this function returns C<undef>. If you do I<not> want to |
467
|
|
|
|
|
|
|
use UUIDs, then this function must I<always> return a valid value. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
Here is an example of a method in a fictitious class which generates a |
470
|
|
|
|
|
|
|
closure suitable to pass into the L<Data::ICal::RDF> constructor: |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub generate_resolve_uid { |
473
|
|
|
|
|
|
|
my $self = shift; |
474
|
|
|
|
|
|
|
return sub { |
475
|
|
|
|
|
|
|
my ($data_ical_rdf, $uid) = @_; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# magically look up a resource node from some other |
478
|
|
|
|
|
|
|
# data source |
479
|
|
|
|
|
|
|
return $self->lookup_uid($uid); |
480
|
|
|
|
|
|
|
}; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
This parameter is I<required>. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=cut |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
has resolve_uid => ( |
488
|
|
|
|
|
|
|
is => 'ro', |
489
|
|
|
|
|
|
|
isa => sub { die 'resolve_uid must be a CODE reference' |
490
|
|
|
|
|
|
|
unless _is_really($_[0], 'CODE') }, |
491
|
|
|
|
|
|
|
required => 1, |
492
|
|
|
|
|
|
|
); |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item resolve_binary |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
Supply a callback function to handle inline C<BINARY> attachments. |
497
|
|
|
|
|
|
|
This function I<must> return a L<RDF::Trine::Node::Resource> or |
498
|
|
|
|
|
|
|
L<RDF::Trine::Node::Blank>. The function is handed: |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=over 4 |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=item 1. |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
The context object itself, meaning the function should be written as |
505
|
|
|
|
|
|
|
if it were a mixin of L<Data::ICal::RDF>, |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=item 2. |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
The binary data as a seekable IO object, |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=item 3. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
The I<declared> Content-Type of the data (as in you might want to |
514
|
|
|
|
|
|
|
verify it using something like L<File::MMagic> or |
515
|
|
|
|
|
|
|
L<File::MimeInfo::Magic>), |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=item 4. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
The suggested file name, which will already be stripped of any |
520
|
|
|
|
|
|
|
erroneous path information. File names of zero length or containing |
521
|
|
|
|
|
|
|
only whitespace will not be passed into this function, so you need |
522
|
|
|
|
|
|
|
only check if it is C<defined>. |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=back |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
This function is used in the C<BINARY> type handler in |
527
|
|
|
|
|
|
|
L</process_events>, which is used by L</process>. Once again, if this |
528
|
|
|
|
|
|
|
function is not completely reliable, those methods may C<croak>. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Here is an example of a method in a fictitious class which generates a |
531
|
|
|
|
|
|
|
closure suitable to pass into the L<Data::ICal::RDF> constructor: |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub generate_resolve_binary { |
534
|
|
|
|
|
|
|
my $self = shift; |
535
|
|
|
|
|
|
|
return sub { |
536
|
|
|
|
|
|
|
my ($data_ical_rdf, $io, $type, $name) = @_; |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# store the content somewhere and get back an identifier |
539
|
|
|
|
|
|
|
my $content_id = $self->store($io, $type); |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# return the content ID if there is no file name |
542
|
|
|
|
|
|
|
return $content_id unless defined $name; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# turn the name into an RDF literal |
545
|
|
|
|
|
|
|
$name = RDF::Trine::Node::Literal->new($name); |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# now retrieve the subject node that binds the filename |
548
|
|
|
|
|
|
|
# to the content identifier |
549
|
|
|
|
|
|
|
my $subj = $self->get_subject_for($content_id, $name); |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# now perhaps write the relevant statements back into |
552
|
|
|
|
|
|
|
# the parser context's internal model |
553
|
|
|
|
|
|
|
map { $data_ical_rdf->model->add_statement($_) } |
554
|
|
|
|
|
|
|
for $self->statements_for($content_id, $name); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# now we want to return the retrieved *subject*, which |
557
|
|
|
|
|
|
|
# will be passed into the upstream RDF statement |
558
|
|
|
|
|
|
|
# generation function. |
559
|
|
|
|
|
|
|
return $subj; |
560
|
|
|
|
|
|
|
}; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
This parameter is I<required>. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=cut |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
has resolve_binary => ( |
568
|
|
|
|
|
|
|
is => 'ro', |
569
|
|
|
|
|
|
|
isa => sub { die 'resolve_binary must be a CODE reference' |
570
|
|
|
|
|
|
|
unless _is_really($_[0], 'CODE') }, |
571
|
|
|
|
|
|
|
required => 1, |
572
|
|
|
|
|
|
|
); |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=item model |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Supply an L<RDF::Trine::Model> object to use instead of an internal |
577
|
|
|
|
|
|
|
temporary model, for direct interface to some other RDF data |
578
|
|
|
|
|
|
|
store. Note that this is also accessible through the L</model> |
579
|
|
|
|
|
|
|
accessor. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
This parameter is I<optional>. |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=cut |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
has model => ( |
586
|
|
|
|
|
|
|
is => 'ro', |
587
|
|
|
|
|
|
|
default => sub { |
588
|
|
|
|
|
|
|
RDF::Trine::Model->new(RDF::Trine::Store::Hexastore->new) }, |
589
|
|
|
|
|
|
|
); |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=item tz |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
Supply a C<HASH> reference whose keys are I<known> iCal C<TZID> |
594
|
|
|
|
|
|
|
identifiers, and the values are L<DateTime::TimeZone> objects. By |
595
|
|
|
|
|
|
|
default, these values are gleaned from the supplied L<Data::ICal> |
596
|
|
|
|
|
|
|
objects themselves and I<will override> any supplied values. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
This parameter is I<optional>. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=cut |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
has tz => ( |
603
|
|
|
|
|
|
|
is => 'ro', |
604
|
|
|
|
|
|
|
isa => sub { die |
605
|
|
|
|
|
|
|
'tz must be a HASH of DateTime::TimeZone objects' |
606
|
|
|
|
|
|
|
unless _is_really($_[0], 'HASH') |
607
|
|
|
|
|
|
|
and values %{$_[0]} == grep { |
608
|
|
|
|
|
|
|
_is_really($_, 'DateTime::TimeZone') } values %{$_[0]} }, |
609
|
|
|
|
|
|
|
default => sub { { } }, |
610
|
|
|
|
|
|
|
); |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=item no_uuids |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
This is a flag to alter the short-circuiting behaviour of |
615
|
|
|
|
|
|
|
L</subject_for>. When set, it will I<not> attempt to return the result |
616
|
|
|
|
|
|
|
of L</uid_is_uuid> before running L</resolve_uid>. |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=back |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=cut |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
has no_uuids => ( |
623
|
|
|
|
|
|
|
is => 'rw', |
624
|
|
|
|
|
|
|
default => sub { 0 }, |
625
|
|
|
|
|
|
|
); |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
has _subjects => ( |
628
|
|
|
|
|
|
|
is => 'ro', |
629
|
|
|
|
|
|
|
default => sub { { } }, |
630
|
|
|
|
|
|
|
); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=head2 process $ICAL |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
Process a L<Data::ICal> object and put it into the object's internal |
635
|
|
|
|
|
|
|
model. Note that any C<VTIMEZONE> objects found will I<not> be |
636
|
|
|
|
|
|
|
inserted into the model, but rather integrated into the appropriate |
637
|
|
|
|
|
|
|
date/time-like property values. |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
Note as well that I<all> non-standard properties are I<ignored>, as |
640
|
|
|
|
|
|
|
well as all non-standard property I<parameters> with the exception of |
641
|
|
|
|
|
|
|
C<X-FILENAME> and C<X-APPLE-FILENAME> since there is no standard way |
642
|
|
|
|
|
|
|
to suggest a file name for attachments. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
This method calls L</subject_for> and therefore may croak if the |
645
|
|
|
|
|
|
|
L</resolve_uid> callback fails for any reason. |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=cut |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub process { |
650
|
|
|
|
|
|
|
my ($self, $ical) = @_; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my @events; |
653
|
|
|
|
|
|
|
for my $entry (@{$ical->entries}) { |
654
|
|
|
|
|
|
|
my $t = $entry->ical_entry_type; |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
# snag all the time zones |
657
|
|
|
|
|
|
|
if ($t eq 'VTIMEZONE') { |
658
|
|
|
|
|
|
|
my $dtz = DateTime::TimeZone::ICal->from_ical_entry($entry); |
659
|
|
|
|
|
|
|
# woops, looks like DateTime::TimeZone aliasing messes |
660
|
|
|
|
|
|
|
# with the name and causes time zones to be unfindable |
661
|
|
|
|
|
|
|
my $id = $entry->property('TZID')->[0]->value; |
662
|
|
|
|
|
|
|
$self->tz->{$id} = $dtz; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
# XXX should we create a timezone object in rdf? |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
elsif ($t eq 'VEVENT') { |
667
|
|
|
|
|
|
|
push @events, $entry; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
else { |
670
|
|
|
|
|
|
|
# noop |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
$self->process_events(@events); |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head2 process_events @EVENTS |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Process a list of L<Data::ICal::Entry::Event> objects. This is called |
680
|
|
|
|
|
|
|
by L</process> and therefore also may croak. |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=cut |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# take the events and put them in the temporary store |
685
|
|
|
|
|
|
|
sub process_events { |
686
|
|
|
|
|
|
|
my ($self, @events) = @_; |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
for my $event (@events) { |
689
|
|
|
|
|
|
|
# skip unless this is correct |
690
|
|
|
|
|
|
|
next unless _is_really($event, 'Data::ICal::Entry'); |
691
|
|
|
|
|
|
|
next unless $event->ical_entry_type eq 'VEVENT'; |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
# get the uid separately and skip if it doesn't exist |
694
|
|
|
|
|
|
|
my ($uid) = @{$event->property('uid')} or next; |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
# fetch the appropriate subject UUID for the ical uid |
697
|
|
|
|
|
|
|
my $s = eval { $self->subject_for($uid->value) }; |
698
|
|
|
|
|
|
|
$self->throw($@) if $@; |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# don't forget to add the uid |
701
|
|
|
|
|
|
|
$self->model->add_statement(statement( |
702
|
|
|
|
|
|
|
$s, $NS->ical->uid, literal($uid->value, undef, $NS->xsd->string))); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# don't forget to add the type |
705
|
|
|
|
|
|
|
$self->model->add_statement |
706
|
|
|
|
|
|
|
(statement($s, $NS->rdf->type, $NS->ical->Vevent)); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# generate a map of all valid properties and whether or not |
709
|
|
|
|
|
|
|
# they are permitted multiple values |
710
|
|
|
|
|
|
|
my %pmap = ((map { $_ => 0 } |
711
|
|
|
|
|
|
|
($event->mandatory_unique_properties, |
712
|
|
|
|
|
|
|
$event->optional_unique_properties)), |
713
|
|
|
|
|
|
|
(map { $_ => 1 } |
714
|
|
|
|
|
|
|
($event->mandatory_repeatable_properties, |
715
|
|
|
|
|
|
|
$event->optional_repeatable_properties))); |
716
|
|
|
|
|
|
|
# we have already processed uid so let's get rid of it |
717
|
|
|
|
|
|
|
delete $pmap{uid}; |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
while (my ($name, $multi) = each %pmap) { |
720
|
|
|
|
|
|
|
# it's definitely easier to be indiscriminate about the |
721
|
|
|
|
|
|
|
# properties than to try to cherry-pick |
722
|
|
|
|
|
|
|
my @props = @{$event->property($name) || []} or next; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
# truncate if this is a single-valued property |
725
|
|
|
|
|
|
|
@props = ($props[0]) unless $multi; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# interpret the property contents and put the resulting |
728
|
|
|
|
|
|
|
# RDF statements in the temporary model |
729
|
|
|
|
|
|
|
for my $val (@props) { |
730
|
|
|
|
|
|
|
$self->_process_property($val, $s); |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# return *something*, right? |
736
|
|
|
|
|
|
|
return scalar @events; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=head2 subject_for $UID |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Take an iCal C<UID> property and return a suitable RDF node which can |
742
|
|
|
|
|
|
|
be used as a subject. This may call the L</resolve_uid> callback and |
743
|
|
|
|
|
|
|
therefore may croak if it receives a bad value. |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=cut |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
sub subject_for { |
748
|
|
|
|
|
|
|
my ($self, $uid) = @_; |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
if (!$self->no_uuids and my $s = $self->uid_is_uuid($uid)) { |
751
|
|
|
|
|
|
|
return $s; |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
# now we check the cache |
755
|
|
|
|
|
|
|
if (my $s = $self->_subjects->{$uid}) { |
756
|
|
|
|
|
|
|
#warn "Found $s for $uid in cache"; |
757
|
|
|
|
|
|
|
return $s; |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# call out to the callback |
761
|
|
|
|
|
|
|
if (my $s = eval { $self->resolve_uid->($self, $uid) }) { |
762
|
|
|
|
|
|
|
$self->throw('resolve_uid callback returned an invalid value') |
763
|
|
|
|
|
|
|
unless _is_really($s, 'RDF::Trine::Node'); |
764
|
|
|
|
|
|
|
$self->throw("Node $s returned from resolve_uid callback" . |
765
|
|
|
|
|
|
|
' is not suitable as a subject') |
766
|
|
|
|
|
|
|
unless ($s->is_resource or $s->is_blank); |
767
|
|
|
|
|
|
|
return $self->_subjects->{$uid} = $s; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
# explode if the eval failed |
770
|
|
|
|
|
|
|
$self->throw("resolve_uid callback failed: $@") if $@; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# if we can't find a cached entry or a mapping in the database, |
774
|
|
|
|
|
|
|
# then we create one from scratch (and cache it). |
775
|
|
|
|
|
|
|
my $s = iri(_uuid_urn); |
776
|
|
|
|
|
|
|
#warn "Generated $s for $uid"; |
777
|
|
|
|
|
|
|
return $self->_subjects->{$uid} = $s; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 uuid_is_uid $UID |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Returns a suitable C<urn:uuid:> node if the iCal UID is also a valid |
783
|
|
|
|
|
|
|
(version 4) UUID. Used by L</subject_for> and available in the |
784
|
|
|
|
|
|
|
L<resolve_uid> and L<resolve_binary> functions. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=cut |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
sub uid_is_uuid { |
789
|
|
|
|
|
|
|
my ($self, $uid) = @_; |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# check to see if this is a V4 UUID |
792
|
|
|
|
|
|
|
if (my @parts = ($uid =~ $UUID4)) { |
793
|
|
|
|
|
|
|
# if it is, convert it into a resource node and return it |
794
|
|
|
|
|
|
|
my $s = iri('urn:uuid:' . lc join '-', @parts); |
795
|
|
|
|
|
|
|
#warn "$s is already a V4 UUID"; |
796
|
|
|
|
|
|
|
return $s; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=head2 model |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
Retrieve the L<RDF::Trine::Model> object embedded in the processor. |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=head1 CAVEATS |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
This module is I<prototype-grade>, and may give you unexpected |
807
|
|
|
|
|
|
|
results. It does not have a test suite to speak of, at least not until |
808
|
|
|
|
|
|
|
I can come up with an adequate one. An exhaustive test suite to handle |
809
|
|
|
|
|
|
|
the vagaries of the iCal format would likely take an order of |
810
|
|
|
|
|
|
|
magnitude more effort than the module code itself. Nevertheless, I |
811
|
|
|
|
|
|
|
know it works because I'm using it, so my "test suite" is production. |
812
|
|
|
|
|
|
|
I repeat, this is I<not> mature software. Patches welcome. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Furthermore, a number of iCal datatype handlers are not implemented in |
815
|
|
|
|
|
|
|
this early version. These are: |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=over 4 |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=item |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
C<CAL-ADDRESS> |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=item |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
C<DURATION> |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
C<PERIOD> |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
C<RECUR> |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
C<TIME> |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=item |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
C<UTC-OFFSET> |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=back |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
In particular, a lack of a handler for the C<DURATION> type means |
846
|
|
|
|
|
|
|
events that follow the C<DTSTART>/C<DURATION> form will be incomplete. |
847
|
|
|
|
|
|
|
In practice this should not be a problem, as iCal, Outlook, etc. use |
848
|
|
|
|
|
|
|
C<DTEND>. This is also in part a design issue, as to whether the |
849
|
|
|
|
|
|
|
C<DURATION> I<property> should be normalized to C<DTEND>. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
As well, the C<GEO>, C<RESOURCES>, and C<CLASS> properties are yet to |
852
|
|
|
|
|
|
|
be implemented. Patches are welcome, as are work orders. |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=head1 AUTHOR |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
Dorian Taylor, C<< <dorian at cpan.org> >> |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head1 BUGS |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-data-ical-rdf at |
861
|
|
|
|
|
|
|
rt.cpan.org>, or through the web interface at |
862
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data-ICal-RDF>. I |
863
|
|
|
|
|
|
|
will be notified, and then you'll automatically be notified of |
864
|
|
|
|
|
|
|
progress on your bug as I make changes. |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=head1 SUPPORT |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
perldoc Data::ICal::RDF |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
You can also look for information at: |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
=over 4 |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-ICal-RDF> |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Data-ICal-RDF> |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=item * CPAN Ratings |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Data-ICal-RDF> |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=item * Search CPAN |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Data-ICal-RDF/> |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=back |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=head1 SEE ALSO |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=over 4 |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
L<Data::ICal> |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=item |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
L<RDF::Trine> |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
L<DateTime::TimeZone::ICal> |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=item |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
L<RFC 5545|http://tools.ietf.org/html/rfc5545> |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=back |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
Copyright 2015 Dorian Taylor. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you |
921
|
|
|
|
|
|
|
may not use this file except in compliance with the License. You may |
922
|
|
|
|
|
|
|
obtain a copy of the License at |
923
|
|
|
|
|
|
|
L<http://www.apache.org/licenses/LICENSE-2.0>. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software |
926
|
|
|
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, |
927
|
|
|
|
|
|
|
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or |
928
|
|
|
|
|
|
|
implied. See the License for the specific language governing |
929
|
|
|
|
|
|
|
permissions and limitations under the License. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=cut |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
1; # End of Data::ICal::RDF |