view release on metacpan or  search on metacpan

lib/Data/ICal/Entry.pm  view on Meta::CPAN

use warnings;
use strict;

package Data::ICal::Entry;
use base qw/Class::Accessor/;
use Data::ICal::Property;
use Sys::Hostname qw();         # For unique UIDs for entries
use Carp;

use constant CRLF => "\x0d\x0a";

=head1 NAME

Data::ICal::Entry - Represents an entry in an iCalendar file

=head1 SYNOPSIS

    my $vtodo = Data::ICal::Entry::Todo->new();
    $vtodo->add_property(
    # ... see Data::ICal::Entry::Todo documentation
    );
    $vtodo->add_properties( ... );

    $calendar->add_entry($vtodo);

    $event->add_entry($alarm);
    $event->add_entries($alarm1, ...);

    # or all in one go
    my $vtodo = Data::ICal::Entry::Todo->new( \%props, \@entries );

=head1 DESCRIPTION

A L<Data::ICal::Entry> object represents a single entry in an
iCalendar file.  (Note that the iCalendar RFC refers to entries as
"components".)  iCalendar defines several types of entries, such as
events and to-do lists; each of these corresponds to a subclass of
L<Data::ICal::Entry> (though only to-do lists and events are currently
implemented).  L<Data::ICal::Entry> should be treated as an abstract
base class -- all objects created should be of its subclasses.  The
entire calendar itself (the L<Data::ICal> object) is also represented
as a L<Data::ICal::Entry> object.

Each entry has an entry type (such as C<VCALENDAR> or C<VEVENT>), a
series of "properties", and possibly some sub-entries.  (Only the root
L<Data::ICal> object can have sub-entries, except for alarm entries
contained in events and to-dos (not yet implemented).)

=head1 METHODS

=cut

=head2 new

Creates a new entry object with no properties or sub-entries.

=cut

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();
    # ALLOW passing arguments here!
    $self->set( properties => {} );
    $self->set( entries    => [] );
    for (@_) {
        ref $_ eq "HASH"  and $self->add_properties( %$_ );
        ref $_ eq "ARRAY" and $self->add_entries( @$_ );
    }
    return $self;
}

=head2 as_string [ crlf => C<CRLF> ]

Returns the entry as an appropriately formatted string (with trailing
newline).

Properties are returned in alphabetical order, with multiple
properties of the same name returned in the order added.  (Property
order is unimportant in iCalendar, and this makes testing easier.)

If any mandatory property is missing, issues a warning.

The string to use as a newline can optionally be specified by giving
the a C<crlf> argument, which defaults to C<\x0d\x0a>, per RFC 2445
spec; this option is primarily for backwards compatibility with
versions of this module before 0.16.

=cut

my $uid = 0;
sub as_string {
    my $self = shift;
    my %args = (
        crlf => CRLF,
        @_
    );
    my $output = $self->header(%args);

    my @mandatory = (
        $self->mandatory_unique_properties,
        $self->mandatory_repeatable_properties,
    );

    if (grep {$_ eq "uid"} @mandatory and !defined $self->properties->{uid}
            and $self->auto_uid) {
      # Per the RFC, create a "persistent, globally unique" UID for this
      # event; "persistent" in this context does not mean consistent
      # across time, but rather "unique across all time"
      $self->add_property(
          uid => time() . '-' .$$ . '-' . $uid++ . '@' . Sys::Hostname::hostname()
      );
    }

    for my $name ( @mandatory ) {
        carp "Mandatory property for " . ( ref $self ) . " missing: $name"
            unless $self->properties->{$name}
                and @{ $self->properties->{$name} };
    }

    my @properties = sort {
        # RFC2445 implies an order (see 4.6 Calendar Components) but does not
        # require it.  However, some applications break if VERSION is not first
        # (see http://icalvalid.cloudapp.net/Default.aspx and [rt.cpan.org # #65447]).
        return -1 if $a eq 'version';
        return  1 if $b eq 'version';
        return $a cmp $b;
    } keys %{ $self->properties };

    for my $name (@properties) {
        $output .= $_
            for map { $_->as_string(%args) } @{ $self->properties->{$name} };
    }

    for my $entry ( @{ $self->entries } ) {
        $output .= $entry->as_string(%args);
    }
    $output .= $self->footer(%args);

    return $output;
}

=head2 add_entry $entry

Adds an entry to this entry.  (According to the standard, this should
only be called on either a to-do or event entry with an alarm entry,
or on a calendar entry (L<Data::ICal>) with a to-do, event, journal,
timezone, or free/busy entry.)

Returns true if the entry was successfully added, and false otherwise
(perhaps because you tried to add an entry of an invalid type, but
this check hasn't been implemented yet).

=cut

sub add_entry {
    my $self  = shift;
    my $entry = shift;
    push @{ $self->{entries} }, $entry;

    $entry->vcal10( $self->vcal10 );
    $entry->rfc_strict( $self->rfc_strict );
    $entry->auto_uid( $self->auto_uid );

    return $self;
}

=head2 add_entries $entry1, [$entry2, ...]

Convenience function to call C<add_entry> several times with a list
of entries.

=cut

sub add_entries {
    my $self  = shift;
    $self->add_entry( $_ ) for @_;
    return $self;
}

=head2 entries

Returns a reference to the array of subentries of this entry.

=cut

__PACKAGE__->mk_ro_accessors('entries');

=head2 properties

Returns a reference to the hash of properties of this entry.  The keys
are property names and the values are array references containing
L<Data::ICal::Property> objects.

=cut

__PACKAGE__->mk_ro_accessors('properties');

=head2 property

Given a property name returns a reference to the array of
L<Data::ICal::Property> objects.

=cut

sub property {
    my $self = shift;

lib/Data/ICal/Entry.pm  view on Meta::CPAN

sub footer {
    my $self = shift;
    my %args = (
        crlf => CRLF,
        @_
    );
    return 'END:' . $self->ical_entry_type . $args{crlf};
}

# mapping of event types to class (under the Data::Ical::Event namespace)
my %_generic = (
    vevent    => 'Event',
    vtodo     => 'Todo',
    vjournal  => 'Journal',
    vfreebusy => 'FreeBusy',
    vtimezone => 'TimeZone',
    standard  => 'TimeZone::Standard',
    daylight  => 'TimeZone::Daylight',
);

=head2 parse_object

Translate a L<Text::vFile::asData> sub object into the appropriate
L<Data::iCal::Event> subtype.

=cut

# TODO: this is currently recursive which could blow the stack -
#       it might be worth refactoring to make it sequential
sub parse_object {
    my ( $self, $object ) = @_;

    my $type = $object->{type};

    my $new_self;

    # First check to see if it's generic long name just in case there
    # event turns out to be a VGENERIC entry type
    if ( my $class = $_generic{ lc($type) } ) {
        $new_self = $self->_parse_data_ical_generic( $class, $object );

        # then look for specific overrides
    } elsif ( my $sub = $self->can( '_parse_' . lc($type) ) ) {
        $new_self = $self->$sub($object);

        # complain
    } else {
        warn "Can't parse type $type yet";
        return;
    }

    # recurse through sub-objects
    foreach my $sub_object ( @{ $object->{objects} } ) {
        $new_self->parse_object($sub_object);
    }

    return $self;
}

# special because we want to use ourselves as the parent
sub _parse_vcalendar {
    my ( $self, $object ) = @_;
    $self->_parse_generic_event( $self, $object );
    return $self;
}

# mapping of action types to class (under the Data::Ical::Event::Alarm namespace)
my %_action_map = (
    AUDIO     => 'Audio',
    DISPLAY   => 'Display',
    EMAIL     => 'Email',
    PROCEDURE => 'Procedure',
    NONE      => 'None',
    URI       => 'URI',
);

# alarms have actions
sub _parse_valarm {
    my ( $parent, $object ) = @_;

    # ick
    my $action = $object->{properties}->{ACTION}->[0]->{value};
    die "Can't parse VALARM with action $action"
        unless exists $_action_map{$action};

    $action = $_action_map{$action};
    my $alarm_class = "Data::ICal::Entry::Alarm::$action";
    eval "require $alarm_class";
    die "Failed to require $alarm_class : $@" if $@;

    $alarm_class->import;
    my $alarm = $alarm_class->new;
    $parent->_parse_generic_event( $alarm, $object );
    $parent->add_entry($alarm);
    return $alarm;
}

# generic event handler
sub _parse_data_ical_generic {
    my ( $parent, $class, $object ) = @_;

    my $entry_class = "Data::ICal::Entry::$class";
    eval "require $entry_class";
    die "Failed to require $entry_class : $@" if $@;

    $entry_class->import;
    my $entry = $entry_class->new;
    $entry->vcal10($parent->vcal10);
    $parent->_parse_generic_event( $entry, $object );
    $parent->add_entry($entry);
    return $entry;
}

# handle transferring of properties
sub _parse_generic_event {
    my ( $parent, $entry, $object ) = @_;

    my $p = $object->{properties};
    for my $key ( sort keys %$p ) {
        foreach my $occurence (@{ $p->{$key} }) {
            my $prop;