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