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