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