1package DateTime::Format::W3CDTF; 2 3use strict; 4use warnings; 5 6use vars qw ($VERSION); 7 8$VERSION = '0.06'; 9 10use DateTime; 11use DateTime::TimeZone; 12 13sub new { 14 my $class = shift; 15 16 return bless {}, $class; 17} 18 19sub parse_datetime { 20 my ( $self, $date ) = @_; 21 22 my @fields = qw/ year month day hour minute second fraction time_zone /; 23 my @values = 24 ( $date =~ /^(\d\d\d\d) # Year 25 (?:-(\d\d) # -Month 26 (?:-(\d\d) # -Day 27 (?:T 28 (\d\d):(\d\d) # Hour:Minute 29 (?: 30 :(\d\d) # :Second 31 (\.\d+)? # .Fractional_Second 32 )? 33 ( Z # UTC 34 | [+-]\d\d:\d\d # Hour:Minute TZ offset 35 (?::\d\d)? # :Second TZ offset 36 )?)?)?)?$/x ) 37 or die "Invalid W3CDTF datetime string ($date)"; 38 my %p; 39 for ( my $i=0; $i < @values; $i++ ) { # Oh how I wish Perl had zip 40 next unless defined $values[$i]; 41 $p{$fields[$i]} = $values[$i]; 42 } 43 44### support for YYYY-MM-DDT24:00:00 as a syntactic form for 00:00:00 on the day following YYYY-MM-DD 45### this is allowed in xsd dateTime syntactic forms, but not W3CDTF. 46# my $next_day = 0; 47# if (defined($p{hour}) and defined($p{minute}) and defined($p{second})) { 48# if ($p{hour} eq '24') { 49# if ($p{second} eq '00' and $p{minute} eq '00') { 50# $p{hour} = '00'; 51# $next_day++; 52# } else { 53# die "Cannot use hour value '24' with non-zero minutes and seconds\n"; 54# } 55# } 56# } 57 58 if ( !$p{time_zone} ) { 59 $p{time_zone} = 'floating'; 60 } elsif ( $p{time_zone} eq 'Z' ) { 61 $p{time_zone} = 'UTC'; 62 } 63 64 if ( $p{fraction} ) { 65 $p{nanosecond} = $p{fraction} * 1_000_000_000; 66 delete $p{fraction} 67 } 68 69 my $dt = DateTime->new( %p ); 70# if ($next_day) { 71# $dt->add( day => 1 ); 72# } 73 return $dt; 74} 75 76sub format_datetime { 77 my ( $self, $dt ) = @_; 78 79 my $base = sprintf( 80 '%04d-%02d-%02dT%02d:%02d:%02d', 81 $dt->year, $dt->month, $dt->day, 82 $dt->hour, $dt->minute, $dt->second 83 ); 84 85 if ( $dt->nanosecond ) { 86 my $secs = sprintf "%f", $dt->nanosecond / 1_000_000_000; 87 $secs =~ s/^0//; 88 $base .= $secs; 89 } 90 91 my $tz = $dt->time_zone; 92 93 return $base if $tz->is_floating; 94 95 return $base . 'Z' if $tz->is_utc; 96 97 my $offset = $dt->offset(); 98 99 return $base unless defined $offset; 100 101 return $base . _offset_as_string($offset) 102} 103 104sub format_date { 105 my ( $self, $dt ) = @_; 106 107 my $base = sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day ); 108 return $base; 109} 110 111# minor offset_as_string variant w/ : 112# 113sub _offset_as_string { 114 my $offset = shift; 115 116 return undef unless defined $offset; 117 118 my $sign = $offset < 0 ? '-' : '+'; 119 120 my $hours = $offset / ( 60 * 60 ); 121 $hours = abs($hours) % 24; 122 123 my $mins = ( $offset % ( 60 * 60 ) ) / 60; 124 125 my $secs = $offset % 60; 126 127 return ( 128 $secs 129 ? sprintf( '%s%02d:%02d:%02d', $sign, $hours, $mins, $secs ) 130 : sprintf( '%s%02d:%02d', $sign, $hours, $mins ) 131 ); 132} 133 1341; 135 136__END__ 137 138=head1 NAME 139 140DateTime::Format::W3CDTF - Parse and format W3CDTF datetime strings 141 142=head1 SYNOPSIS 143 144 use DateTime::Format::W3CDTF; 145 146 my $w3c = DateTime::Format::W3CDTF->new; 147 my $dt = $w3c->parse_datetime( '2003-02-15T13:50:05-05:00' ); 148 149 # 2003-02-15T13:50:05-05:00 150 $w3c->format_datetime($dt); 151 152=head1 DESCRIPTION 153 154This module understands the W3CDTF date/time format, an ISO 8601 profile, 155defined at http://www.w3.org/TR/NOTE-datetime. This format as the native 156date format of RSS 1.0. 157 158It can be used to parse these formats in order to create the appropriate 159objects. 160 161=head1 METHODS 162 163This API is currently experimental and may change in the future. 164 165=over 4 166 167=item * new() 168 169Returns a new W3CDTF parser object. 170 171=item * parse_datetime($string) 172 173Given a W3CDTF datetime string, this method will return a new 174C<DateTime> object. 175 176If given an improperly formatted string, this method may die. 177 178=item * format_datetime($datetime) 179 180Given a C<DateTime> object, this methods returns a W3CDTF datetime 181string. 182 183NOTE: As of version 0.4, format_datetime no longer attempts to truncate 184datetimes without a time component. This is due to the fact that C<DateTime> 185doesn't distinguish between a date with no time component, and midnight. 186 187=item * format_date($datetime) 188 189Given a C<DateTime> object, return a W3CDTF datetime string without the time component. 190 191=back 192 193=head1 SUPPORT 194 195Support for this module is provided via the datetime@perl.org email 196list. See http://datetime.perl.org/?MailingList for details. 197 198Please submit bugs to the CPAN RT system at 199http://rt.cpan.org/NoAuth/ReportBug.html?Queue=datetime-format-w3cdtf or via 200email at bug-datetime-format-w3cdtf@rt.cpan.org. 201 202=head1 AUTHOR 203 204Dave Rolsky E<lt>autarch@urth.orgE<gt> 205 206=head1 CREDITS 207 208This module is maintained by Gregory Todd Williams E<lt>gwilliams@cpan.orgE<gt>. 209It was originally created by Kellan Elliott-McCrea E<lt>kellan@protest.netE<gt>. 210 211This module was inspired by L<DateTime::Format::ICal> 212 213=head1 COPYRIGHT 214 215Copyright (c) 2009 David Rolsky. All rights reserved. This 216program is free software; you can redistribute it and/or modify it 217under the same terms as Perl itself. 218 219Copyright (c) 2003 Kellan Elliott-McCrea 220 221Portions of the code in this distribution are derived from other 222works. Please see the CREDITS file for more details. 223 224The full text of the license can be found in the LICENSE file included 225with this module. 226 227=head1 SEE ALSO 228 229datetime@perl.org mailing list 230 231http://datetime.perl.org/ 232 233=cut 234