1# $Id$
2package iCal::Parser;
3use strict;
4
5our $VERSION='1.20';
6
7our @ISA = qw (Exporter);
8
9use DateTime::Format::ICal;
10use DateTime::TimeZone;
11use Text::vFile::asData;
12use File::Basename;
13use IO::File;
14use IO::String;
15
16# mapping of ical entries to datatypes
17our %TYPES=(dates=>{DTSTAMP=>1,DTSTART=>1,DTEND=>1,COMPLETED=>1,
18                    'RECURRENCE-ID'=>1,EXDATE=>1,DUE=>1,
19                    'LAST-MODIFIED'=>1,
20                },
21            durations=>{DURATION=>1},
22            arrays=>{EXDATE=>1,ATTENDEE=>1},
23            hash=>{'ATTENDEE'=>1, ORGANIZER=>1},
24        );
25
26our %defaults=(debug=>0,span=>undef,start=>undef,end=>undef,months=>60,tz=>'local');
27
28our $dfmt=DateTime::Format::ICal->new;
29our $parser=Text::vFile::asData->new;
30sub new {
31    my ($class, %params) = @_;
32
33    my $self=bless {%defaults, %params,
34                    ical=>{cals=>[],events=>{},todos=>[]},
35                    _today=>DateTime->now,_calid=>0,
36                }, $class;
37    #set range, allow passed in dates as DateTimes or strings
38    my $start=$params{start}||DateTime->now->truncate(to=>'year');
39    $start=$dfmt->parse_datetime($start) unless ref $start;
40    my $end=$params{end}||$start->clone->add(months=>$self->{months});
41    $end=$dfmt->parse_datetime($end) unless ref $end;
42    $self->{span}||=DateTime::Span->new(start=>$start, end=>$end);
43
44    $self->{tz}=DateTime::TimeZone->new(name=>$self->{tz})
45        unless ref $self->{tz};
46
47    return ($self);
48}
49sub parse {
50    my $self=shift;
51
52    foreach my $file (@_) {
53        my $fh=ref $file ? $file
54            : IO::File->new($file,'r') || die "Can\'t open $file, $!";
55        my $data=$parser->parse($fh);
56        undef $fh;
57
58        $self->VCALENDAR($data->{objects}[0],$file);
59        $self->add_objects($data->{objects}[0]);
60        $self->update_recurrences;
61    }
62    return $self->{ical};
63}
64sub parse_files {
65    return parse(@_);
66}
67sub parse_strings {
68    my $self=shift;
69    return $self->parse((map { IO::String->new($_) } @_));
70}
71sub calendar {
72    return shift->{ical};
73}
74sub VCALENDAR {
75    my($self,$cal,$file)=@_;
76
77    my %props=();
78    $self->{recurrences}=[];
79    $self->map_properties(\%props,$cal);
80    $props{'X-WR-TIMEZONE'}||=$self->{tz}->name;
81    $props{index}=++$self->{_calid};
82    $props{'X-WR-RELCALID'}||=$self->{_calid};
83    $props{'X-WR-CALNAME'}||= ref $file
84        ? "Calendar $self->{_calid}" : fileparse($file,qr{\.\w+});
85
86    push @{$self->{ical}{cals}},\%props;
87}
88sub VTODO {
89    my($self,$todo)=@_;
90    return if $self->{no_todos};
91
92    my $t={idref=>$self->_cur_calid};
93    $self->map_properties($t,$todo);
94    $t->{PRIORITY}||=99;
95
96    $self->add_objects($todo,$t);
97    push @{ $self->{ical}{todos} }, $t;
98}
99sub VEVENT {
100    my($self,$event)=@_;
101    return if $self->{no_events};
102
103    my %e=(idref=>$self->_cur_calid);
104
105    $self->map_properties(\%e,$event);
106    $self->add_objects($event,\%e);
107
108    my $start=$e{DTSTART};
109    return if $start > $self->{span}->end;
110
111    warn "Event: @e{qw(UID DTSTART SUMMARY)}\n"
112        if $self->{debug};
113
114    # stolen from Text::vFile::asData example
115    $e{allday}=1 if _param($event,'DTSTART','VALUE')||'' eq 'DATE';
116
117    #is it a rule that an event must contain either a duration or end?
118    # answer: no, it's not (cpan bug #25232)
119    my $end=$e{DTEND};
120    my $duration=$end ? $end-$start : delete $e{DURATION};
121    $duration ||= DateTime::Duration->new(days=> $e{allday} ? 1 : 0);
122    $e{DTEND}||=$start+$duration;
123    $e{hours}=_hours($duration) unless $e{allday};
124
125    #build recurrence sets
126    my $set;
127    if (my $rid=$e{'RECURRENCE-ID'}) {
128        return if $start < $self->{span}->start;
129        push @{ $self->{recurrences} }, \%e;
130        return;
131    }
132    if (my $recur=delete $e{RRULE}) {
133        $set=$dfmt->parse_recurrence(recurrence=>$recur, dtstart=>$start,
134                                     #cap infinite repeats
135                                     until =>$self->{span}->end);
136    } elsif ($end) {
137        # non-rrule event possibly spanning multiple days,
138        # expand into multiple events
139        my $diff=$end-$start;
140        if (!$e{allday} && $end->day > $start->day) {
141            $self->add_span(\%e);
142            return;
143        }
144        if ($diff->delta_days > 1) {
145            # note recurrence includes last date, and allday events
146            # end at 00 on the last (non-inclusive) day, so remove it
147            # from set
148            $set=DateTime::Set->from_recurrence
149                (start=>$start,end=>$end->clone->subtract(days=>1),
150                 recurrence=>sub {
151                     return $_[0]->truncate(to=>'day')->add(days=>1)
152                 });
153            # reset duration to "allday" event
154            $duration=DateTime::Duration->new(days=>1);
155        }
156    }
157    $set||=DateTime::Set->from_datetimes(dates=>[$start]);
158
159    # fix bug w/ recurrence containing no entries
160    # note that count returns "undef" for infinitely large sets.
161    return if defined $set->count && $set->count==0;
162
163    if (my $dates=delete $e{'EXDATE'}) {
164        #mozilla/sunbird set exdate to T00..., so, get first start date
165        #and set times on exdates
166        my $d=$set->min;
167        my $exset=DateTime::Set->from_datetimes
168            (dates=>[
169                map {$_->set(hour=>$d->hour,minute=>$d->minute,
170                             second=>$d->second)
171                 } @$dates]);
172        $set=$set
173            ->complement(DateTime::Set->from_datetimes(dates=>$dates));
174    }
175    $set=$set->intersection($self->{span}) if $self->{span};
176    my $iter=$set->iterator;
177    while (my $dt=$iter->next) {
178        #bug found by D. Sweet. Fix alarms on entries
179        #other than first
180        my $new_event={%e,DTSTART=>$dt,DTEND=>$dt+$duration};
181        $new_event->{VALARM}=_fix_alarms($new_event, $e{DTSTART})
182            if $new_event->{VALARM};
183        $self->add_event($new_event);
184    }
185}
186sub VALARM {
187    my($self,$alarm,$e)=@_;
188
189    my %a=();
190    #handle "RELATED attribute
191    my $which=$alarm->{properties}{TRIGGER}[0]{param}{RELATED}||'START';
192
193    $self->map_properties(\%a,$alarm);
194    $a{when}=ref $a{TRIGGER} eq 'DateTime::Duration'
195        ? $e->{"DT$which"}+delete $a{TRIGGER}
196            : delete $a{TRIGGER};
197
198    push @{$e->{VALARM}},\%a;
199}
200sub _fix_alarms {
201    my $e=shift;
202    my $orig_start=shift;
203
204    # trigger already remove, generate diff
205    my $diff=$e->{DTSTART}-$orig_start;
206    my @alarms=();
207    foreach my $old (@{ $e->{VALARM} }) {
208        my %a=%$old;
209        $a{when}=$a{when}->clone->add_duration($diff);
210        push @alarms, \%a;
211    }
212    return \@alarms;
213}
214sub add_objects {
215    my $self=shift;
216    my $event=shift;
217
218    return unless $event->{objects};
219    foreach my $o (@{ $event->{objects} }) {
220        my $t=$o->{type};
221        $self->$t($o,@_) if $self->can($t);
222    }
223}
224sub _hours {
225    my $duration=shift;
226
227    my($days,$hours,$minutes)=@{$duration}{qw(days hours minutes)};
228    $days||=0; $hours||=0; $minutes||=0;
229    return sprintf "%.2f",($days*24*60+$hours*60+$minutes)/60.0;
230}
231sub convert_value {
232    my($self,$type,$hash)=@_;
233
234    my $value=$hash->{value};
235    return $value unless $value; #should protect from invalid datetimes
236
237    if ($type eq 'TRIGGER') {
238        #can be date or duration!
239        return $dfmt->parse_duration($value) if $value =~/^[-+]?P/;
240        return $dfmt->parse_datetime($value)->set_time_zone($self->{tz});
241    }
242    if ($TYPES{hash}{$type}) {
243        my %h=(value=>$value);
244        map { $h{$_}=$hash->{param}{$_} } keys %{ $hash->{param} };
245        return \%h;
246    }
247    return $dfmt->parse_duration($value) if $TYPES{durations}{$type};
248    return $value unless $TYPES{dates}{$type};
249
250    #mozilla calendar bug: negative dates on todos!
251    return undef if $value =~ /^-/;
252
253    #handle dates which can be arrays (EXDATE)
254    my @dates=();
255    foreach my $s (split ',', $value) {
256        # I have a sample calendar "Employer Tax calendar"
257        # which has an allday event ending on 20040332!
258        # so, handle the exception
259        my $date;
260        eval {
261            $date=$dfmt->parse_datetime($s)->set_time_zone($self->{tz});
262        };
263        push @dates, $date and next unless $@;
264        die $@ if $@ && $type ne 'DTEND';
265        push @dates,
266            $dfmt->parse_datetime(--$value)->set_time_zone($self->{tz});
267    }
268    return @dates;
269}
270sub get_value {
271    my($self,$props,$key)=@_;
272
273    my @a=map {$self->convert_value($key,$_)} @{ $props->{$key} };
274    return wantarray ? @a : $a[0];
275}
276sub _param {
277    my($event,$key,$param)=@_;
278    return $event->{properties}{$key}[0]{param}{$param};
279}
280#set $a from $b
281sub map_properties {
282    my($self,$e,$event)=@_;
283
284    my $props=$event->{properties};
285    foreach (keys %$props) {
286        my @a=$self->get_value($props,$_);
287        delete $e->{$_}, next unless defined $a[0];
288        $e->{$_}=$TYPES{arrays}{$_} ? \@a : $a[0];
289    }
290    ;
291    delete $e->{SEQUENCE};
292}
293sub _cur_calid {
294    my $self=shift;
295    return $self->{ical}{cals}[-1]{'X-WR-RELCALID'};
296}
297sub find_day {
298    my($self,$d)=@_;
299
300    my $h=$self->{ical}{events};
301    #warn sprintf "find %4d-%02d-%02d\n",$d->year,$d->month,$d->day
302    #if $self->{debug};
303    foreach my $i ($d->year,$d->month,$d->day) {
304        $h->{$i}||={};
305        $h=$h->{$i};
306    }
307    return $h;
308}
309sub add_event {
310    my($self,$event)=@_;
311
312    $self->find_day($event->{DTSTART})->{$event->{UID}}=$event;
313}
314sub update_recurrences {
315    my $self=shift;
316    foreach my $event (@{ $self->{recurrences} }) {
317        my $day=$self->find_day(delete $event->{'RECURRENCE-ID'});
318        my $old=delete $day->{$event->{UID}}||{};
319        $self->add_event({%$old,%$event});
320    }
321}
322sub add_span {
323    my($self,$event)=@_;
324    my %last=%$event;
325
326    #when event spans days, only alarm on first entry
327    delete $last{VALARM};
328
329    $last{DTSTART}=$event->{DTEND}->clone->truncate(to=>'day');
330    $last{DTEND}=$event->{DTEND};
331    $event->{DTEND}=$event->{DTSTART}->clone->truncate(to=>'day')
332        ->add(days=>1);
333    $last{hours}=_hours($last{DTEND}-$last{DTSTART});
334    $event->{hours}=_hours($event->{DTEND}-$event->{DTSTART});
335    my @a=();
336    my $min=$self->{span}->start;
337    my $max=$self->{span}->end;
338    for (my $d=$event->{DTEND}->clone;
339         $d < $last{DTSTART}; $d->add(days=>1)) {
340        if ($d >= $min && $d <= $max) {
341            my %t=%last;
342            $t{DTSTART}=$d->clone;
343            $t{DTEND}=$d->clone->add(days=>1);
344            $t{hours}=_hours($t{DTEND}-$t{DTSTART});
345            push @a,\%t;
346        }
347    }
348    my($start,$end)=($self->{span}->start,$self->{span}->end);
349    map {$self->add_event($_)} grep {
350        $_->{DTSTART} >= $start && $_->{DTEND} <= $end
351    } $event,@a,\%last;
352}
3531;
354__END__
355
356=head1 NAME
357
358iCal::Parser - Parse iCalendar files into a data structure
359
360=head1 SYNOPSIS
361
362  use iCal::Parser
363
364  my $parser=iCal::Parser->new();
365  my $hash=$parser->parse($file);
366
367  $parser->parse($another_file);
368  my $combined=$parser->calendar;
369
370  my $combined=iCal::Parser->new->parse(@files);
371  my $combined=iCal::Parser->new->parse_files(@files);
372  my $combined=iCal::Parser->new->parse_strings(@strings);
373
374=head1 DESCRIPTION
375
376This module processes iCalendar (vCalendar 2.0) files as specified in RFC 2445
377into a data structure.
378It handles recurrences (C<RRULE>s), exclusions (C<EXDATE>s), event updates
379(events with a C<RECURRENCE-ID>), and nested data structures (C<ATTENDEES> and
380C<VALARM>s). It currently ignores the C<VTIMEZONE>, C<VJOURNAL> and
381C<VFREEBUSY> entry types.
382
383The data structure returned is a hash like the following:
384
385    {
386      calendars=>[\%cal, ...],
387      events=>{yyyy=>{mm=>{dd}=>{UID=>\%event}}
388      todos=>[\%todo, ...]
389    }
390
391That is, it contains an array of calendar hashes, a hash of events key by
392C<year=E<gt>month=E<gt>day=E<gt>eventUID>, and an array of todos.
393
394Calendars, events and todos are "rolled up" version os the hashes returned from
395L<Text::vFile::asData>, with dates replaced by C<DateTime> objects.
396
397During parsing, events in the input calendar are expanded out into multiple
398events, one per day covered by the event, as follows:
399
400=over 4
401
402=item *
403
404If the event is a one day "all day" event (in ical, the event is 24hrs long,
405starts at midnight on the day and ends a midnight of the next day),
406it contains no C<hour> field and the C<allday> field is set to C<1>.
407
408=item *
409
410If the event is a recurrence (C<RRULE>), one event per day is created as
411per the C<RRULE> specification.
412
413=item *
414
415If the event spans more than one day (the start and end dates are on different
416days, but does not contain an C<RRULE>),
417it is expanded into multiple events, the first events end time is set
418to midnight, subsequent events are set to start at midnight and end at
419midnight the following day (same as an "allday" event, but the C<allday> field
420is not set), and the last days event is set to run from midnight to the
421end time of the original multi-day event.
422
423=item *
424
425If the event is an update (it contains a C<RECURRENCE-ID>), the original
426event is updated. If the referenced event does not exist (e.g., it was
427deleted after the update), then the event is added as a new event.
428
429=back
430
431
432An example of each hash is below.
433
434=head2 Calendar Hash
435
436    {
437        'X-WR-CALNAME' => 'Test',
438        'index' => 1,
439        'X-WR-RELCALID' => '7CCE8555-3516-11D9-8A43-000D93C45D90',
440        'PRODID' => '-//Apple Computer\\, Inc//iCal 1.5//EN',
441        'CALSCALE' => 'GREGORIAN',
442        'X-WR-TIMEZONE' => 'America/New_York',
443        'X-WR-CALDESC' => 'My Test Calendar',
444        'VERSION' => '2.0'
445    }
446
447=head2 Event Hash
448
449Note that C<hours> and C<allday> are mutually exclusive in the actual data.
450The C<idref> field contains the C<id> of the calendar the event
451came from, which is useful if the hash was created from multiple calendars.
452
453    {
454        'SUMMARY' => 'overnight',
455        'hours' => '15.00',
456        'allday' => 1,
457        'UID' => '95CCBF98-3685-11D9-8CA5-000D93C45D90',
458        'idref' => '7CCE8555-3516-11D9-8A43-000D93C45D90',
459        'DTSTAMP' => \%DateTime,
460        'DTEND' => \%DateTime,
461        'DTSTART' => \%DateTime
462        'ATTENDEE' => [
463           {
464              'CN' => 'Jay',
465              'value' => 'mailto:jayl@my.server'
466           },
467          ],
468          'VALARM' => [
469            {
470              'when' => \%DateTime,
471              'SUMMARY' => 'Alarm notification',
472              'ACTION' => 'EMAIL',
473              'DESCRIPTION' => 'This is an event reminder',
474              'ATTENDEE' => [
475                 {
476                   'value' => 'mailto:cpan@my.server'
477                 }
478              ]
479           }
480         ],
481    }
482
483=head2 Todo Hash
484
485    {
486        'URL' => 'mailto:me',
487        'SUMMARY' => 'todo 1',
488        'UID' => 'B78E68F2-35E7-11D9-9E64-000D93C45D90',
489        'idref' => '7CCE8555-3516-11D9-8A43-000D93C45D90',
490        'STATUS' => 'COMPLETED',
491        'COMPLETED' => \%DateTime,
492        'DTSTAMP' => \%DateTime,
493        'PRIORITY' => '9',
494        'DTSTART' => \%DateTime,
495        'DUE' => \%DateTime,
496        'DESCRIPTION' => 'not much',
497        'VALARM' => [
498           {
499              'when' => \%DateTime,
500              'ATTACH' => 'file://localhost/my-file',
501              'ACTION' => 'PROCEDURE'
502           }
503        ],
504    },
505
506=head1 Methods
507
508=head2 new(%opt_args)
509
510=head3 Optional Arguments
511
512=over 4
513
514=item start {yyymmdd|DateTime}
515
516Only include events on or after C<yyymmdd>. Defaults to Jan of this year.
517
518=item end {yyyymmdd|DateTime}
519
520Only include events before C<yyymmdd>.
521
522=item no_events
523
524Don't include events in the output (todos only).
525
526=item no_todos
527
528Don't include todos in the output (events only).
529
530=item months n
531
532L<DateTime::Set>s (used for calculating recurrences) are limited to
533approximately 200 entries. If an C<end> date is not specified, the
534C<to> date is set to the C<start> date plus this many months.
535The default is 60.
536
537=item tz (string|DateTime::TimeZone)
538
539Use tz as timezone for date values.
540The default is 'local', which will adjust the parsed dates to the current timezone.
541
542=item debug
543
544Set to non-zero for some debugging output during processing.
545
546=back
547
548=head2 parse({file|file_handle}+)
549
550Parse the input files or opened file handles and return the generated hash.
551
552This function can be called mutitple times and the calendars will be
553merge into the hash, each event tagged with the unique id of its calendar.
554
555=head2 parse_files({file|file_handle}+)
556
557Alias for C<parse()>
558
559=head2 parse_strings(string+)
560
561Parse the input strings (each assumed to be a valid iCalendar) and return
562the generated hash.
563
564=head1 AUTHOR
565
566Rick Frankel, cpan@rickster.com
567
568=head1 COPYRIGHT
569
570This program is free software; you can redistribute
571it and/or modify it under the same terms as Perl itself.
572
573The full text of the license can be found in the
574LICENSE file included with this module.
575
576
577=head1 SEE ALSO
578
579L<Text::vFile::asData>, L<DateTime::Set>, L<DateTime::Span>,
580L<iCal::Parser::SAX>
581