1# we need to comment this out or PAUSE might index it 2# pack age DateTime::Format::W3CDTF; 3 4use strict; 5 6use DateTime::Format::Builder ( 7 parsers => { 8 parse_datetime => [ 9 [ preprocess => \&_parse_tz ], 10 { 11 params => [qw( year month day hour minute second)], 12 regex => 13 qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)\.(\d\d)$/, 14 length => 22, 15 }, 16 { 17 params => [qw( year month day hour minute second)], 18 regex => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/, 19 length => 19, 20 }, 21 { 22 params => [qw( year month day hour minute)], 23 regex => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d)$/, 24 length => 16, 25 }, 26 { 27 params => [qw( year month day )], 28 regex => qr/^(\d{4})-(\d\d)-(\d\d)$/, 29 length => 10, 30 }, 31 { 32 params => [qw( year month )], 33 regex => qr/^(\d{4})-(\d\d)$/, 34 length => 7, 35 extra => { day => 1 }, 36 }, 37 { 38 params => [qw( year )], 39 regex => qr/^(\d\d\d\d)$/, 40 length => 4, 41 extra => { month => 1, day => 1 } 42 } 43 ] 44 } 45); 46 47sub _parse_tz { 48 my %args = @_; 49 my ( $date, $p ) = @args{qw( input parsed )}; 50 if ( $date =~ s/([+-]\d\d:\d\d)$// ) { 51 $p->{time_zone} = $1; 52 } 53 54 # Z at end means UTC 55 elsif ( $date =~ s/Z$// ) { 56 $p->{time_zone} = 'UTC'; 57 } 58 else { 59 $p->{time_zone} = 'floating'; 60 } 61 return $date; 62} 63 64sub format_datetime { 65 my ( $self, $dt ) = @_; 66 67 my $base = ( 68 $dt->hour || $dt->min || $dt->sec 69 ? sprintf( 70 '%04d-%02d-%02dT%02d:%02d:%02d', 71 $dt->year, $dt->month, $dt->day, 72 $dt->hour, $dt->minute, $dt->second 73 ) 74 : sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day ) 75 ); 76 77 my $tz = $dt->time_zone; 78 79 return $base if $tz->is_floating; 80 81 # if there is a time component 82 if ( $dt->hour || $dt->min || $dt->sec ) { 83 return $base . 'Z' if $tz->is_utc; 84 85 if ( $tz->{'offset'} ) { 86 return $base . offset_as_string( $tz->{'offset'} ); 87 } 88 } 89 else { 90 return $base; 91 } 92} 93 94# minor offset_as_string variant w/ : 95# 96sub offset_as_string { 97 my $offset = shift; 98 99 return undef unless defined $offset; 100 101 my $sign = $offset < 0 ? '-' : '+'; 102 103 my $hours = $offset / ( 60 * 60 ); 104 $hours = abs($hours) % 24; 105 106 my $mins = ( $offset % ( 60 * 60 ) ) / 60; 107 108 my $secs = $offset % 60; 109 110 return ( 111 $secs 112 ? sprintf( '%s%02d:%02d:%02d', $sign, $hours, $mins, $secs ) 113 : sprintf( '%s%02d:%02d', $sign, $hours, $mins ) 114 ); 115} 116 1171; 118 119__END__ 120 121=head1 NAME 122 123DateTime::Format::W3CDTF - Parse and format W3CDTF datetime strings 124 125=head1 SYNOPSIS 126 127 use DateTime::Format::W3CDTF; 128 129 my $f = DateTime::Format::W3CDTF->new; 130 my $dt = $f->parse_datetime( '2003-02-15T13:50:05-05:00' ); 131 132 # 2003-02-15T13:50:05-05:00 133 $f->format_datetime($dt); 134 135=head1 DESCRIPTION 136 137This module understands the W3CDTF date/time format, an ISO 8601 profile, 138defined at http://www.w3.org/TR/NOTE-datetime. This format as the native 139date format of RSS 1.0. 140 141It can be used to parse these formats in order to create the appropriate 142objects. 143 144=head1 METHODS 145 146This API is currently experimental and may change in the future. 147 148=over 4 149 150=item * parse_datetime($string) 151 152Given a W3CDTF datetime string, this method will return a new 153C<DateTime> object. 154 155If given an improperly formatted string, this method may die. 156 157=item * format_datetime($datetime) 158 159Given a C<DateTime> object, this methods returns a W3CDTF datetime 160string. 161 162=back 163 164=head1 SUPPORT 165 166Support for this module is provided via the datetime@perl.org email 167list. See http://lists.perl.org/ for more details. 168 169=head1 AUTHOR 170 171Kellan Elliott-McCrea <kellan@protest.net> 172 173This module was inspired by C<DateTime::Format::ICal> 174 175=head1 COPYRIGHT 176 177Copyright (c) 2003 Kellan Elliott-McCrea. All rights reserved. This program 178is free software; you can redistribute it and/or modify it under the 179same terms as Perl itself. 180 181The full text of the license can be found in the LICENSE file included 182with this module. 183 184=head1 SEE ALSO 185 186datetime@perl.org mailing list 187 188http://datetime.perl.org/ 189 190=cut 191