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