Add built local::lib

[catagits/Gitalist.git] / local-lib5 / lib / perl5 / DateTime / Format / W3CDTF.pm

package DateTime::Format::W3CDTF;

use strict;

use vars qw ($VERSION);

$VERSION = '0.05';

use DateTime;

sub new {
    my $class = shift;

    return bless {}, $class;
}

# key is string length
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 ) = @_;

    # save for error messages
    my $original = $date;

    my %p;
    if ( $date =~ s/([+-]\d\d:\d\d)$// ) {
        $p{time_zone} = $1;
    }

    # Z at end means UTC
    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 ) = @_;

    # removed in 0.4 as it behaved improperly at midnight - kellan 2003/11/23
    #my $base =
    #    ( $dt->hour || $dt->min || $dt->sec ?
    #      sprintf( '%04d-%02d-%02dT%02d:%02d:%02d',
    #               $dt->year, $dt->month, $dt->day,
    #               $dt->hour, $dt->minute, $dt->second ) :
    #      sprintf( '%04d-%02d-%02d', $dt->year, $dt->month, $dt->day )
    #    );

    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;

    my $offset = $dt->offset();

    return $base unless defined $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;
}

# minor offset_as_string variant w/ :
#
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 $w3c = DateTime::Format::W3CDTF->new;
  my $dt = $w3c->parse_datetime( '2003-02-15T13:50:05-05:00' );

  # 2003-02-15T13:50:05-05:00
  $w3c->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://datetime.perl.org/?MailingList for details.

Please submit bugs to the CPAN RT system at
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=datetime-format-w3cdtf or via
email at bug-datetime-format-w3cdtf@rt.cpan.org.

=head1 AUTHOR

Dave Rolsky E<lt>autarch@urth.orgE<gt>

=head1 CREDITS

This module was originally created by Kellan Elliott-McCrea
E<lt>kellan@protest.netE<gt>.

This module was inspired by L<DateTime::Format::ICal>

=head1 COPYRIGHT

Copyright (c) 2009 David Rolsky.  All rights reserved.  This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

Copyright (c) 2003 Kellan Elliott-McCrea

Portions of the code in this distribution are derived from other
works.  Please see the CREDITS file for more details.

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