Permalink
Browse files

Moved this into its own repo.

  • Loading branch information...
0 parents commit 52278e36c4b648db0b3f8eb2060274a5e1070466 @supernovus committed Nov 10, 2011
Showing with 369 additions and 0 deletions.
  1. +5 −0 Changes
  2. +9 −0 MANIFEST
  3. +25 −0 META.yml
  4. +17 −0 Makefile.PL
  5. +32 −0 README
  6. +183 −0 lib/DateTime/Format/Perl6.pm
  7. +11 −0 t/00_load.t
  8. +45 −0 t/01_parsing.t
  9. +42 −0 t/02_formatting.t
5 Changes
@@ -0,0 +1,5 @@
+Revision history for DateTime-Format-Perl6
+
+1.0.0 2011-01-25
+ Started project, a fork of DateTime-Format-RFC3339.
+
9 MANIFEST
@@ -0,0 +1,9 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/DateTime/Format/Perl6.pm
+t/00_load.t
+t/01_parsing.t
+t/02_formatting.t
+META.yml Module meta-data (added by MakeMaker)
25 META.yml
@@ -0,0 +1,25 @@
+--- #YAML:1.0
+name: DateTime-Format-Perl6
+version: v1.0.0
+abstract: Parse and format Perl6-style datetime strings
+author:
+ - Eric Brine <ikegami@adaelis.com>
+ - Timothy Totten <supernovus@gmail.com>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ DateTime: 0
+ Test::More: 0
+ version: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
17 Makefile.PL
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker qw( WriteMakefile );
+
+WriteMakefile(
+ NAME => 'DateTime::Format::Perl6',
+ AUTHOR => 'Timothy Totten <supernovus@gmail.com>',
+ VERSION_FROM => 'lib/DateTime/Format/Perl6.pm',
+ ABSTRACT_FROM => 'lib/DateTime/Format/Perl6.pm',
+ PREREQ_PM => { 'DateTime' => 0,
+ 'Test::More' => 0,
+ 'version' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
+ clean => { FILES => 'DateTime-Format-Perl6-*' },
+);
32 README
@@ -0,0 +1,32 @@
+DateTime-Format-Perl6
+
+DateTime::Format::Perl6 parses and formats Perl6-style
+datetime strings.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ DateTime
+ Test::More
+ version
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc DateTime::Format::Perl6
+
+COPYRIGHT AND LICENCE
+
+Public domain. No rights reserved.
183 lib/DateTime/Format/Perl6.pm
@@ -0,0 +1,183 @@
+
+package DateTime::Format::Perl6;
+
+use strict;
+use warnings;
+
+use version; our $VERSION = qv('v1.0.0');
+
+use Carp qw( croak );
+use DateTime qw( );
+
+use constant FIRST_IDX => 0;
+use constant IDX_UC_ONLY => FIRST_IDX + 0;
+use constant NEXT_IDX => FIRST_IDX + 1;
+
+sub new {
+ my ($class, %opts) = @_;
+
+ my $uc_only = delete( $opts{uc_only} );
+
+ return bless([
+ $uc_only, # IDX_UC_ONLY
+ ], $class);
+}
+
+sub parse_datetime {
+ my ($self, $str) = @_;
+
+ $self = $self->new()
+ if !ref($self);
+
+ $str = uc($str)
+ if !$self->[IDX_UC_ONLY];
+
+ my ($Y,$M,$D) = $str =~ s/^(\d{4})-(\d{2})-(\d{2})// && (0+$1,0+$2,0+$3)
+ or croak("Incorrectly formatted date");
+
+ $str =~ s/^T//
+ or croak("Incorrectly formatted datetime");
+
+ my ($h,$m,$s) = $str =~ s/^(\d{2}):(\d{2}):(\d{2})// && (0+$1,0+$2,0+$3)
+ or croak("Incorrectly formatted time");
+
+ my $ns = $str =~ s/^\.(\d{1,9})\d*// ? 0+substr($1.('0'x8),0,9) : 0;
+
+ my $tz;
+ if ( $str =~ s/^Z// ) { $tz = 'UTC'; }
+ elsif ( $str =~ s/^([+-])(\d{2}):?(\d{2})// ) { $tz = "$1$2$3"; }
+ else { croak("Missing time zone"); }
+
+ $str =~ /^\z/ or croak("Incorrectly formatted datetime");
+
+ return DateTime->new(
+ year => $Y,
+ month => $M,
+ day => $D,
+ hour => $h,
+ minute => $m,
+ second => $s,
+ nanosecond => $ns,
+ time_zone => $tz,
+ formatter => $self,
+ );
+}
+
+
+sub format_datetime {
+ my ($self, $dt) = @_;
+
+ my $tz;
+ if ($dt->time_zone()->is_utc()) {
+ $tz = 'Z';
+ } else {
+ my $secs = $dt->offset();
+ my $sign = $secs < 0 ? '-' : '+'; $secs = abs($secs);
+ my $mins = int($secs / 60); $secs %= 60;
+ my $hours = int($mins / 60); $mins %= 60;
+ if ($secs) {
+ ( $dt = $dt->clone() )
+ ->set_time_zone('UTC');
+ $tz = 'Z';
+ } else {
+ $tz = sprintf('%s%02d%02d', $sign, $hours, $mins);
+ }
+ }
+
+ return $dt->strftime('%Y-%m-%dT%H:%M:%S').$tz;
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+DateTime::Format::Perl6 - Parse and format Perl6-style datetime strings
+
+
+=head1 VERSION
+
+Version 1.0.0
+
+
+=head1 SYNOPSIS
+
+ use DateTime::Format::Perl6;
+
+ my $f = DateTime::Format::Perl6->new();
+ my $dt = $f->parse_datetime( '2002-07-01T13:50:05-0800' );
+
+ # 2002-07-01T13:50:05-0800
+ print $f->format_datetime($dt);
+
+
+=head1 DESCRIPTION
+
+This module understands the Perl 6 date/time format, an ISO 8601 profile,
+defined at L<http://perlcabal.org/syn/S32/Temporal.html>.
+
+It can be used to parse that format in order to create the appropriate
+objects.
+
+
+=head1 METHODS
+
+=over
+
+=item C<parse_datetime($string)>
+
+Given a Perl 6 datetime string, this method will return a new
+L<DateTime> object.
+
+If given an improperly formatted string, this method will croak.
+
+For a more flexible parser, see L<DateTime::Format::ISO8601>.
+
+=item C<format_datetime($datetime)>
+
+Given a L<DateTime> object, this methods returns a Perl 6 datetime
+string.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item * L<DateTime>
+
+=item * L<DateTime::Format::ISO8601>
+
+=item * L<DateTime::Format::RFC3339>, the module that was forked from.
+
+=item * L<http://perlcabal.org/syn/S32/Temporal.html>, Perl 6 Temporal specification, from where this date format is specified.
+
+=back
+
+
+=head1 BUGS
+
+Please report any bugs to the author (see below.)
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc DateTime::Format::Perl6
+
+
+=head1 AUTHOR
+
+Timothy Totten, C<< <supernovus@gmail.com> >>, the guy who hacked this up using an existing module as a basis.
+
+Eric Brine, C<< <ikegami@adaelis.com> >>, author of DateTime::Format::RFC3339, which this is based on.
+
+
+=head1 COPYRIGHT & LICENSE
+
+Public domain. No rights reserved.
+
+
+=cut
11 t/00_load.t
@@ -0,0 +1,11 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN { require_ok( 'DateTime::Format::Perl6' ); }
+
+diag( "Testing DateTime::Format::Perl6 $DateTime::Format::Perl6::VERSION, Perl $]" );
+
45 t/01_parsing.t
@@ -0,0 +1,45 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use DateTime qw( );
+use DateTime::Format::Perl6 qw( );
+
+my @pos_tests;
+my @neg_tests;
+BEGIN {
+ @pos_tests = (
+ [
+ '2002-07-01T13:50:05Z',
+ DateTime->new( year => 2002, month => 7, day => 1, hour => 13, minute => 50, second => 5, time_zone => 'UTC' ),
+ ],
+ [
+ '2002-07-01T13:50:05.123Z',
+ DateTime->new( year => 2002, month => 7, day => 1, hour => 13, minute => 50, second => 5, nanosecond => 123000000, time_zone => 'UTC' ),
+ ],
+ [
+ '2011-01-25T15:42:17-0800',
+ DateTime->new( year => 2011, month => 1, day => 25, hour => 15, minute => 42, second => 17, time_zone => '-0800' ),
+ ],
+ );
+
+ @neg_tests = (
+ );
+}
+
+use Test::More tests => @pos_tests + @neg_tests;
+
+for (@pos_tests) {
+ my ($str, $expected_dt) = @$_;
+ my $actual_dt = eval { DateTime::Format::Perl6->parse_datetime($str) };
+ ok( defined($actual_dt) && $actual_dt eq $expected_dt, $str );
+}
+
+for (@neg_tests) {
+ my ($str, $expected_e) = @$_;
+ eval { DateTime::Format::Perl6->parse_datetime($str) };
+ my $actual_e = $@;
+ like( $actual_e, $expected_e, $str );
+}
+
42 t/02_formatting.t
@@ -0,0 +1,42 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use DateTime qw( );
+use DateTime::Format::Perl6 qw( );
+
+my @tests;
+BEGIN {
+ @tests = (
+ [ # UTC
+ DateTime->new( year => 2002, month => 7, day => 1, hour => 13, minute => 50, second => 5, time_zone => 'UTC' ),
+ '2002-07-01T13:50:05Z',
+ ],
+ [ # Positive offset
+ DateTime->new( year => 2002, month => 7, day => 1, hour => 13, minute => 50, second => 5, time_zone => 'Europe/London' ),
+ '2002-07-01T13:50:05+0100',
+ ],
+ [ # Zero offset
+ DateTime->new( year => 2002, month => 1, day => 1, hour => 13, minute => 50, second => 5, time_zone => 'Europe/London' ),
+ '2002-01-01T13:50:05+0000',
+ ],
+ [ # Negative offset.
+ DateTime->new( year => 2002, month => 1, day => 1, hour => 13, minute => 50, second => 5, time_zone => 'America/New_York' ),
+ '2002-01-01T13:50:05-0500',
+ ],
+ [ # Offset with non-integral minutes.
+ DateTime->new( year => 1880, month => 1, day => 1, hour => 0, minute => 0, second => 0, time_zone => 'America/New_York' ),
+ '1880-01-01T04:56:02Z',
+ ],
+ );
+}
+
+use Test::More tests => 0+@tests;
+
+for (@tests) {
+ my ($dt, $expected_str) = @$_;
+ $dt->set_formatter('DateTime::Format::Perl6');
+ my $actual_str = "$dt";
+ is( $actual_str, $expected_str );
+}

0 comments on commit 52278e3

Please sign in to comment.