1package DateTime::Format::ICal;
2
3use strict;
4
5use vars qw ($VERSION);
6
7$VERSION = '0.03';
8
9use DateTime;
10
11# Builder relevant stuff starts here.
12
13use DateTime::Format::Builder
14    parsers => {
15	parse_datetime => [
16	[ preprocess => \&_parse_tz ],
17	{
18	    length => 15,
19	    params => [ qw( year month day hour minute second ) ],
20	    regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)$/,
21	},
22	{
23	    length => 13,
24	    params => [ qw( year month day hour minute ) ],
25	    regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)$/,
26	},
27	{
28	    length => 11,
29	    params => [ qw( year month day hour ) ],
30	    regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)$/,
31	},
32	{
33	    length => 8,
34	    params => [ qw( year month day ) ],
35	    regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)$/,
36	},
37	],
38    };
39
40sub _parse_tz
41{
42    my %args = @_;
43    my ($date, $p) = @args{qw( input parsed )};
44    if ( $date =~ s/^TZID=([^:]+):// )
45    {
46	$p->{time_zone} = $1;
47    }
48    # Z at end means UTC
49    elsif ( $date =~ s/Z$// )
50    {
51	$p->{time_zone} = 'UTC';
52    }
53    else
54    {
55	$p->{time_zone} = 'floating';
56    }
57    return $date;
58}
59
60# Builder relevant stuff ends here.
61
62sub parse_duration
63{
64    my ( $self, $dur ) = @_;
65
66    my @units = qw( weeks days hours minutes seconds );
67
68    $dur =~ m{ ([\+\-])?         # Sign
69               P                 # 'P' for period? This is our magic character)
70               (?:
71                   (?:(\d+)W)?   # Weeks
72                   (?:(\d+)D)?   # Days
73               )?
74               (?: T             # Time prefix
75                   (?:(\d+)H)?   # Hours
76                   (?:(\d+)M)?   # Minutes
77                   (?:(\d+)S)?   # Seconds
78               )?
79             }x;
80
81    my $sign = $1;
82
83    my %units;
84    $units{weeks}   = $2 if defined $2;
85    $units{days}    = $3 if defined $3;
86    $units{hours}   = $4 if defined $4;
87    $units{minutes} = $5 if defined $5;
88    $units{seconds} = $6 if defined $6;
89
90    die "Invalid ICal duration string ($dur)\n"
91        unless %units;
92
93    if ( $sign eq '-' )
94    {
95        $_ *= -1 foreach values %units;
96    }
97
98    return DateTime::Duration->new(%units);
99}
100
101sub format_datetime
102{
103    my ( $self, $dt ) = @_;
104
105    my $tz = $dt->time_zone;
106
107    unless ( $tz->is_floating || $tz->is_utc || $tz->name )
108    {
109        $dt = $dt->clone->set_time_zone('UTC');
110        $tz = $dt->time_zone;
111    }
112
113    my $base =
114        ( $dt->hour || $dt->min || $dt->sec ?
115          sprintf( '%04d%02d%02dT%02d%02d%02d',
116                   $dt->year, $dt->month, $dt->day,
117                   $dt->hour, $dt->minute, $dt->second ) :
118          sprintf( '%04d%02d%02d', $dt->year, $dt->month, $dt->day )
119        );
120
121
122    return $base if $tz->is_floating;
123
124    return $base . 'Z' if $tz->is_utc;
125
126    return 'TZID=' . $tz->name . ':' . $base;
127}
128
129sub format_duration
130{
131    my ( $self, $duration ) = @_;
132
133    die "Cannot represent years or months in an iCal duration\n"
134        if $duration->delta_months;
135
136    # simple string for 0-length durations
137    return '+PT0S'
138        unless $duration->delta_days || $duration->delta_seconds;
139
140    my $ical = $duration->is_positive ? '+' : '-';
141    $ical .= 'P';
142
143    if ( $duration->delta_days )
144    {
145        $ical .= $duration->weeks . 'W' if $duration->weeks;
146        $ical .= $duration->days  . 'D' if $duration->days;
147    }
148
149    if ( $duration->delta_seconds )
150    {
151        $ical .= 'T';
152
153        $ical .= $duration->hours   . 'H' if $duration->hours;
154        $ical .= $duration->minutes . 'M' if $duration->minutes;
155        $ical .= $duration->seconds . 'S' if $duration->seconds;
156    }
157
158    return $ical;
159}
160
161
1621;
163