DateTime::Format::ICal - Parse and format iCal datetime and duration strings

DateTime-Format-ICal documentation Contained in the DateTime-Format-ICal distribution.

Index

Code Index:

NAME

Top

DateTime::Format::ICal - Parse and format iCal datetime and duration strings

SYNOPSIS

Top

  use DateTime::Format::ICal;

  my $dt = DateTime::Format::ICal->parse_datetime( '20030117T032900Z' );

  my $dur = DateTime::Format::ICal->parse_duration( '+P3WT4H55S' );

  # 20030117T032900Z
  DateTime::Format::ICal->format_datetime($dt);

  # +P3WT4H55S
  DateTime::Format::ICal->format_duration($dur);

DESCRIPTION

Top

This module understands the ICal date/time and duration formats, as defined in RFC 2445. It can be used to parse these formats in order to create the appropriate objects.

METHODS

Top

This class offers the following methods.

* parse_datetime($string)

Given an iCal datetime string, this method will return a new DateTime object.

If given an improperly formatted string, this method may die.

* parse_duration($string)

Given an iCal duration string, this method will return a new DateTime::Duration object.

If given an improperly formatted string, this method may die.

* parse_period($string)

Given an iCal period string, this method will return a new DateTime::Span object.

If given an improperly formatted string, this method may die.

* parse_recurrence( recurrence => $string, ... )

Given an iCal recurrence description, this method uses DateTime::Event::ICal to create a DateTime::Set object representing that recurrence. Any parameters given to this method beside "recurrence" will be passed directly to the DateTime::Event::ICal->recur method.

If given an improperly formatted string, this method may die.

This method accepts optional parameters "dtstart" and "dtend". These parameters must be DateTime objects.

The iCal spec requires that "dtstart" always be included in the recurrence set, unless this is an "exrule" statement. Since we don't know what kind of statement is being parsed, we do not include dtstart in the recurrence set.

* format_datetime($datetime)

Given a DateTime object, this methods returns an iCal datetime string.

The iCal spec requires that datetimes be formatted either as floating times (no time zone), UTC (with a 'Z' suffix) or with a time zone id at the beginning ('TZID=America/Chicago;...'). If this method is asked to format a DateTime object that has an offset-only time zone, then the object will be converted to the UTC time zone internally before formatting.

For example, this code:

    my $dt = DateTime->new( year => 1900, hour => 15, time_zone => '-0100' );

    print $ical->format_datetime($dt);

will print the string "19000101T160000Z".

* format_duration($duration)

Given a DateTime::Duration object, this methods returns an iCal duration string.

The iCal standard does not allow for months or years in a duration, so if a duration for which delta_months() is not zero is given, then this method will die.

* format_period($span)

Given a DateTime::Span object, this methods returns an iCal period string, using the format DateTime/DateTime.

* format_period_with_duration($span)

Given a DateTime::Span object, this methods returns an iCal period string, using the format DateTime/Duration.

* format_recurrence($arg [,$arg...] )

This method returns a list of strings containing ICal statements. In scalar context it returns a single string which may contain embedded newlines.

The argument can be a DateTime list, a DateTime::Span list, a DateTime::Set, or a DateTime::SpanSet.

ICal DATE values are not supported. Whenever a date value is found, a DATE-TIME is generated.

If a recurrence has an associated DTSTART or DTEND, those values must be formatted using format_datetime(). The format_recurrence() method will not do this for you.

If a union or complement of recurrences is being formatted, they are assumed to have the same DTSTART value.

Only union and complement operations are supported for recurrences. This is a limitation of the ICal specification.

If given a set it cannot format, this method may die.

Only DateTime::Set::ICal objects are formattable. A set may change class after some set operations:

    $recurrence = $recurrence->union( $dt_set );
    # Ok - $recurrence still is a DT::Set::ICal

    $recurrence = $dt_set->union( $recurrence );
    # Not Ok! - $recurrence is a DT::Set now

The only unbounded recurrences currently supported are the ones generated by the DateTime::Event::ICal module.

You can add ICal formatting support to a custom recurrence by using the DateTime::Set::ICal module:

    $custom_recurrence =
        DateTime::Set::ICal->from_recurrence
            ( recurrence =>
              sub { $_[0]->truncate( to => 'month' )->add( months => 1 ) }
            );
    $custom_recurrence->set_ical( include => [ 'FREQ=MONTHLY' ] );

SUPPORT

Top

Support for this module is provided via the datetime@perl.org email list. See http://lists.perl.org/ for more details.

AUTHORS

Top

Dave Rolsky <autarch@urth.org> and Flavio Soibelmann Glock <fglock@pucrs.br>

Some of the code in this module comes from Rich Bowen's Date::ICal module.

COPYRIGHT

Top

Copyright (c) 2003 David Rolsky. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

SEE ALSO

Top

datetime@perl.org mailing list

http://datetime.perl.org/

DateTime-Format-ICal documentation Contained in the DateTime-Format-ICal distribution. 
package DateTime::Format::ICal;

use strict;

use vars qw ($VERSION);

$VERSION = '0.09';

use DateTime;
use DateTime::Span;
use DateTime::Event::ICal;

use Params::Validate qw( validate_with SCALAR );

sub new
{
    my $class = shift;

    return bless {}, $class;
}

# key is string length
my %valid_formats =
    ( 15 =>
      { params => [ qw( year month day hour minute second ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)$/,
      },
      13 =>
      { params => [ qw( year month day hour minute ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)$/,
      },
      11 =>
      { params => [ qw( year month day hour ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)$/,
      },
      8 =>
      { params => [ qw( year month day ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)$/,
      },
    );

sub parse_datetime
{
    my ( $self, $date ) = @_;

    # save for error messages
    my $original = $date;

    my %p;
    if ( $date =~ s/^TZID=([^:]+):// )
    {
        $p{time_zone} = $1;
    }
    # Z at end means UTC
    elsif ( $date =~ s/Z$// )
    {
        $p{time_zone} = 'UTC';
    }
    else
    {
        $p{time_zone} = 'floating';
    }

    my $format = $valid_formats{ length $date }
        or die "Invalid iCal datetime string ($original)\n";

    @p{ @{ $format->{params} } } = $date =~ /$format->{regex}/;

    return DateTime->new(%p);
}

sub parse_duration
{
    my ( $self, $dur ) = @_;

    my @units = qw( weeks days hours minutes seconds );

    $dur =~ m{ ([\+\-])?         # Sign
                              P                 # 'P' for period? This is our magic character)
                              (?:
                                      (?:(\d+)W)?   # Weeks
                                      (?:(\d+)D)?   # Days
                              )?
                              (?: T             # Time prefix
                                      (?:(\d+)H)?   # Hours
                                      (?:(\d+)M)?   # Minutes
                                      (?:(\d+)S)?   # Seconds
                              )?
                          }x;

    my $sign = $1;

    my %units;
    $units{weeks}   = $2 if defined $2;
    $units{days}    = $3 if defined $3;
    $units{hours}   = $4 if defined $4;
    $units{minutes} = $5 if defined $5;
    $units{seconds} = $6 if defined $6;

    die "Invalid ICal duration string ($dur)\n"
        unless %units;

    if ( defined $sign && $sign eq '-' )
    {
        # $_ *= -1 foreach values %units;  - does not work in 5.00503
        $units{$_} *= -1 foreach keys %units;
    }

    return DateTime::Duration->new(%units);
}

sub parse_period
{
    my ( $self, $period ) = @_;

    my ( $start, $end ) = $period =~ /^((?:TZID=[^:]+:)?.*?)\/(.*)/;

    die "Invalid ICal period string ($period)\n"
        unless $start && $end;

    $start = $self->parse_datetime( $start );

    if ( $end =~ /[\+\-]P/i ) {
        $end = $start + $self->parse_duration( $end );
    }
    else
    {
        $end = $self->parse_datetime( $end );
    }

    die "Invalid ICal period: end before start ($period)\n"
        if $start > $end;

    return DateTime::Span->new( start => $start, end => $end );
}

sub parse_recurrence
{
    my $self = shift;
    my %p = validate_with( params => \@_,
                           spec   => { recurrence => { type => SCALAR } },
                           allow_extra => 1,
                         );

    my $recurrence = delete $p{recurrence};

    # recurrence may start with RRULE:
    $recurrence =~ s/^(?:RRULE|EXRULE)://i;

    # parser: adapted from code written for Date::Set by jesse
    # RRULEs look like 'FREQ=foo;INTERVAL=bar;' etc.
    foreach ( split /;/, $recurrence )
    {
        my ( $name, $value ) = split /=/;

        $name  = lc $name;

        # BY<FOO> parameters should be arrays. everything else should be strings
        if ( $name eq 'until' )
        {
            $p{$name} = __PACKAGE__->parse_datetime( $value );
        }
        elsif ( $name =~ /^by/i )
        {
            $p{$name} = [ split /,/, lc( $value ) ];
        }
        else
        {
            $p{$name} = lc( $value );
        }
    }

    return DateTime::Event::ICal->recur(%p);
}

sub format_datetime
{
    my ( $self, $dt ) = @_;

    my $tz = $dt->time_zone;

    unless ( $tz->is_floating ||
             $tz->is_utc ||
             $tz->is_olson )
    {
        $dt = $dt->clone->set_time_zone('UTC');
        $tz = $dt->time_zone;
    }

    my $base =
        sprintf( '%04d%02d%02dT%02d%02d%02d',
                 $dt->year, $dt->month, $dt->day,
                 $dt->hour, $dt->minute, $dt->second );

    return $base if $tz->is_floating;

    return $base . 'Z' if $tz->is_utc;

    return 'TZID=' . $tz->name . ':' . $base;
}

sub format_duration
{
    my ( $self, $duration ) = @_;

    die "Cannot represent years or months in an iCal duration\n"
        if $duration->delta_months;

    # simple string for 0-length durations
    return '+PT0S'
        unless $duration->delta_days ||
               $duration->delta_minutes ||
               $duration->delta_seconds;

    my $ical = $duration->is_positive ? '+' : '-';
    $ical .= 'P';

    if ( $duration->delta_days )
    {
        $ical .= $duration->weeks . 'W' if $duration->weeks;
        $ical .= $duration->days  . 'D' if $duration->days;
    }

    if ( $duration->delta_minutes || $duration->delta_seconds )
    {
        $ical .= 'T';

        $ical .= $duration->hours   . 'H' if $duration->hours;
        $ical .= $duration->minutes . 'M' if $duration->minutes;
        $ical .= $duration->seconds . 'S' if $duration->seconds;
    }

    return $ical;
}


sub format_period
{
    my ( $self, $span ) = @_;

    return $self->format_datetime( $span->start ) . '/' .
           $self->format_datetime( $span->end ) ;
}

sub format_period_with_duration
{
    my ( $self, $span ) = @_;

    return $self->format_datetime( $span->start ) . '/' .
           $self->format_duration( $span->duration ) ;
}


sub _split_datetime_tz 
{
    my ( $self, $dt ) = @_;

    my $tz = $dt->time_zone;

    unless ( $tz->is_floating ||
             $tz->is_utc ||
             $tz->is_olson )
    {
        $dt = $dt->clone->set_time_zone('UTC');
        $tz = $dt->time_zone;
    }

    my $base =
        ( $dt->hour || $dt->min || $dt->sec ?
          sprintf( '%04d%02d%02dT%02d%02d%02d',
                   $dt->year, $dt->month, $dt->day,
                   $dt->hour, $dt->minute, $dt->second ) :
          sprintf( '%04d%02d%02d', $dt->year, $dt->month, $dt->day )
        );

    return ($base, '')    if $tz->is_floating;
    return ($base, 'UTC') if $tz->is_utc;
    return ($base, $tz->name);
}

sub format_recurrence
{
    my ( $self, $set, @more ) = @_;
    my @result;

    # normalize param to either DT::Set or DT::SpanSet
    # DT list =>       convert to DT::Set
    # DT::Span list => convert to DT::SpanSet

    if ( $set->isa('DateTime') )
    {
        $set = DateTime::Set->from_datetimes( dates => [ $set, @more ] );
    }
    elsif ( $set->isa('DateTime::Span') )
    {
        $set = DateTime::SpanSet->from_spans( spans => [ $set, @more ] );
    }

    # is it a recurrence?
    if ( $set->{set}->is_too_complex )
    {
        # DT::Set recurrence => DTSTART;timezone:date CRLF
        #                       RRULE:params CRLF
        #   note: add more lines if necessary:
        #             union =        more RRULE/RDATE lines
        #             complement =   more EXRULE/EXDATE lines
        #             intersection = ?
        #   note: timezone is specified by DTSTART only.

        # TODO: add support to DT::Event::Recurrence objects

        if ( $set->can( 'get_ical' ) && defined $set->get_ical )
        {
            my %ical = $set->get_ical;
            for ( @{ $ical{include} } )
            {
                next unless $_;
                if ( ref( $_ ) )
                {
                    push @result, $self->format_recurrence( $_ );
                }
                else
                {
                    push @result, $_;
                }
            }
            if ( $ical{exclude} )
            {
                my @exclude;
                for ( @{ $ical{exclude} } )
                {
                    next unless $_;
                    if ( ref( $_ ) )
                    {
			push @exclude, $self->format_recurrence( $_ );
                    }
                    else
                    {
			push @exclude, $_;
                    }
                }
                s/^RDATE/EXDATE/ for @exclude;
                s/^RRULE/EXRULE/ for @exclude;
                push @result, @exclude;
            }
        }
        else
        {
            die "format_recurrence() - Format not implemented for this unbounded set";
        }

        # end: format recurrence
    }
    else
    {
        # DT::Set  =>        RDATE:datetime,datetime,datetime CRLF
        # DT::SpanSet =>     RDATE;VALUE=PERIOD:period,period CRLF
        #
        # not supported =>   RDATE;VALUE=DATE:date,date,date CRLF
        #
        # DT::Set w/tz =>     RDATE;timezone:date,date CRLF
        # DT::SpanSet w/tz => RDATE;VALUE=PERIOD;timezone:period,period CRLF

        my $iterator = $set->iterator;
        my $last_type = 'DateTime';
        my $last_tz =   'invalid';
        my $item;

        while( $item = $iterator->next )
        {
            if( $item->isa('DateTime') )
            {
                my ($base,$tz) = $self->_split_datetime_tz( $item );
                if( $last_tz eq $tz &&
                    $last_type eq 'DateTime' )
                {
                    $result[-1] .= ',' . $base;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                }
                else
                {
                    push @result, 'RDATE';
                    $result[-1] .= ';TZID='.$tz if $tz ne '' && $tz ne 'UTC';
                    $result[-1] .= ':' . $base;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                    $last_tz =   $tz;
                    $last_type = 'DateTime';
                }
            }
            elsif( $item->isa('DateTime::Span') )
            {
                my $item_start = $item->start;
                my $item_end =   $item->end;
                if ( $item_start == $item_end )
                {
                    $item = $item_start;
                    # item looks like a datetime
                    redo;
                }
                my ($start,$tz) = $self->_split_datetime_tz( $item_start );
                $item_end->set_time_zone( $tz );
                my ($end,undef) = $self->_split_datetime_tz( $item_end );
                if( $last_tz eq $tz &&
                    $last_type eq 'DateTime::Span' )
                {
                    $result[-1] .= ',' . $start;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                    $result[-1] .= '/' . $end;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                }
                else
                {
                    push @result, 'RDATE;VALUE=PERIOD';
                    $result[-1] .= ';TZID='.$tz if $tz ne '' && $tz ne 'UTC';
                    $result[-1] .= ':' . $start;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                    $result[-1] .= '/' . $end;
                    $result[-1] .= 'Z' if $tz eq 'UTC';
                    $last_tz =   $tz;
                    $last_type = 'DateTime::Span';
                }
            }
            else
            {
                die 'unexpected data type "'.ref($item).'" in set';
            }
        }

        # end: format list of dates
    }
    return join( "\n", @result ) if ! wantarray;
    return @result;
}

1;

__END__