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