Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / DateTime / Format / W3CDTF.pm
diff --git a/local-lib5/lib/perl5/DateTime/Format/W3CDTF.pm b/local-lib5/lib/perl5/DateTime/Format/W3CDTF.pm
new file mode 100644 (file)
index 0000000..cbb001c
--- /dev/null
@@ -0,0 +1,229 @@
+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