package DateTime::Format::W3CDTF;
use strict;
use vars qw ($VERSION);
$VERSION = '0.04';
use DateTime;
sub new
{
my $class = shift;
return bless {}, $class;
}
my %valid_formats =
( 19 =>
{ params => [ qw( year month day hour minute second) ],
regex => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/,
zero => {},
},
16 =>
{ params => [ qw( year month day hour minute) ],
regex => qr/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d)$/,
zero => { second => 0 },
},
10 =>
{ params => [ qw( year month day ) ],
regex => qr/^(\d{4})-(\d\d)-(\d\d)$/,
zero => { hour => 0, minute => 0, second => 0 },
},
7 =>
{ params => [ qw( year month ) ],
regex => qr/^(\d{4})-(\d\d)$/,
zero => { day => 1, hour => 0, minute => 0, second => 0 },
},
4 =>
{ params => [ qw( year ) ],
regex => qr/^(\d\d\d\d)$/,
zero => { month => 1, day => 1, hour => 0, minute => 0, second => 0 }
}
);
sub parse_datetime
{
my ( $self, $date ) = @_;
my $original = $date;
my %p;
if ( $date =~ s/([+-]\d\d:\d\d)$// )
{
$p{time_zone} = $1;
}
elsif ( $date =~ s/Z$// )
{
$p{time_zone} = 'UTC';
}
else
{
$p{time_zone} = 'floating';
}
my $format = $valid_formats{ length $date }
or die "Invalid W3CDTF datetime string ($original)";
@p{ @{ $format->{params} } } = $date =~ /$format->{regex}/;
return DateTime->new( %p, %{ $format->{zero} } );
}
sub format_datetime
{
my ( $self, $dt ) = @_;
my $base = sprintf( '%04d-%02d-%02dT%02d:%02d:%02d',
$dt->year, $dt->month, $dt->day,
$dt->hour, $dt->minute, $dt->second );
my $tz = $dt->time_zone;
return $base if $tz->is_floating;
return $base . 'Z' if $tz->is_utc;
if (my $offset = $dt->offset()) {
return $base . offset_as_string($offset );
}
}
sub format_date
{
my ( $self, $dt ) = @_;
my $base = sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day );
return $base;
}
sub offset_as_string
{
my $offset = shift;
return undef unless defined $offset;
my $sign = $offset < 0 ? '-' : '+';
my $hours = $offset / ( 60 * 60 );
$hours = abs($hours) % 24;
my $mins = ( $offset % ( 60 * 60 ) ) / 60;
my $secs = $offset % 60;
return ( $secs ?
sprintf( '%s%02d:%02d:%02d', $sign, $hours, $mins, $secs ) :
sprintf( '%s%02d:%02d', $sign, $hours, $mins )
);
}
1;
__END__
=head1 NAME
DateTime::Format::W3CDTF - Parse and format W3CDTF datetime strings
=head1 SYNOPSIS
use DateTime::Format::W3CDTF;
my $f = DateTime::Format::W3CDTF->new;
my $dt = $f->parse_datetime( '2003-02-15T13:50:05-05:00' );
# 2003-02-15T13:50:05-05:00
$f->format_datetime($dt);
=head1 DESCRIPTION
This module understands the W3CDTF date/time format, an ISO 8601 profile,
defined at http://www.w3.org/TR/NOTE-datetime. This format as the native
date format of RSS 1.0.
It can be used to parse these formats in order to create the appropriate
objects.
=head1 METHODS
This API is currently experimental and may change in the future.
=over 4
=item * parse_datetime($string)
Given a W3CDTF datetime string, this method will return a new
C<DateTime> object.
If given an improperly formatted string, this method may die.
=item * format_datetime($datetime)
Given a C<DateTime> object, this methods returns a W3CDTF datetime
string.
NOTE: As of version 0.4, format_datetime no longer attempts to truncate
datetimes without a time component. This is due to the fact that C<DateTime>
doesn't distinguish between a date with no time component, and midnight.
=item * format_date($datetime)
Given a C<DateTime> object, return a W3CDTF datetime string without the time component.
=back
=head1 SUPPORT
Support for this module is provided via the datetime@perl.org email
list. See http://lists.perl.org/ for more details.
=head1 AUTHOR
Kellan Elliott-McCrea <kellan@protest.net>
This module was inspired by C<DateTime::Format::ICal>
=head1 COPYRIGHT
Copyright (c) 2003 Kellan Elliott-McCrea. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
The full text of the license can be found in the LICENSE file included
with this module.
=head1 SEE ALSO
datetime@perl.org mailing list
http://datetime.perl.org/
=cut