line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package RDF::iCalendar::Exporter; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
20896
|
use 5.008; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
76
|
|
4
|
2
|
|
|
2
|
|
10
|
use base qw[RDF::vCard::Exporter]; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
4422
|
|
5
|
|
|
|
|
|
|
use strict; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use DateTime; |
8
|
|
|
|
|
|
|
use MIME::Base64 qw[]; |
9
|
|
|
|
|
|
|
use RDF::iCalendar::Entity; |
10
|
|
|
|
|
|
|
use RDF::iCalendar::Line; |
11
|
|
|
|
|
|
|
use RDF::TrineX::Functions |
12
|
|
|
|
|
|
|
-shortcuts, |
13
|
|
|
|
|
|
|
statement => { -as => 'rdf_statement' }, |
14
|
|
|
|
|
|
|
iri => { -as => 'rdf_resource' }; |
15
|
|
|
|
|
|
|
use Scalar::Util qw[blessed]; |
16
|
|
|
|
|
|
|
use URI; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
require RDF::vCard; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# kinda constants |
21
|
|
|
|
|
|
|
sub I { return 'http://www.w3.org/2002/12/cal/icaltzd#' . shift; } |
22
|
|
|
|
|
|
|
sub IX { return 'http://buzzword.org.uk/rdf/icaltzdx#' . shift; } |
23
|
|
|
|
|
|
|
sub RDF { return 'http://www.w3.org/1999/02/22-rdf-syntax-ns#' . shift; } |
24
|
|
|
|
|
|
|
sub V { return 'http://www.w3.org/2006/vcard/ns#' . shift; } |
25
|
|
|
|
|
|
|
sub VX { return 'http://buzzword.org.uk/rdf/vcardx#' . shift; } |
26
|
|
|
|
|
|
|
sub XSD { return 'http://www.w3.org/2001/XMLSchema#' . shift; } |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub flatten_node |
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
my $node = shift; |
31
|
|
|
|
|
|
|
return $node->value if $node->is_resource || $node->is_literal; |
32
|
|
|
|
|
|
|
return $node->as_ntriples; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use namespace::clean; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our $VERSION = '0.004'; |
38
|
|
|
|
|
|
|
our $PRODID = sprintf("+//IDN cpan.org//NONSGML %s v %s//EN", __PACKAGE__, $VERSION); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
our %cal_dispatch = ( |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our %dispatch = ( |
44
|
|
|
|
|
|
|
IX('contact') => \&_prop_export_contact, |
45
|
|
|
|
|
|
|
I('contact') => \&_prop_export_contact, |
46
|
|
|
|
|
|
|
I('geo') => \&_prop_export_geo, |
47
|
|
|
|
|
|
|
IX('organizer') => \&_prop_export_Person, |
48
|
|
|
|
|
|
|
I('organizer') => \&_prop_export_Person, |
49
|
|
|
|
|
|
|
IX('attendee') => \&_prop_export_Person, |
50
|
|
|
|
|
|
|
I('attendee') => \&_prop_export_Person, |
51
|
|
|
|
|
|
|
I('attach') => \&RDF::vCard::Exporter::_prop_export_binary, |
52
|
|
|
|
|
|
|
I('dtstart') => \&_prop_export_DateTime, |
53
|
|
|
|
|
|
|
I('dtend') => \&_prop_export_DateTime, |
54
|
|
|
|
|
|
|
I('due') => \&_prop_export_DateTime, |
55
|
|
|
|
|
|
|
I('completed') => \&_prop_export_DateTime, |
56
|
|
|
|
|
|
|
I('created') => \&_prop_export_DateTime, |
57
|
|
|
|
|
|
|
I('dtstamp') => \&_prop_export_DateTime, |
58
|
|
|
|
|
|
|
I('last-modified') => \&_prop_export_DateTime, |
59
|
|
|
|
|
|
|
IX('location') => \&_prop_export_location, |
60
|
|
|
|
|
|
|
I('location') => \&_prop_export_location, |
61
|
|
|
|
|
|
|
I('rrule') => \&_prop_export_Recur, |
62
|
|
|
|
|
|
|
I('exrule') => \&_prop_export_Recur, |
63
|
|
|
|
|
|
|
I('valarm') => \&_prop_export_valarm, |
64
|
|
|
|
|
|
|
I('freebusy') => \&_prop_export_freebusy, |
65
|
|
|
|
|
|
|
# RELATED-TO |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
our %list_dispatch = ( |
69
|
|
|
|
|
|
|
I('exdate') => ['exdate', \&_value_export_DateTime], |
70
|
|
|
|
|
|
|
I('rdate') => ['rdate', \&_value_export_DateTime], |
71
|
|
|
|
|
|
|
I('resources') => ['resources', \&_value_export_category], |
72
|
|
|
|
|
|
|
I('categories') => ['categories', \&_value_export_category], |
73
|
|
|
|
|
|
|
I('category') => ['categories', \&_value_export_category], |
74
|
|
|
|
|
|
|
IX('category') => ['categories', \&_value_export_category], |
75
|
|
|
|
|
|
|
); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub _rebless |
78
|
|
|
|
|
|
|
{ |
79
|
|
|
|
|
|
|
my ($self, $thing) = @_; |
80
|
|
|
|
|
|
|
if ($thing->isa('RDF::vCard::Line')) |
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
return bless $thing, 'RDF::iCalendar::Line'; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
if ($thing->isa('RDF::vCard::Entity')) |
85
|
|
|
|
|
|
|
{ |
86
|
|
|
|
|
|
|
return bless $thing, 'RDF::iCalendar::Entity'; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub _debug |
91
|
|
|
|
|
|
|
{ |
92
|
|
|
|
|
|
|
# my ($self, @debug) = @_; |
93
|
|
|
|
|
|
|
# printf(@debug); |
94
|
|
|
|
|
|
|
# print "\n"; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub export_cards # need to really use superclass for these |
98
|
|
|
|
|
|
|
{ |
99
|
|
|
|
|
|
|
my ($self, $model, %options) = @_; |
100
|
|
|
|
|
|
|
return RDF::vCard::Exporter->new->export_cards($model, %options); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub export_card # need to really use superclass for these |
104
|
|
|
|
|
|
|
{ |
105
|
|
|
|
|
|
|
my ($self, $model, $subject, %options) = @_; |
106
|
|
|
|
|
|
|
return RDF::vCard::Exporter->new->export_card($model, $subject, %options); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub export_calendars |
110
|
|
|
|
|
|
|
{ |
111
|
|
|
|
|
|
|
my ($self, $model, %options) = @_; |
112
|
|
|
|
|
|
|
$model = rdf_parse($model) |
113
|
|
|
|
|
|
|
unless blessed($model) && $model->isa('RDF::Trine::Model'); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
my @subjects = $model->subjects(rdf_resource(RDF('type')), rdf_resource(I('Vcalendar'))); |
116
|
|
|
|
|
|
|
push @subjects, $model->subjects(rdf_resource(I('component')), undef); |
117
|
|
|
|
|
|
|
my %subjects = map { flatten_node($_) => $_ } @subjects; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my @cals; |
120
|
|
|
|
|
|
|
foreach my $s (values %subjects) |
121
|
|
|
|
|
|
|
{ |
122
|
|
|
|
|
|
|
push @cals, $self->export_calendar($model, $s, %options); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
if ($options{sort}) |
126
|
|
|
|
|
|
|
{ |
127
|
|
|
|
|
|
|
return sort { $a->entity_order cmp $b->entity_order } @cals; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
return @cals; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub export_calendar |
134
|
|
|
|
|
|
|
{ |
135
|
|
|
|
|
|
|
my ($self, $model, $subject, %options) = @_; |
136
|
|
|
|
|
|
|
$model = RDF::TrineShortcuts::rdf_parse($model) |
137
|
|
|
|
|
|
|
unless blessed($model) && $model->isa('RDF::Trine::Model'); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
my $ical = RDF::iCalendar::Entity->new( profile=>'VCALENDAR' ); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my %categories; |
142
|
|
|
|
|
|
|
my $triples = $model->get_statements($subject, undef, undef); |
143
|
|
|
|
|
|
|
while (my $triple = $triples->next) |
144
|
|
|
|
|
|
|
{ |
145
|
|
|
|
|
|
|
# next |
146
|
|
|
|
|
|
|
# unless (substr($triple->predicate->uri, 0, length(&I)) eq &I or |
147
|
|
|
|
|
|
|
# substr($triple->predicate->uri, 0, length(&IX)) eq &IX); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
if ($triple->predicate->uri eq I('component')) |
150
|
|
|
|
|
|
|
{ |
151
|
|
|
|
|
|
|
$ical->add_component($self->export_component($model, $triple->object)); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
elsif (defined $cal_dispatch{$triple->predicate->uri} |
154
|
|
|
|
|
|
|
and ref($cal_dispatch{$triple->predicate->uri}) eq 'CODE') |
155
|
|
|
|
|
|
|
{ |
156
|
|
|
|
|
|
|
my $code = $cal_dispatch{$triple->predicate->uri}; |
157
|
|
|
|
|
|
|
my $r = $code->($self, $model, $triple); |
158
|
|
|
|
|
|
|
if (blessed($r) and $r->isa('RDF::iCalendar::Line')) |
159
|
|
|
|
|
|
|
{ $ical->add($r); } |
160
|
|
|
|
|
|
|
elsif (blessed($r) and $r->isa('RDF::iCalendar::Entity')) |
161
|
|
|
|
|
|
|
{ $ical->add_component($r); } |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
elsif ((substr($triple->predicate->uri, 0, length(&I)) eq &I |
164
|
|
|
|
|
|
|
or substr($triple->predicate->uri, 0, length(&IX)) eq &IX)) |
165
|
|
|
|
|
|
|
{ |
166
|
|
|
|
|
|
|
$ical->add($self->_prop_export_simple($model, $triple)) |
167
|
|
|
|
|
|
|
unless $triple->object->is_blank; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
$ical->add( |
172
|
|
|
|
|
|
|
RDF::iCalendar::Line->new( |
173
|
|
|
|
|
|
|
property => 'version', |
174
|
|
|
|
|
|
|
value => '2.0', |
175
|
|
|
|
|
|
|
) |
176
|
|
|
|
|
|
|
); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$ical->add( |
179
|
|
|
|
|
|
|
RDF::iCalendar::Line->new( |
180
|
|
|
|
|
|
|
property => 'prodid', |
181
|
|
|
|
|
|
|
value => (defined $options{prodid} ? $options{prodid} : $PRODID), |
182
|
|
|
|
|
|
|
) |
183
|
|
|
|
|
|
|
) unless exists $options{prodid} && !defined $options{prodid}; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
$ical->add( |
186
|
|
|
|
|
|
|
RDF::iCalendar::Line->new( |
187
|
|
|
|
|
|
|
property => 'source', |
188
|
|
|
|
|
|
|
value => $options{source}, |
189
|
|
|
|
|
|
|
type_parameters => {value=>'URI'}, |
190
|
|
|
|
|
|
|
) |
191
|
|
|
|
|
|
|
) if defined $options{source}; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
return $ical; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub export_component |
197
|
|
|
|
|
|
|
{ |
198
|
|
|
|
|
|
|
my ($self, $model, $subject, %options) = @_; |
199
|
|
|
|
|
|
|
$model = RDF::TrineShortcuts::rdf_parse($model) |
200
|
|
|
|
|
|
|
unless blessed($model) && $model->isa('RDF::Trine::Model'); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $profile = 'VEVENT'; |
203
|
|
|
|
|
|
|
$profile = 'VTIMEZONE' |
204
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Vtimezone'))); |
205
|
|
|
|
|
|
|
$profile = 'VFREEBUSY' |
206
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Vfreebusy'))); |
207
|
|
|
|
|
|
|
$profile = 'VALARM' |
208
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Valarm'))); |
209
|
|
|
|
|
|
|
$profile = 'VJOURNAL' |
210
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Vjournal'))); |
211
|
|
|
|
|
|
|
$profile = 'VTODO' |
212
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Vtodo'))); |
213
|
|
|
|
|
|
|
$profile = 'VEVENT' |
214
|
|
|
|
|
|
|
if $model->count_statements($subject, rdf_resource(RDF('type')), rdf_resource(I('Vevent'))); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
my $c = RDF::iCalendar::Entity->new( profile=>$profile ); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$self->_debug("COMPONENT: %s", flatten_node($subject)); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my $lists = {}; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my $triples = $model->get_statements($subject, undef, undef); |
223
|
|
|
|
|
|
|
while (my $triple = $triples->next) |
224
|
|
|
|
|
|
|
{ |
225
|
|
|
|
|
|
|
$self->_debug(" %s %s", $triple->predicate->sse, $triple->object->sse); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
if (defined $dispatch{$triple->predicate->uri} |
228
|
|
|
|
|
|
|
and ref($dispatch{$triple->predicate->uri}) eq 'CODE') |
229
|
|
|
|
|
|
|
{ |
230
|
|
|
|
|
|
|
$self->_debug(" -> dispatch"); |
231
|
|
|
|
|
|
|
my $code = $dispatch{$triple->predicate->uri}; |
232
|
|
|
|
|
|
|
my $r = $code->($self, $model, $triple); |
233
|
|
|
|
|
|
|
if (blessed($r) and $r->isa('RDF::iCalendar::Line')) |
234
|
|
|
|
|
|
|
{ $c->add($r); } |
235
|
|
|
|
|
|
|
elsif (blessed($r) and $r->isa('RDF::iCalendar::Entity')) |
236
|
|
|
|
|
|
|
{ $c->add_component($r); } |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
elsif (defined $list_dispatch{$triple->predicate->uri} |
239
|
|
|
|
|
|
|
and ref($list_dispatch{$triple->predicate->uri}) eq 'ARRAY') |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
$self->_debug(" -> list_dispatch"); |
242
|
|
|
|
|
|
|
my ($listname, $code) = @{ $list_dispatch{$triple->predicate->uri} }; |
243
|
|
|
|
|
|
|
push @{ $lists->{$listname} }, $code->($self, $model, $triple); |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
elsif ((substr($triple->predicate->uri, 0, length(&I)) eq &I |
246
|
|
|
|
|
|
|
or substr($triple->predicate->uri, 0, length(&IX)) eq &IX)) |
247
|
|
|
|
|
|
|
{ |
248
|
|
|
|
|
|
|
$self->_debug(" -> default"); |
249
|
|
|
|
|
|
|
$c->add($self->_prop_export_simple($model, $triple)) |
250
|
|
|
|
|
|
|
unless $triple->object->is_blank; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
else |
253
|
|
|
|
|
|
|
{ |
254
|
|
|
|
|
|
|
$self->_debug(" -> NO ACTION"); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
foreach my $listname (keys %$lists) |
259
|
|
|
|
|
|
|
{ |
260
|
|
|
|
|
|
|
$c->add(RDF::iCalendar::Line->new( |
261
|
|
|
|
|
|
|
property => $listname, |
262
|
|
|
|
|
|
|
value => [[ sort keys %{{ map { $_ => 1 } @{$lists->{$listname}} }} ]], |
263
|
|
|
|
|
|
|
)); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
return $c; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub _prop_export_valarm |
270
|
|
|
|
|
|
|
{ |
271
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
unless ($triple->object->is_literal) |
274
|
|
|
|
|
|
|
{ |
275
|
|
|
|
|
|
|
return $self->export_component($model, $triple->object); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub _prop_export_simple |
280
|
|
|
|
|
|
|
{ |
281
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
282
|
|
|
|
|
|
|
my $rv = $self->SUPER::_prop_export_simple($model, $triple); |
283
|
|
|
|
|
|
|
return $self->_rebless($rv); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# iCalendar forces different datetime/date formats than |
287
|
|
|
|
|
|
|
# the generalised text/directory ones used by vCard... |
288
|
|
|
|
|
|
|
sub _prop_export_DateTime |
289
|
|
|
|
|
|
|
{ |
290
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
my $prop = 'x-data'; |
293
|
|
|
|
|
|
|
if ($triple->predicate->uri =~ m/([^\#\/]+)$/) |
294
|
|
|
|
|
|
|
{ |
295
|
|
|
|
|
|
|
$prop = $1; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
my $val = undef; |
299
|
|
|
|
|
|
|
my $params = undef; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my ($dt, $has_time) = $self->_node2dt($triple->object, $model); |
302
|
|
|
|
|
|
|
my $tz = $dt->time_zone; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
if ($dt and $has_time) |
305
|
|
|
|
|
|
|
{ |
306
|
|
|
|
|
|
|
$params = { value=>'DATE-TIME' }; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
unless ($tz->is_floating || |
309
|
|
|
|
|
|
|
$tz->is_utc || |
310
|
|
|
|
|
|
|
$tz->is_olson ) |
311
|
|
|
|
|
|
|
{ |
312
|
|
|
|
|
|
|
$dt = $dt->clone->set_time_zone('UTC'); |
313
|
|
|
|
|
|
|
$tz = $dt->time_zone; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$val = sprintf('%04d%02d%02dT%02d%02d%02d', |
317
|
|
|
|
|
|
|
$dt->year, $dt->month, $dt->day, $dt->hour, $dt->minute, $dt->second); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
if ($tz->is_utc) |
320
|
|
|
|
|
|
|
{ |
321
|
|
|
|
|
|
|
$val .= "Z"; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
elsif (!$tz->is_floating) |
324
|
|
|
|
|
|
|
{ |
325
|
|
|
|
|
|
|
$params->{tzid} = $tz->name; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
elsif ($dt) |
329
|
|
|
|
|
|
|
{ |
330
|
|
|
|
|
|
|
$params = { value=>'DATE' }; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
unless ($tz->is_floating || |
333
|
|
|
|
|
|
|
$tz->is_utc || |
334
|
|
|
|
|
|
|
$tz->is_olson ) |
335
|
|
|
|
|
|
|
{ |
336
|
|
|
|
|
|
|
$dt = $dt->clone->set_time_zone('UTC'); |
337
|
|
|
|
|
|
|
$tz = $dt->time_zone; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
$val = sprintf('%04d%02d%02d', |
341
|
|
|
|
|
|
|
$dt->year, $dt->month, $dt->day); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
345
|
|
|
|
|
|
|
property => $prop, |
346
|
|
|
|
|
|
|
value => $val, |
347
|
|
|
|
|
|
|
type_parameters => $params, |
348
|
|
|
|
|
|
|
); |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub _node2dt |
352
|
|
|
|
|
|
|
{ |
353
|
|
|
|
|
|
|
my ($self, $node, $model) = @_; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Shouldn't happen! |
356
|
|
|
|
|
|
|
return DateTime->now unless $node->is_literal; |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
my ($date, $time) = split /T/i, $node->literal_value; |
359
|
|
|
|
|
|
|
my $has_time = (defined $time and length $time); |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
my $dt; |
362
|
|
|
|
|
|
|
if ($date =~ m'^([0-9]{4})\-?([0-9]{2})\-?([0-9]{2})$') |
363
|
|
|
|
|
|
|
{ |
364
|
|
|
|
|
|
|
$dt = DateTime->new(year => $1, month => $2, day => $3); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
elsif ($date =~ m'^([0-9]{1,4})\-([0-9]{1,2})\-([0-9]{1,2})$') |
367
|
|
|
|
|
|
|
{ |
368
|
|
|
|
|
|
|
$dt = DateTime->new(year => $1, month => $2, day => $3); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
else |
371
|
|
|
|
|
|
|
{ |
372
|
|
|
|
|
|
|
$dt = DateTime->now; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
my $zone; |
376
|
|
|
|
|
|
|
if ($time =~ /^(.+)(Z|[\+\-]00\:?00])$/i) |
377
|
|
|
|
|
|
|
{ |
378
|
|
|
|
|
|
|
$time = $1; |
379
|
|
|
|
|
|
|
$zone = DateTime::TimeZone->new(name => 'UTC'); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
elsif ($time =~ /^(.+)([\+\-][0-9][0-9]\:?[0-9][0-9])$/i) |
382
|
|
|
|
|
|
|
{ |
383
|
|
|
|
|
|
|
$time = $1; |
384
|
|
|
|
|
|
|
$zone = DateTime::TimeZone->new(name => $2); |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
elsif ($node->has_datatype |
387
|
|
|
|
|
|
|
and $node->literal_datatype =~ m'^http://www\.w3\.org/2002/12/cal/tzd/(.+)#tz$') |
388
|
|
|
|
|
|
|
{ |
389
|
|
|
|
|
|
|
$zone = DateTime::TimeZone->new(name => $1); |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
elsif ($node->has_datatype |
392
|
|
|
|
|
|
|
and $node->literal_datatype !~ m'^http://www\.w3\.org/2001/XMLSchema#' |
393
|
|
|
|
|
|
|
and defined $model) |
394
|
|
|
|
|
|
|
{ |
395
|
|
|
|
|
|
|
# Some funny datatype; let's try our best! |
396
|
|
|
|
|
|
|
my @locations = grep |
397
|
|
|
|
|
|
|
{ $_->is_literal } |
398
|
|
|
|
|
|
|
$model->objects( |
399
|
|
|
|
|
|
|
rdf_resource($node->literal_datatype), |
400
|
|
|
|
|
|
|
rdf_resource('http://www.w3.org/2002/12/cal/prod/Ximian_NON_de8f2a9bed573980#location'), |
401
|
|
|
|
|
|
|
rdf_resource(RDF('value')), |
402
|
|
|
|
|
|
|
rdf_resource(RDFS('label')), |
403
|
|
|
|
|
|
|
); |
404
|
|
|
|
|
|
|
$zone = DateTime::TimeZone->new(name => $locations[0]->literal_value) |
405
|
|
|
|
|
|
|
if @locations; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
$dt->set_time_zone($zone) if $zone; |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
if ($time =~ m'^([0-2][0-9])\:?([0-5][0-9])\:?([0-6][0-9](\.[0-9]*)?)?$') |
411
|
|
|
|
|
|
|
{ |
412
|
|
|
|
|
|
|
$dt->set_hour($1)->set_minute($2); |
413
|
|
|
|
|
|
|
$dt->set_second($3) if defined $3; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
elsif ($time =~ m'^([0-2]?[0-9])\:([0-5]?[0-9])\:([0-6]?[0-9](\.[0-9]*)?)$') |
416
|
|
|
|
|
|
|
{ |
417
|
|
|
|
|
|
|
$dt->set_hour($1)->set_minute($2)->set_second($3); |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
elsif ($time =~ m'^([0-2]?[0-9])\:([0-5]?[0-9])\:?$') |
420
|
|
|
|
|
|
|
{ |
421
|
|
|
|
|
|
|
$dt->set_hour($1)->set_minute($2); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
return ($dt, $has_time); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub _prop_export_contact |
428
|
|
|
|
|
|
|
{ |
429
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
432
|
|
|
|
|
|
|
{ |
433
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
my $card = $self->export_card($model, $triple->object); |
437
|
|
|
|
|
|
|
my $uri = URI->new('data:'); |
438
|
|
|
|
|
|
|
$uri->media_type('text/directory'); |
439
|
|
|
|
|
|
|
$uri->data("$card"); |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
my $label = ''; |
442
|
|
|
|
|
|
|
my ($fn) = $card->get('fn'); |
443
|
|
|
|
|
|
|
my ($email) = $card->get('email'); |
444
|
|
|
|
|
|
|
if ($fn and $email) |
445
|
|
|
|
|
|
|
{ |
446
|
|
|
|
|
|
|
$label = sprintf('%s <%s>', |
447
|
|
|
|
|
|
|
$fn->_unescape_value($fn->value_to_string), |
448
|
|
|
|
|
|
|
$email->_unescape_value($email->value_to_string), |
449
|
|
|
|
|
|
|
); |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
elsif ($fn) |
452
|
|
|
|
|
|
|
{ |
453
|
|
|
|
|
|
|
$label = $fn->_unescape_value($fn->value_to_string); |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
elsif ($email) |
456
|
|
|
|
|
|
|
{ |
457
|
|
|
|
|
|
|
$label = $email->_unescape_value($email->value_to_string); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
461
|
|
|
|
|
|
|
property => 'contact', |
462
|
|
|
|
|
|
|
value => $label, |
463
|
|
|
|
|
|
|
type_parameters => { |
464
|
|
|
|
|
|
|
altrep => "\"$uri\"", |
465
|
|
|
|
|
|
|
}, |
466
|
|
|
|
|
|
|
); |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub _prop_export_location |
470
|
|
|
|
|
|
|
{ |
471
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
$self->_debug(" Location: %s", flatten_node($triple->object)); |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
476
|
|
|
|
|
|
|
{ |
477
|
|
|
|
|
|
|
$self->_debug(" -> literal"); |
478
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
if ($model->count_statements( |
482
|
|
|
|
|
|
|
$triple->object, |
483
|
|
|
|
|
|
|
rdf_resource(RDF('type')), |
484
|
|
|
|
|
|
|
rdf_resource(V('VCard')), |
485
|
|
|
|
|
|
|
) |
486
|
|
|
|
|
|
|
or $model->count_statements( |
487
|
|
|
|
|
|
|
$triple->object, |
488
|
|
|
|
|
|
|
rdf_resource(V('fn')), |
489
|
|
|
|
|
|
|
undef, |
490
|
|
|
|
|
|
|
) |
491
|
|
|
|
|
|
|
) |
492
|
|
|
|
|
|
|
{ |
493
|
|
|
|
|
|
|
$self->_debug(" -> vcard"); |
494
|
|
|
|
|
|
|
my $card = $self->export_card($model, $triple->object); |
495
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
496
|
|
|
|
|
|
|
property => 'location', |
497
|
|
|
|
|
|
|
value => "$card", |
498
|
|
|
|
|
|
|
type_parameters => { |
499
|
|
|
|
|
|
|
value => "VCARD", |
500
|
|
|
|
|
|
|
}, |
501
|
|
|
|
|
|
|
); |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
elsif ($model->count_statements( |
505
|
|
|
|
|
|
|
$triple->object, |
506
|
|
|
|
|
|
|
rdf_resource(RDF('type')), |
507
|
|
|
|
|
|
|
rdf_resource(V('Address')), |
508
|
|
|
|
|
|
|
) |
509
|
|
|
|
|
|
|
or $model->count_statements( |
510
|
|
|
|
|
|
|
$triple->object, |
511
|
|
|
|
|
|
|
rdf_resource(V('locality')), |
512
|
|
|
|
|
|
|
undef, |
513
|
|
|
|
|
|
|
) |
514
|
|
|
|
|
|
|
or $model->count_statements( |
515
|
|
|
|
|
|
|
$triple->object, |
516
|
|
|
|
|
|
|
rdf_resource(V('street-address')), |
517
|
|
|
|
|
|
|
undef, |
518
|
|
|
|
|
|
|
) |
519
|
|
|
|
|
|
|
) |
520
|
|
|
|
|
|
|
{ |
521
|
|
|
|
|
|
|
$self->_debug(" -> adr"); |
522
|
|
|
|
|
|
|
my $line = $self->_rebless( $self->_prop_export_adr($model, $triple) ); |
523
|
|
|
|
|
|
|
$line->{property} = 'location'; |
524
|
|
|
|
|
|
|
return $line; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
elsif ($model->count_statements( |
528
|
|
|
|
|
|
|
$triple->object, |
529
|
|
|
|
|
|
|
rdf_resource(RDF('type')), |
530
|
|
|
|
|
|
|
rdf_resource(V('Location')), |
531
|
|
|
|
|
|
|
) |
532
|
|
|
|
|
|
|
or $model->count_statements( |
533
|
|
|
|
|
|
|
$triple->object, |
534
|
|
|
|
|
|
|
rdf_resource(V('latitude')), |
535
|
|
|
|
|
|
|
undef, |
536
|
|
|
|
|
|
|
) |
537
|
|
|
|
|
|
|
) |
538
|
|
|
|
|
|
|
{ |
539
|
|
|
|
|
|
|
$self->_debug(" -> geo"); |
540
|
|
|
|
|
|
|
my $line = $self->_rebless( $self->SUPER::_prop_export_geo($model, $triple) ); |
541
|
|
|
|
|
|
|
$line->{property} = 'location'; |
542
|
|
|
|
|
|
|
return $line; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub _prop_export_geo |
550
|
|
|
|
|
|
|
{ |
551
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
554
|
|
|
|
|
|
|
{ |
555
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
elsif ($triple->object->is_resource |
558
|
|
|
|
|
|
|
and $triple->object->uri =~ /^geo:(.+)$/i) |
559
|
|
|
|
|
|
|
{ |
560
|
|
|
|
|
|
|
my $g = $1; |
561
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
562
|
|
|
|
|
|
|
property => 'geo', |
563
|
|
|
|
|
|
|
value => [ split /[,;]/, $g, 2 ], |
564
|
|
|
|
|
|
|
); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
my ($lat, $lon); |
568
|
|
|
|
|
|
|
{ |
569
|
|
|
|
|
|
|
my @latitudes = grep |
570
|
|
|
|
|
|
|
{ $_->is_literal } |
571
|
|
|
|
|
|
|
$model->objects($triple->object, rdf_resource(RDF('first'))); |
572
|
|
|
|
|
|
|
$lat = $latitudes[0]->literal_value if @latitudes; |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
my @nodes = grep |
575
|
|
|
|
|
|
|
{ !$_->is_literal } |
576
|
|
|
|
|
|
|
$model->objects($triple->object, rdf_resource(RDF('next'))); |
577
|
|
|
|
|
|
|
if (@nodes) |
578
|
|
|
|
|
|
|
{ |
579
|
|
|
|
|
|
|
my @longitudes = grep |
580
|
|
|
|
|
|
|
{ $_->is_literal } |
581
|
|
|
|
|
|
|
$model->objects($nodes[0], rdf_resource(RDF('first'))); |
582
|
|
|
|
|
|
|
$lon = $longitudes[0]->literal_value if @longitudes; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
587
|
|
|
|
|
|
|
property => 'geo', |
588
|
|
|
|
|
|
|
value => [$lat||0, $lon||0], |
589
|
|
|
|
|
|
|
); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub _prop_export_Person |
593
|
|
|
|
|
|
|
{ |
594
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
597
|
|
|
|
|
|
|
{ |
598
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
my $property = { |
602
|
|
|
|
|
|
|
I('organizer') => 'organizer', |
603
|
|
|
|
|
|
|
IX('organizer') => 'organizer', |
604
|
|
|
|
|
|
|
I('attendee') => 'attendee', |
605
|
|
|
|
|
|
|
IX('attendee') => 'attendee', |
606
|
|
|
|
|
|
|
}->{ $triple->predicate->uri }; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
my ($name, $email, $role, $partstat, $rsvp, $cutype, %thing_values); |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
my %thing_meta = ( |
611
|
|
|
|
|
|
|
'sent-by' => [map {rdf_resource($_)} IX('sentBy'), I('sent-by')], |
612
|
|
|
|
|
|
|
'delegated-to' => [map {rdf_resource($_)} IX('delegatedTo'), I('delegated-to')], |
613
|
|
|
|
|
|
|
'delegated-from' => [map {rdf_resource($_)} IX('delegatedFrom'), I('delegated-from')], |
614
|
|
|
|
|
|
|
); |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
if ($triple->object->is_resource |
617
|
|
|
|
|
|
|
and $triple->object->uri =~ /^mailto:.+$/i) |
618
|
|
|
|
|
|
|
{ |
619
|
|
|
|
|
|
|
$email = $triple->object->uri; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
else |
622
|
|
|
|
|
|
|
{ |
623
|
|
|
|
|
|
|
($name) = grep |
624
|
|
|
|
|
|
|
{ $_->is_literal } |
625
|
|
|
|
|
|
|
$model->objects_for_predicate_list($triple->object, rdf_resource(IX('cn')), rdf_resource(V('fn'))); |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
($role) = grep |
628
|
|
|
|
|
|
|
{ $_->is_literal } |
629
|
|
|
|
|
|
|
$model->objects_for_predicate_list($triple->object, rdf_resource(V('role')), rdf_resource(I('role')), rdf_resource(IX('role'))); |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
($partstat) = grep |
632
|
|
|
|
|
|
|
{ $_->is_literal } |
633
|
|
|
|
|
|
|
$model->objects_for_predicate_list($triple->object, rdf_resource(I('partstat')), rdf_resource(IX('partstat'))); |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
($rsvp) = grep |
636
|
|
|
|
|
|
|
{ $_->is_literal } |
637
|
|
|
|
|
|
|
$model->objects_for_predicate_list($triple->object, rdf_resource(I('rsvp')), rdf_resource(IX('rsvp'))); |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
($cutype) = grep |
640
|
|
|
|
|
|
|
{ $_->is_literal } |
641
|
|
|
|
|
|
|
$model->objects_for_predicate_list($triple->object, rdf_resource(VX('kind')), rdf_resource(I('cutype')), rdf_resource(IX('cutype'))); |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
($email) = $model->objects($triple->object, rdf_resource(V('email'))); |
644
|
|
|
|
|
|
|
if ($email |
645
|
|
|
|
|
|
|
and ($email->is_blank or ($email->is_resource and $email->uri !~ /^mailto:/i))) |
646
|
|
|
|
|
|
|
{ |
647
|
|
|
|
|
|
|
($email) = grep |
648
|
|
|
|
|
|
|
{ !$_->is_blank } |
649
|
|
|
|
|
|
|
$model->objects($email, rdf_resource(RDF('value'))); |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# This bit doesn't just work for sent-by, but also delegated-from/delegated-to |
653
|
|
|
|
|
|
|
while (my ($P, $X) = each %thing_meta) |
654
|
|
|
|
|
|
|
{ |
655
|
|
|
|
|
|
|
my ($sentby) = $model->objects_for_predicate_list($triple->object, @$X); |
656
|
|
|
|
|
|
|
# if $sentby isn't an email address |
657
|
|
|
|
|
|
|
if (!defined $sentby) {} |
658
|
|
|
|
|
|
|
elsif ($sentby->is_blank or $sentby->is_resource && $sentby->uri !~ /^mailto:/i) |
659
|
|
|
|
|
|
|
{ |
660
|
|
|
|
|
|
|
# Maybe it's a vcard:Email resource; if so, then get the rdf:value. |
661
|
|
|
|
|
|
|
my ($value) = grep |
662
|
|
|
|
|
|
|
{ !$_->is_blank } |
663
|
|
|
|
|
|
|
$model->objects($triple->object, rdf_resource(RDF('value'))); |
664
|
|
|
|
|
|
|
if ($value) |
665
|
|
|
|
|
|
|
{ |
666
|
|
|
|
|
|
|
$sentby = $value; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
# If it's not then it might be a vcard:VCard... |
669
|
|
|
|
|
|
|
else |
670
|
|
|
|
|
|
|
{ |
671
|
|
|
|
|
|
|
my ($sb_email) = $model->objects($sentby, rdf_resource(V('email'))); |
672
|
|
|
|
|
|
|
if (!defined $sb_email) {} |
673
|
|
|
|
|
|
|
elsif ($sb_email->is_literal or $sb_email->is_resource && $sb_email->uri !~ /^mailto:/i) |
674
|
|
|
|
|
|
|
{ |
675
|
|
|
|
|
|
|
$sentby = $sb_email; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
else |
678
|
|
|
|
|
|
|
{ |
679
|
|
|
|
|
|
|
my ($value) = grep |
680
|
|
|
|
|
|
|
{ !$_->is_blank } |
681
|
|
|
|
|
|
|
$model->objects($sb_email, rdf_resource(RDF('value'))); |
682
|
|
|
|
|
|
|
if ($value) |
683
|
|
|
|
|
|
|
{ |
684
|
|
|
|
|
|
|
$sentby = $value; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
$thing_values{$P} = $sentby if $sentby; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
my %params = (); |
695
|
|
|
|
|
|
|
$params{'cn'} = flatten_node($name) |
696
|
|
|
|
|
|
|
if defined $name; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
foreach my $P (keys %thing_meta) |
699
|
|
|
|
|
|
|
{ |
700
|
|
|
|
|
|
|
$params{$P} = flatten_node($thing_values{$P}) |
701
|
|
|
|
|
|
|
if defined $thing_values{$P}; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
$params{'cutype'} = flatten_node($cutype) |
705
|
|
|
|
|
|
|
if (defined $cutype and $property eq 'attendee'); |
706
|
|
|
|
|
|
|
$params{'partstat'} = flatten_node($partstat) |
707
|
|
|
|
|
|
|
if (defined $partstat and $property eq 'attendee'); |
708
|
|
|
|
|
|
|
$params{'role'} = flatten_node($role) |
709
|
|
|
|
|
|
|
if (defined $role and $property eq 'attendee'); |
710
|
|
|
|
|
|
|
$params{'rsvp'} = flatten_node($rsvp) |
711
|
|
|
|
|
|
|
if (defined $rsvp and $property eq 'attendee'); |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
$params{'value'} = 'CAL-ADDRESS'; |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
if (!$email) |
716
|
|
|
|
|
|
|
{ |
717
|
|
|
|
|
|
|
$email = $name; |
718
|
|
|
|
|
|
|
$params{'value'} = 'TEXT'; |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
722
|
|
|
|
|
|
|
property => $property, |
723
|
|
|
|
|
|
|
value => flatten_node($email), |
724
|
|
|
|
|
|
|
type_parameters => \%params, |
725
|
|
|
|
|
|
|
); |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub _value_export_simple |
729
|
|
|
|
|
|
|
{ |
730
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
731
|
|
|
|
|
|
|
my $rv = $self->_prop_export_simple($model, $triple); |
732
|
|
|
|
|
|
|
return $rv->_unescape_value($rv->value_to_string); |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
sub _value_export_DateTime |
736
|
|
|
|
|
|
|
{ |
737
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
738
|
|
|
|
|
|
|
my $rv = $self->_prop_export_DateTime($model, $triple); |
739
|
|
|
|
|
|
|
return $rv->_unescape_value($rv->value_to_string); |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
sub _value_export_category |
743
|
|
|
|
|
|
|
{ |
744
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
747
|
|
|
|
|
|
|
{ |
748
|
|
|
|
|
|
|
return uc $triple->object->literal_value; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
my @labels = grep |
752
|
|
|
|
|
|
|
{ $_->is_literal } |
753
|
|
|
|
|
|
|
$model->objects_for_predicate_list( |
754
|
|
|
|
|
|
|
$triple->object, |
755
|
|
|
|
|
|
|
rdf_resource('http://www.w3.org/2004/02/skos/core#prefLabel'), |
756
|
|
|
|
|
|
|
rdf_resource('http://www.holygoat.co.uk/owl/redwood/0.1/tags/name'), |
757
|
|
|
|
|
|
|
rdf_resource('http://www.w3.org/2000/01/rdf-schema#label'), |
758
|
|
|
|
|
|
|
rdf_resource('http://www.w3.org/2004/02/skos/core#altLabel'), |
759
|
|
|
|
|
|
|
rdf_resource('http://www.w3.org/2004/02/skos/core#notation'), |
760
|
|
|
|
|
|
|
rdf_resource(RDF('value')), |
761
|
|
|
|
|
|
|
); |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
if (@labels) |
764
|
|
|
|
|
|
|
{ |
765
|
|
|
|
|
|
|
return uc $labels[0]->literal_value; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
elsif ($triple->object->is_resource) |
768
|
|
|
|
|
|
|
{ |
769
|
|
|
|
|
|
|
return $triple->object->uri; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
sub _prop_export_Recur |
774
|
|
|
|
|
|
|
{ |
775
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
my $prop = 'x-data'; |
778
|
|
|
|
|
|
|
if ($triple->predicate->uri =~ m/([^\#\/]+)$/) |
779
|
|
|
|
|
|
|
{ |
780
|
|
|
|
|
|
|
$prop = $1; |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
784
|
|
|
|
|
|
|
{ |
785
|
|
|
|
|
|
|
return $self->_prop_export_simple($model, $triple); |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
my (%bits, @bits); |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
my $iter = $model->get_statements($triple->object, undef, undef); |
791
|
|
|
|
|
|
|
while (my $st = $iter->next) |
792
|
|
|
|
|
|
|
{ |
793
|
|
|
|
|
|
|
if ($st->predicate->uri =~ m'^http://www\.w3\.org/2002/12/cal/icaltzd#(.+)$') |
794
|
|
|
|
|
|
|
{ |
795
|
|
|
|
|
|
|
my $p = uc $1; |
796
|
|
|
|
|
|
|
my $v = ($p eq 'UNITL') ? $self->_value_export_DateTime($model, $st) : flatten_node($st->object); |
797
|
|
|
|
|
|
|
push @{ $bits{$p} }, $v; |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
while (my ($k, $v) = each %bits) |
802
|
|
|
|
|
|
|
{ |
803
|
|
|
|
|
|
|
push @bits, sprintf('%s=%s', $k, join(',', @$v)); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
807
|
|
|
|
|
|
|
property => $prop, |
808
|
|
|
|
|
|
|
value => [ map { [ split /,/, $_ ] } @bits ], |
809
|
|
|
|
|
|
|
type_parameters => { value => 'RECUR' }, |
810
|
|
|
|
|
|
|
); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
sub _prop_export_freebusy |
814
|
|
|
|
|
|
|
{ |
815
|
|
|
|
|
|
|
my ($self, $model, $triple) = @_; |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
if ($triple->object->is_literal) |
818
|
|
|
|
|
|
|
{ |
819
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
820
|
|
|
|
|
|
|
property => 'freebusy', |
821
|
|
|
|
|
|
|
value => $triple->object->literal_value, |
822
|
|
|
|
|
|
|
type_parameters => { fbtype => 'BUSY' }, |
823
|
|
|
|
|
|
|
); |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
my @values = sort map |
827
|
|
|
|
|
|
|
{ $_->literal_value } |
828
|
|
|
|
|
|
|
grep |
829
|
|
|
|
|
|
|
{ $_->is_literal } |
830
|
|
|
|
|
|
|
$model->objects_for_predicate_list( |
831
|
|
|
|
|
|
|
$triple->object, |
832
|
|
|
|
|
|
|
rdf_resource(RDF('value')), |
833
|
|
|
|
|
|
|
); |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
my ($fbtype) = map |
836
|
|
|
|
|
|
|
{ uc $_->literal_value } |
837
|
|
|
|
|
|
|
grep |
838
|
|
|
|
|
|
|
{ $_->is_literal } |
839
|
|
|
|
|
|
|
$model->objects_for_predicate_list( |
840
|
|
|
|
|
|
|
$triple->object, |
841
|
|
|
|
|
|
|
rdf_resource(I('fbtype')), |
842
|
|
|
|
|
|
|
rdf_resource(IX('fbtype')), |
843
|
|
|
|
|
|
|
); |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
return RDF::iCalendar::Line->new( |
846
|
|
|
|
|
|
|
property => 'freebusy', |
847
|
|
|
|
|
|
|
value => [[ @values ]], |
848
|
|
|
|
|
|
|
type_parameters => { fbtype => $fbtype || 'BUSY' }, |
849
|
|
|
|
|
|
|
); |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
1; |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
__END__ |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head1 NAME |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
RDF::iCalendar::Exporter - export RDF data to iCalendar format |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head1 SYNOPSIS |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
use RDF::iCalendar; |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
my $input = "http://example.com/calendar-data.ics"; |
867
|
|
|
|
|
|
|
my $exporter = RDF::iCalendar::Exporter->new; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
print $_ foreach $exporter->export_calendars($input); |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head1 DESCRIPTION |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
This module reads RDF and writes iCalendar files. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
This is a subclass of RDF::vCard::Exporter, so it can also export vCards. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=head2 Constructor |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=over |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item * C<< new(%options) >> |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
Returns a new RDF::iCalendar::Exporter object. |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
There are no valid options at the moment - the hash is reserved |
886
|
|
|
|
|
|
|
for future use. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=back |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=head2 Methods |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=over |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=item * C<< export_calendars($input, %options) >> |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
Returns a list of iCalendars found in the input, in no particular order. |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
The input may be a URI, file name, L<RDF::Trine::Model> or anything else |
899
|
|
|
|
|
|
|
that can be handled by the C<rdf_parse> method of L<RDF::TrineShortcuts>. |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
Each item in the list returned is an L<RDF::iCalendar::Entity>, though |
902
|
|
|
|
|
|
|
that class overloads stringification, so you can just treat each item |
903
|
|
|
|
|
|
|
as a string mostly. |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=item * C<< export_calendar($input, $subject, %options) >> |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
As per C<export_calendars> but exports just a single calendar. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
The subject provided must be an RDF::Trine::Node::Blank or |
910
|
|
|
|
|
|
|
RDF::Trine::Node::Resource of type icaltzd:Vcalendar. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=item * C<< export_component($input, $subject, %options) >> |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
Exports a component from a calendar - e.g. a single VEVENT |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
The subject provided must be an RDF::Trine::Node::Blank or |
917
|
|
|
|
|
|
|
RDF::Trine::Node::Resource of type icaltzd:Vevent, icaltzd:Vtodo |
918
|
|
|
|
|
|
|
or similar. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=item * C<< export_cards($input, %options) >> |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
See L<RDF::vCard::Exporter>. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=item * C<< export_card($input, $subject, %options) >> |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
See L<RDF::vCard::Exporter>. |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=back |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head2 RDF Input |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Input is expected to use the newer of the 2005 revision of the W3C's |
933
|
|
|
|
|
|
|
vCard vocabulary L<http://www.w3.org/TR/rdfcal/>. (Note that even |
934
|
|
|
|
|
|
|
though this was revised in 2005, the term URIs include "2002" in |
935
|
|
|
|
|
|
|
them.) |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Some extensions from the namespace L<http://buzzword.org.uk/rdf/icaltzdx#> |
938
|
|
|
|
|
|
|
are also supported. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head2 iCalendar Output |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
The output of this module aims at iCalendar (RFC 2445) compliance. |
943
|
|
|
|
|
|
|
In the face of weird input data though, (e.g. an DTSTART property that is a |
944
|
|
|
|
|
|
|
URI instead of a literal) it can pretty easily descend into exporting |
945
|
|
|
|
|
|
|
junk, non-compliant iCalendars. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
The output has barely been tested in any iCalendar-supporting software, |
948
|
|
|
|
|
|
|
so beware. |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=head1 SEE ALSO |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
L<RDF::iCalendar>. |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
L<RDF::vCard>, L<HTML::Microformats>, L<RDF::TrineShortcuts>. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
L<http://www.w3.org/TR/rdfcal/>. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
L<http://www.perlrdf.org/>. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=head1 AUTHOR |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
Toby Inkster E<lt>tobyink@cpan.orgE<gt>. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=head1 COPYRIGHT |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Copyright 2011, 2013 Toby Inkster |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
969
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTIES |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED |
974
|
|
|
|
|
|
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF |
975
|
|
|
|
|
|
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |