use warnings;
use strict;

package Data::ICal;
use base qw/Data::ICal::Entry/;

use Class::ReturnValue;
use Text::vFile::asData;

our $VERSION = '0.24';

use Carp;

=head1 NAME

Data::ICal - Generates iCalendar (RFC 2445) calendar files


    use Data::ICal;

    my $calendar = Data::ICal->new();

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

    # ... or
    $calendar = Data::ICal->new(filename => 'foo.ics'); # parse existing file
    $calendar = Data::ICal->new(data => 'BEGIN:VCALENDAR...'); # parse from scalar
    print $calendar->as_string;


A L<Data::ICal> object represents a C<VCALENDAR> object as defined in the
iCalendar protocol (RFC 2445, MIME type "text/calendar"), as implemented in many
popular calendaring programs such as Apple's iCal.

Each L<Data::ICal> object is a collection of "entries", which are objects of a
subclass of L<Data::ICal::Entry>.  The types of entries defined by iCalendar
(which refers to them as "components") include events, to-do items, journal
entries, free/busy time indicators, and time zone descriptors; in addition,
events and to-do items can contain alarm entries.  (Currently, L<Data::ICal>
only implements to-do items and events.)

L<Data::ICal> is a subclass of L<Data::ICal::Entry>; see its manpage for more
methods applicable to L<Data::ICal>.

=head1 METHODS


=head2 new [ data => $data, ] [ filename => $file ], [ calname => $string ], [ vcal10 => $bool ], [ rfc_strict => $bool ], [ auto_uid => $bool ]

Creates a new L<Data::ICal> object.

If it is given a filename or data argument is passed, then this parses the
content of the file or string into the object.  If the C<vcal10> flag is passed,
parses it according to vCalendar 1.0, not iCalendar 2.0; this in particular impacts
the parsing of continuation lines in quoted-printable sections.

If a calname is passed, sets x-wr-calname to the given string.  Although
not specified in RFC2445, most calendar software respects x-wr-calname
as the displayed name of the calendar.

If the C<rfc_strict> flag is set to true, will require Data::ICal to
include UIDs, as per RFC2445: Unique Identifier
    ... The property MUST be specified in the "VEVENT", "VTODO",
    "VJOURNAL" or "VFREEBUSY" calendar components"

If the C<auto_uid> flag is set to true, will automatically generate a
default UID for each type which requires it, based on the RFC-suggested
algorithm.  Explicitly-set UID attributes will override this
auto-generated value.

If a filename or data argument is not passed, this just sets the
object's C<VERSION> and C<PRODID> properties to "2.0" (or "1.0" if the
C<vcal10> flag is passed) and the value of the C<product_id> method

Returns a false value upon failure to open or parse the file or data; this false
value is a L<Class::ReturnValue> object and can be queried as to its


sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);

    my %args = (
        filename   => undef,
        calname    => undef,
        data       => undef,
        vcal10     => 0,
        rfc_strict => 0,
        auto_uid   => 0,

    $self->vcal10( $args{vcal10} );
    $self->rfc_strict( $args{rfc_strict} );
    $self->auto_uid( $args{auto_uid} );

    if ( defined $args{filename} or defined $args{data} ) {

        # might return a Class::ReturnValue if parsing fails
        return $self->parse(%args);
    } else {
            version => ( $self->vcal10 ? '1.0' : '2.0' ),
            prodid => $self->product_id,
        $self->add_property('x-wr-calname' => $args{calname})
            if defined $args{calname};

        return $self;

=head2 parse [ data => $data, ] [ filename => $file, ]

Parse a C<.ics> file or string containing one, and populate C<$self>
with its contents.

Should only be called once on a given object, and will be automatically
called by C<new> if you provide arguments to C<new>.

Returns C<$self> on success.  Returns a false value upon failure to
open or parse the file or data; this false value is a
L<Class::ReturnValue> object and can be queried as to its


sub parse {
    my $self = shift;
    my %args = (
        filename => undef,
        data     => undef,

    unless ( defined $args{filename} or defined $args{data} ) {
        return $self->_error(
            "parse called with no filename or data specified");

    my @lines;

    # open the file (checking as we go, like good little Perl mongers)
    if ( defined $args{filename} ) {
        open my $fh, '<', $args{filename}
            or return $self->_error("could not open '$args{filename}': $!");
        @lines = map { chomp; $_ } <$fh>;
    } else {
        @lines = split /\r?\n/, $args{data};

    @lines = $self->_vcal10_input_cleanup(@lines) if $self->vcal10;

    # Parse the lines; Text::vFile doesn't want trailing newlines
    my $cal = eval { Text::vFile::asData->new->parse_lines(@lines) };
    return $self->_error("parse failure: $@") if $@;

    return $self->_error("parse failure")
        unless $cal and exists $cal->{objects};

    # loop through all the vcards
    foreach my $object ( @{ $cal->{objects} } ) {

    my $version_ref = $self->property("version");
    my $version = $version_ref ? $version_ref->[0]->value : undef;
    unless ( defined $version ) {
        return $self->_error("data does not specify a version property");

    if (   $version eq '1.0' and not $self->vcal10
        or $version eq '2.0' and $self->vcal10 )
        return $self->_error( 'application claims data is'
                . ( $self->vcal10 ? '' : ' not' )
                . ' vCal 1.0 but doc contains VERSION:'
                . $version );

    return $self;

sub _error {
    my $self = shift;
    my $msg  = shift;

    my $ret = Class::ReturnValue->new;
    $ret->as_error( errno => 1, message => $msg );
    return $ret;

=head2 ical_entry_type

Returns C<VCALENDAR>, its iCalendar entry name.


sub ical_entry_type {'VCALENDAR'}

=head2 product_id

Returns the product ID used in the calendar's C<PRODID> property; you may
wish to override this in a subclass for your own application.


sub product_id {
    my $self = shift;
    return "Data::ICal $VERSION";

=head2 mandatory_unique_properties

According to the iCalendar standard, the following properties must be specified
exactly one time for a calendar:

      prodid version


sub mandatory_unique_properties {
        prodid version

=head2 optional_unique_properties

According to the iCalendar standard, the following properties may be specified
at most one time for a calendar:

      calscale method


sub optional_unique_properties {
        calscale method

# In quoted-printable sections, convert from vcal10 "=\n" line endings to
# ical20 "\n ".
sub _vcal10_input_cleanup {
    my $self     = shift;
    my @in_lines = @_;

    my @out_lines;

    my $in_qp = 0;
LINE: while (@in_lines) {
        my $line = shift @in_lines;

        if ( not $in_qp and $line =~ /^[^:]+;ENCODING=QUOTED-PRINTABLE/i ) {
            $in_qp = 1;

        unless ($in_qp) {
            push @out_lines, $line;
            next LINE;

        if ( $line =~ s/=$// ) {
            push @out_lines, $line;
            $in_lines[0] = ' ' . $in_lines[0] if @in_lines;
        } else {
            push @out_lines, $line;
            $in_qp = 0;

    return @out_lines;


L<Data::ICal> requires L<Class::Accessor>, L<Text::vFile::asData>,
L<MIME::QuotedPrint>, and L<Class::ReturnValue>.


L<Data::ICal> does not support time zone daylight or standard entries,
so time zone components are basically useless.

While L<Data::ICal> tries to check which properties are required and
repeatable, this only works in simple cases; it does not check for
properties that must either both exist or both not exist, or for
mutually exclusive properties.

L<Data::ICal> does not check to see if property parameter names are
known in general or allowed on the particular property.

L<Data::ICal> does not check to see if nested entries are nested
properly (alarms in todos and events only, everything else in
calendars only).

The only property encoding supported by L<Data::ICal> is quoted

Please report any bugs or feature requests to
C<>, or through the web interface at

=head1 AUTHOR

Best Practical Solutions, LLC E<lt>modules@bestpractical.comE<gt>


Copyright (c) 2005 - 2020, Best Practical Solutions, LLC.  All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.