1package Net::Google::Calendar::Entry; 2 3use strict; 4use Data::Dumper; 5use DateTime; 6use XML::Atom; 7use XML::Atom::Entry; 8use XML::Atom::Util qw( set_ns first nodelist childlist iso2dt create_element); 9use base qw(XML::Atom::Entry Net::Google::Calendar::Base); 10use Net::Google::Calendar::Person; 11use Net::Google::Calendar::Comments; 12 13 14=head1 NAME 15 16Net::Google::Calendar::Entry - entry class for Net::Google::Calendar 17 18=head1 SYNOPSIS 19 20 my $event = Net::Google::Calendar::Entry->new(); 21 $event->title('Party!'); 22 $event->content('P-A-R-T-Why? Because we GOTTA!'); 23 $event->location("My Flat, London, England"); 24 $event->status('confirmed'); 25 $event->transparency('opaque'); 26 $event->visibility('private'); 27 28 my $author = Net::Google::Calendar::Person->new; 29 $author->name('Foo Bar'); 30 $author->email('foo@bar.com'); 31 $entry->author($author); 32 33 34 35=head1 DESCRIPTION 36 37=head1 METHODS 38 39=head2 new 40 41Create a new Event object 42 43=cut 44 45sub new { 46 my ($class, %opts) = @_; 47 my $self = $class->SUPER::new( Version => '1.0', %opts ); 48 $self->_initialize(); 49 return $self; 50} 51 52sub _initialize { 53 my ($self) = @_; 54 $self->SUPER::_initialize(); 55 $self->category({ scheme => 'http://schemas.google.com/g/2005#kind', term => 'http://schemas.google.com/g/2005#event' } ); 56 $self->set_attr('xmlns:gd', 'http://schemas.google.com/g/2005'); 57 $self->set_attr('xmlns:gCal', 'http://schemas.google.com/gCal/2005'); 58 unless ( $self->{_gd_ns} ) { 59 $self->{_gd_ns} = XML::Atom::Namespace->new(gd => 'http://schemas.google.com/g/2005'); 60 } 61 unless ( $self->{_gcal_ns} ) { 62 $self->{_gcal_ns} = XML::Atom::Namespace->new(gCal => 'http://schemas.google.com/gCal/2005'); 63 } 64 65} 66 67=head2 id [id] 68 69Get or set the id. 70 71=cut 72 73=head2 title [title] 74 75Get or set the title. 76 77=cut 78 79=head2 content [content] 80 81Get or set the content. 82 83=cut 84 85sub content { 86 my $self= shift; 87 if (@_) { 88 $self->set($self->ns, 'content', shift); 89 } 90 return $self->SUPER::content; 91} 92 93=head2 author [author] 94 95Get or set the author 96 97=cut 98 99=head2 transparency [transparency] 100 101Get or set the transparency. Transparency should be one of 102 103 opaque 104 transparent 105 106=cut 107 108sub transparency { 109 my $self = shift; 110 return $self->_gd_element('transparency', @_); 111} 112 113 114=head2 visibility [visibility] 115 116Get or set the visibility. Visibility should be one of 117 118 confidential 119 default 120 private 121 public 122 123=cut 124 125sub visibility { 126 my $self = shift; 127 return $self->_gd_element('visibility', @_); 128} 129 130=head2 status [status] 131 132Get or set the status. Status should be one of 133 134 canceled 135 confirmed 136 tentative 137 138=cut 139 140sub status { 141 my $self = shift; 142 return $self->_gd_element('eventStatus', @_); 143} 144 145 146 147=head2 is_allday 148 149Get the allday flag. 150 151Returns 1 of event is an All Day event, 0 if not, undef if it can't be 152determined. 153 154=cut 155 156sub is_allday { 157 my $self = shift; 158 159 my $start = $self->_attribute_get($self->{_gd_ns}, 'when', 'startTime'); 160 my $end = $self->_attribute_get($self->{_gd_ns}, 'when', 'endTime'); 161 162 my $startok = undef; 163 my $endok = undef; 164 165 if ($start =~ /^[0-9]{4}-[0-1][0-9]-[0-3][0-9]$/) { $startok = 1; } 166 if ($end =~ /^[0-9]{4}-[0-1][0-9]-[0-3][0-9]$/) { $endok = 1; } 167 168 if ($startok && $endok) { return 1; } 169 if (!$startok && !$endok) { return 0; } 170 return undef; 171} 172 173 174=head2 extended_property [property] 175 176Get or set an extended property 177 178=cut 179 180sub extended_property { 181 my $self = shift; 182 return $self->_multi_gd_element('extendedProperty', @_); 183} 184 185sub _multi_gd_element { 186 my $self = shift; 187 $self->_gd_elem_generic(1, @_); 188} 189 190sub _gd_element{ 191 my $self = shift; 192 $self->_gd_elem_generic(0, @_); 193} 194 195sub _gd_elem_generic{ 196 my $self = shift; 197 my $multi = shift; 198 my $elem = shift; 199 200 if ($elem eq "extendedProperty") { 201 if (@_) { 202 my $name = shift; 203 my $val = shift; 204 my $op = $multi ? 'add' : 'set'; 205 $self->$op($self->{_gd_ns}, "${elem}" => "", { name => $name, value => $val } ); 206 return $val; 207 } 208 my $ret = {}; 209 for my $item ($self->_my_getlist($self->{_gd_ns} ,$elem)) { 210 $ret->{$item->getAttribute('name')} = $item->getAttribute('value'); 211 } 212 return $ret; 213 } 214 215 if (@_) { 216 my $val = lc(shift); 217 my $op = ($multi)? 'add' : 'set'; 218 $self->$op($self->{_gd_ns}, "${elem}", '', { value => "http://schemas.google.com/g/2005#event.${val}" }); 219 return $val; 220 } 221 my $val = $self->_attribute_get($self->{_gd_ns}, $elem, 'value'); 222 $val =~ s!^http://schemas.google.com/g/2005#event\.!!; 223 return $val; 224} 225 226sub _attribute_get { 227 my ($self, $ns, $what, $key) = @_; 228 my $elem = $self->_my_get($self->{_gd_ns}, $what, $key); 229 230 if (defined($elem) && $elem->hasAttribute($key)) { 231 return $elem->getAttribute($key); 232 } else { 233 return $elem; 234 } 235} 236 237=head2 location [location] 238 239Get or set the location 240 241=cut 242 243sub location { 244 my $self = shift; 245 246 if (@_) { 247 my $val = shift; 248 $self->set($self->{_gd_ns}, 'where' => '', { valueString => $val}); 249 return $val; 250 } 251 252 return $self->_attribute_get($self->{_gd_ns}, 'where', 'valueString'); 253} 254 255 256=head2 quick_add [bool] 257 258Get or set whether this is a a quick add entry or not. 259 260=cut 261sub quick_add { 262 my $self = shift; 263 264 if (@_) { 265 my $val = ($_[0])? 'true' : 'false'; 266 $self->set( $self->{_gcal_ns}, quickadd => '', { value => $val } ); 267 return $_[0]; 268 } 269 my $val = $self->_attribute_get($self->{_gcal_ns}, 'quickadd', 'valueString'); 270 return ($val eq 'true'); 271} 272 273 274 275=head2 when [<start> <end> [allday]] 276 277Get or set the start and end time as supplied as DateTime objects. 278End must be more than start. 279 280You may optionally pass a paramter in designating if this is an all day event or not. 281 282Returns two DateTime objects depicting the start and end and a flag noting whether it's an all day event. 283 284 285=cut 286 287sub when { 288 my $self = shift; 289 290 if (@_) { 291 my ($start, $end, $allday) = @_; 292 $allday = 0 unless defined $allday; 293 unless ($end>=$start) { 294 $@ = "End is not less than start"; 295 return undef; 296 } 297 $start->set_time_zone('UTC'); 298 $end->set_time_zone('UTC'); 299 300 my $format = $allday ? "%F" : "%FT%TZ"; 301 302 $self->set($self->{_gd_ns}, "when", '', { 303 startTime => $start->strftime($format), 304 endTime => $end->strftime($format), 305 }); 306 } 307 my $start = $self->_attribute_get($self->{_gd_ns}, 'when', 'startTime'); 308 my $end = $self->_attribute_get($self->{_gd_ns}, 'when', 'endTime'); 309 my @rets; 310 if (defined $start) { 311 push @rets, $start; 312 } else { 313 return @rets; 314 #die "No start date ".$self->as_xml; 315 } 316 if (defined $end) { 317 push @rets, $end; 318 } 319 return (map { iso2dt($_) } @rets), $self->is_allday; 320 321} 322 323=head2 reminder <method> <type> <when> 324 325Sets a reminder on this entry. 326 327C<method> must be one of: 328 329 alert email sms 330 331C<type> must be one of 332 333 days hours minutes absoluteTime 334 335If the type is C<absoluteTime> then C<when> should be either a iso formatted date string or a DateTime object. 336 337=cut 338 339sub reminder { 340 my $self = shift; 341 my ($method, $type, $time) = @_; 342 return undef unless ($method =~ /alert|email|sms/); 343 return undef unless ($type =~ /days|hours|minutes|absoluteTime/); 344 $time = $time->strftime("%FT%TZ") if ref($time) && $time->isa('DateTime'); 345 for my $item ($self->_my_getlist($self->{_gd_ns} ,'when')) { 346 my $elem = create_element($self->{_gd_ns}, 'reminder'); 347 $elem->setAttribute('method', $method); 348 $elem->setAttribute($type, $time); 349 $item->appendChild($elem); 350 } 351 return 1; 352} 353 354 355 356 357 358=head2 who [Net::Google::Calendar::Person[s]] 359 360Get or set the list of event invitees. 361 362If no parameters are passed then it returns a list containing zero 363or more Net::Google::Calendar::Person objects. 364 365If you pass in one or more Net::Google::Calendar::Person objects then 366they get set as the invitees. 367 368=cut 369 370# http://code.google.com/apis/gdata/elements.html#gdWho 371sub who { 372 my $self = shift; 373 374 my $ns_uri = ""; # $self->{_gd_ns}; 375 my $name = 'gd:who'; 376 foreach my $who (@_) { 377 $self->add($ns_uri,"${name}", $who, {}); 378 } 379 my @who = map { 380 my $person = Net::Google::Calendar::Person->new(); 381 for my $attr ($_->attributes) { 382 my $name = $attr->nodeName; 383 my $val = $attr->value || ""; 384 #print "$name = $val\n"; 385 eval { $person->_do('@'.$name, $val) }; 386 next if $@; 387 } 388 foreach my $child ($_->childNodes) { 389 my $name = $child->nodeName; 390 my $val = $child->getAttribute('value'); 391 #print "$name = $val\n"; 392 $person->_do($name, $val); 393 } 394 #print $person->as_xml; 395 #print "\n\n"; 396 $person; 397 } $self->_my_getlist($ns_uri,$name); 398} 399 400=head2 comments [comment[s]] 401 402Get or set Comments object. 403 404=cut 405 406sub comments { 407 my $self = shift; 408 409 my $ns_uri = $self->{_gd_ns}; 410 my $name = 'gd:comments'; 411 if (@_) { 412 $self->add($ns_uri,"${name}", shift, {}); 413 } 414 415 my $tmp = $self->_my_get($ns_uri, $name); 416 my $comment = Net::Google::Calendar::Comments->new(); 417 for my $attr ($tmp->attributes) { 418 my $name = $attr->nodeName; 419 my $val = $attr->value || ""; 420 eval { $comment->_do('@'.$name, $val) }; 421 next if $@; 422 } 423 my $feed = Net::Google::Calendar::FeedLink->new(Elem => $tmp->firstChild); 424 $comment->feed_link($feed) if $feed; 425 return $comment; 426} 427 428 429 430 431=head2 edit_url 432 433Return the edit url of this event. 434 435=cut 436 437 438sub edit_url { 439 return $_[0]->_generic_url('edit'); 440} 441 442 443=head2 self_url 444 445Return the self url of this event. 446 447=cut 448 449 450 451sub self_url { 452 return $_[0]->_generic_url('self'); 453} 454 455 456=head2 html_url 457 458Return the 'alternate' browser-friendly url of this event. 459 460=cut 461 462sub html_url { 463 return $_[0]->_generic_url('alternate'); 464} 465 466 467 468=head2 recurrence [ Data::ICal::Entry::Event ] 469 470Get or set a recurrence for an entry - this is in the form of a Data::ICal::Entry::Event object. 471 472Returns undef if there's no recurrence event 473 474This will not work if C<Data::ICal> is not installed and will return undef. 475 476For example ... 477 478 $event->title('Pay Day'); 479 $event->start(DateTime->now); 480 481 my $recurrence = Data::ICal::Entry::Event->new(); 482 483 484 my $last_day_of_the_month = DateTime::Event::Recurrence->monthly( days => -1 ); 485 $recurrence->add_properties( 486 dtstart => DateTime::Format::ICal->format_datetime(DateTime->now), 487 rrule => DateTime::Format::ICal->format_recurrence($last_day_of_the_month), 488 ); 489 490 $entry->recurrence($recurrence); 491 492To get the recurrence back: 493 494 print $entry->recurrence->as_string; 495 496See 497 498 http://code.google.com/apis/gdata/common-elements.html#gdRecurrence 499 500For more details 501 502=cut 503 504sub recurrence { 505 my $self = shift; 506 507 # we need Data::ICal for this but we don't wnat to require it 508 eval { 509 require Data::ICal; 510 Data::ICal->import; 511 require Data::ICal::Entry::Event; 512 Data::ICal::Entry::Event->import; 513 514 }; 515 if ($@) { 516 $@ = "Couldn't load Data::ICal or Data::ICal::Entry::Event: $@"; 517 return; 518 } 519 520 # this is all one massive hack. 521 # I hate myself for writing this. 522 if (@_) { 523 my $event = shift; 524 # pesky Google Calendar needs you to remove the BEGIN:VEVENT END:VEVENT. TSSSK 525 my $recur = $event->as_string; 526 527 $recur =~ s!(^BEGIN:VEVENT\n|END:VEVENT\n$)!!sg; 528 $self->set($self->{_gd_ns}, 'recurrence', $recur); 529 530 return $event; 531 } 532 my $string = $self->get($self->{_gd_ns}, 'recurrence'); 533 return undef unless defined $string; 534 $string =~ s!\n+$!!g; 535 $string = "BEGIN:VEVENT\n${string}\nEND:VEVENT"; 536 my $vfile = Text::vFile::asData->new->parse_lines( split(/\n/, $string) ); 537 my $event = Data::ICal::Entry::Event->new(); 538 #return $event; 539 540 $event->parse_object($vfile->{objects}->[0]); 541 return $event->entries->[0]; 542 543} 544 545=head2 add_link <link> 546 547Adds the link $link, which must be an XML::Atom::Link object, to the entry as a new <link> tag. For example: 548 549 my $link = XML::Atom::Link->new; 550 $link->type('text/html'); 551 $link->rel('alternate'); 552 $link->href('http://www.example.com/2003/12/post.html'); 553 $entry->add_link($link); 554 555=cut 556 557sub add_link { 558 my ($self, $link) = @_; 559 # workaround bug in XML::Atom 560 $link = bless $link, 'XML::Atom::Link' if ref($link) && $link->isa('XML::Atom::Link'); 561 $self->SUPER::add_link($link); 562} 563 564=head1 TODO 565 566=over 4 567 568=item more complex content 569 570=item more complex locations 571 572=item recurrency 573 574=item comments 575 576=back 577 578See http://code.google.com/apis/gdata/common-elements.html for details 579 580=head1 AUTHOR 581 582Simon Wistow <simon@thegestalt.org> 583 584=head1 COPYRIGHT 585 586Copyright Simon Wistow, 2006 587 588Distributed under the same terms as Perl itself. 589 590=head1 SEE ALSO 591 592http://code.google.com/apis/gdata/common-elements.html 593 594L<Net::Google::Calendar> 595 596L<XML::Atom::Event> 597 598=cut 599 600 601 6021; 603