File Coverage

blib/lib/Data/ICal/RDF.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


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