r31365 - in /branches/upstream/libdatetime-format-strptime-perl/current: Changes MANIFEST META.yml Makefile.PL lib/DateTime/Format/Strptime.pm t/002_dates.t t/006_locales.t t/007_edge.t t/008_epoch.t

ryan52-guest at users.alioth.debian.org ryan52-guest at users.alioth.debian.org
Wed Mar 4 01:32:25 UTC 2009


Author: ryan52-guest
Date: Wed Mar  4 01:32:22 2009
New Revision: 31365

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31365
Log:
[svn-upgrade] Integrating new upstream version, libdatetime-format-strptime-perl (1.0900)

Added:
    branches/upstream/libdatetime-format-strptime-perl/current/t/008_epoch.t
Modified:
    branches/upstream/libdatetime-format-strptime-perl/current/Changes
    branches/upstream/libdatetime-format-strptime-perl/current/MANIFEST
    branches/upstream/libdatetime-format-strptime-perl/current/META.yml
    branches/upstream/libdatetime-format-strptime-perl/current/Makefile.PL
    branches/upstream/libdatetime-format-strptime-perl/current/lib/DateTime/Format/Strptime.pm
    branches/upstream/libdatetime-format-strptime-perl/current/t/002_dates.t
    branches/upstream/libdatetime-format-strptime-perl/current/t/006_locales.t
    branches/upstream/libdatetime-format-strptime-perl/current/t/007_edge.t

Modified: branches/upstream/libdatetime-format-strptime-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/Changes?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/Changes (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/Changes Wed Mar  4 01:32:22 2009
@@ -194,3 +194,22 @@
 		- It seems that I wasn't getting notifications from Google
 		  when people had reported bugs, so there's a pile of fixes
 		  in this release. Hopefully that fixes everyone's issues.
+
+1.0900 2009-02-22
+	- Another pile-o-bugs
+		- It seems that I also wasn't seeing notifications from RT
+		  (please don't use it, use the Gooogle project) so all the
+		  following are fixed:
+			36672	Started failing mid May
+			23313	Bug handling time zones like America/New_York
+			25555	Module dies even when on_error is 'undef'
+			23768	Olson timezone handling incorrect
+			22450	locale test failing with bleadperl
+			20487	nmake test_more fail (with patch); incorrect
+					META.yml
+			12071	format_datetime uses datetime locale rather than
+					format locale
+			11863	bug in DateTime::Format::Strptime 1.0601 when using %s
+
+		- And a couple from Google:
+		    #8		Add DateTime::Locale to documentation

Modified: branches/upstream/libdatetime-format-strptime-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/MANIFEST?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/MANIFEST (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/MANIFEST Wed Mar  4 01:32:22 2009
@@ -12,4 +12,5 @@
 t/005_croak.t
 t/006_locales.t
 t/007_edge.t
+t/008_epoch.t
 t/more/001_all_locales.t

Modified: branches/upstream/libdatetime-format-strptime-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/META.yml?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/META.yml (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/META.yml Wed Mar  4 01:32:22 2009
@@ -3,7 +3,7 @@
         version: 1.3
         url: http://module-build.sourceforge.net/META-spec-v1.3.html
 name:           DateTime-Format-Strptime
-version:        1.0800
+version:        1.0900
 abstract:       Parse and format strp and strf time patterns
 author:
         - Rick Measham <rickm at cpan.org>

Modified: branches/upstream/libdatetime-format-strptime-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/Makefile.PL?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/Makefile.PL (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/Makefile.PL Wed Mar  4 01:32:22 2009
@@ -35,9 +35,16 @@
 );
 
 sub MY::postamble {
-	return <<'MAKE_FRAG';
+return $^O eq 'MSWin32'?
+<<'MAKE_FRAG'
+test_more :: pure_all
+SET PERL_DL_NONLAZY=1
+$(FULLPERLRUN) "-MExtUtils::Command::MM" "-e"
+"test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" t/more/*.t
+MAKE_FRAG
+:
+<<'MAKE_FRAG';
 test_more :: pure_all
 	PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" t/more/*.t
 MAKE_FRAG
-
 }

Modified: branches/upstream/libdatetime-format-strptime-perl/current/lib/DateTime/Format/Strptime.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/lib/DateTime/Format/Strptime.pm?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/lib/DateTime/Format/Strptime.pm (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/lib/DateTime/Format/Strptime.pm Wed Mar  4 01:32:22 2009
@@ -1,6 +1,7 @@
 package DateTime::Format::Strptime;
 
 use strict;
+
 use DateTime;
 use DateTime::Locale;
 use DateTime::TimeZone;
@@ -11,7 +12,7 @@
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg);
 
 @ISA = 'Exporter';
-$VERSION = '1.0800';
+$VERSION = '1.0900';
 @EXPORT_OK = qw( &strftime &strptime );
 @EXPORT = ();
 
@@ -329,9 +330,14 @@
 	}
 
 	if ($tz_olson) {
-		$tz_olson = ucfirst lc $tz_olson;
-		$tz_olson =~ s|([/_])(\w)|$1\U$2|;
-		my $tz = DateTime::TimeZone->new( name => $tz_olson );
+		my $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
+		if( not $tz ){
+			print "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n" if $self->{diagnostic};
+			$tz_olson = ucfirst lc $tz_olson;
+			$tz_olson =~ s|([/_])(\w)|$1\U$2|g;
+			print "   Trying $tz_olson.\n" if $self->{diagnostic};
+			$tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
+		}
 		$self->local_croak("I don't recognise the time zone '$tz_olson'.") and return undef unless $tz;
 		$use_timezone = $set_time_zone = $tz;
 
@@ -439,7 +445,7 @@
 	# Day of the month
 	$self->local_croak("$day is too large to be a day of the month.") and return undef unless $day <= 31;
 	$self->local_croak("Your day of the month ($day) does not match your day of the year.") and return undef if $doy_dt and $day and $day != $doy_dt->day;
-	$Day = ($day)
+	$Day ||= ($day)
 		? $day
 		: ($doy_dt)
 			? $doy_dt->day
@@ -485,21 +491,21 @@
 
 	# Minutes
 	$self->local_croak("$minute is too large to be a minute.") and return undef unless $minute <= 59;
-	$Minute = $minute;
+	$Minute ||= $minute;
 	$self->local_croak("Your minute does not match your epoch.") and return undef if $epoch_dt and $Minute and $Minute != $epoch_dt->minute;
 	print "Set minute to $Minute.\n" if $self->{diagnostic};
 
 
 	# Seconds
 	$self->local_croak("$second is too large to be a second.") and return undef unless $second <= 59; #OK so leap seconds will break!
-	$Second = $second;
+	$Second ||= $second;
 	$self->local_croak("Your second does not match your epoch.") and return undef if $epoch_dt and $Second and $Second != $epoch_dt->second;
 	print "Set second to $Second.\n" if $self->{diagnostic};
 
 
 	# Nanoeconds
 	$self->local_croak("$nanosecond is too large to be a nanosecond.") and return undef unless length($nanosecond) <= 9;
-	$Nanosecond = $nanosecond;
+	$Nanosecond ||= $nanosecond;
 	$Nanosecond .= '0' while length($Nanosecond) < 9;
 #	Epoch doesn't return nanoseconds
 #	croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond;
@@ -580,7 +586,7 @@
     my ( $self, $dt ) = @_;
     my $pattern = $self->pattern;
     $pattern =~ s/%O/$dt->time_zone->name/eg;
-	return $dt->strftime($pattern);
+	return $dt->clone->set_locale($self->locale)->strftime($pattern);
 }
 
 sub format_duration {
@@ -670,10 +676,11 @@
 	my $month_re = join('|',
 		map { quotemeta $_ }
 			sort { length $b <=> length $a }
-				grep(/\s/, @{$self->{_locale}->month_names}, @{$self->{_locale}->month_abbreviations})
+				grep(/\s|\d/, @{$self->{_locale}->month_names}, @{$self->{_locale}->month_abbreviations})
 	);
 	$month_re .= '|' if $month_re;
-	$regex =~ s/%[bBh]/($month_re\\S+)/g;
+	$month_re .= '[^\\s\\d]+';
+	$regex =~ s/%[bBh]/($month_re)/g;
 	$field_list =~ s/%[bBh]/#month_name#/g;
 	#is the month, using the locale's month names; either the abbreviated or full name may be specified.
 	# %B is the same as %b.
@@ -950,9 +957,10 @@
 
 =item * locale($locale)
 
-When given a locale, this method sets its locale appropriately. If
-the locale is not understood, the method will croak or return undef
-(depending on the setting of on_error in the constructor)
+When given a locale or C<DateTime::Locale> object, this method sets
+its locale appropriately. If the locale is not understood, the method
+will croak or return undef (depending on the setting of on_error in
+the constructor)
 
 If successful this method returns the current locale. (After
 processing as above).
@@ -1212,6 +1220,6 @@
 
 http://datetime.perl.org/
 
-L<perl>, L<DateTime>, L<DateTime::TimeZone>
+L<perl>, L<DateTime>, L<DateTime::TimeZone>, L<DateTime::Locale>
 
 =cut

Modified: branches/upstream/libdatetime-format-strptime-perl/current/t/002_dates.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/t/002_dates.t?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/t/002_dates.t (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/t/002_dates.t Wed Mar  4 01:32:22 2009
@@ -10,7 +10,8 @@
 my $object = DateTime::Format::Strptime->new(
 	pattern => '%D',
 #	time_zone => 'Australia/Melbourne',
-	diagnostic => 0,
+	diagnostic => 1,
+	on_error => 'croak',
 );
 
 my @tests = (
@@ -24,7 +25,7 @@
 	# Simple times
 	['%H:%M:%S', '23:45:56'],
 	['%l:%M:%S %p', '11:34:56 PM'],
-	
+
 	# With Nanoseconds
 	['%H:%M:%S.%N', '23:45:56.123456789'],
 	['%H:%M:%S.%6N', '23:45:56.123456'],
@@ -43,30 +44,30 @@
 }
 
 SKIP: {
-	skip "You don't have the latest DateTime. Older version have a bug whereby 12am and 12pm are shown as 0am and 0pm. You should upgrade.", 1 
+	skip "You don't have the latest DateTime. Older version have a bug whereby 12am and 12pm are shown as 0am and 0pm. You should upgrade.", 1
 		unless $DateTime::VERSION >= 0.11;
 
 	$object->pattern('%l:%M:%S %p');
-	is($object->format_datetime( $object->parse_datetime( '12:34:56 AM' ) ), 
+	is($object->format_datetime( $object->parse_datetime( '12:34:56 AM' ) ),
 		'12:34:56 AM', '%l:%M:%S %p');
 }
 
 
 # Timezones
 SKIP: {
-	skip "You don't have the latest DateTime::TimeZone. Older versions don't display all time zone information. You should upgrade.", 3 
+	skip "You don't have the latest DateTime::TimeZone. Older versions don't display all time zone information. You should upgrade.", 3
 		unless $DateTime::TimeZone::VERSION >= 0.13;
 
 	$object->pattern('%H:%M:%S %z');
-	is($object->format_datetime( $object->parse_datetime( '23:45:56 +1000' ) ), 
+	is($object->format_datetime( $object->parse_datetime( '23:45:56 +1000' ) ),
 		'23:45:56 +1000', '%H:%M:%S %z');
 
 	$object->pattern('%H:%M:%S %Z');
-	is($object->format_datetime( $object->parse_datetime( '23:45:56 AEST' ) ), 
+	is($object->format_datetime( $object->parse_datetime( '23:45:56 AEST' ) ),
 		'23:45:56 +1000', '%H:%M:%S %Z');
 
 	$object->pattern('%H:%M:%S %z %Z');
-	is($object->format_datetime( $object->parse_datetime( '23:45:56 +1000 AEST' ) ), 
+	is($object->format_datetime( $object->parse_datetime( '23:45:56 +1000 AEST' ) ),
 		'23:45:56 +1000 +1000', '%H:%M:%S %z %Z');
 }
 

Modified: branches/upstream/libdatetime-format-strptime-perl/current/t/006_locales.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/t/006_locales.t?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/t/006_locales.t (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/t/006_locales.t Wed Mar  4 01:32:22 2009
@@ -2,7 +2,7 @@
 
 # t/002_basic.t - check module dates in various formats
 
-use Test::More tests => 252;
+use Test::More tests => 257;
 #use Test::More qw/no_plan/;
 use DateTime::Format::Strptime;
 use DateTime;
@@ -21,14 +21,14 @@
 			on_error=> 'croak',
 		)};
 		ok($@ eq '',"Constructor with Day Name");
-		
+
 		my $parsed;
 		eval {
 			$parsed = $strptime->parse_datetime($input);
 		} unless $@;
 		diag("[$@]") if $@ ne '';
 		ok($@ eq '',"Parsed with Day Name");
-		
+
 		is($parsed->strftime($pattern),$input,"Matched with Day Name");
 	}
 #	diag( $locale );
@@ -46,14 +46,14 @@
 			on_error=> 'croak',
 		)};
 		ok($@ eq '',"Constructor with Month Name");
-		
+
 		my $parsed;
 		eval {
 			$parsed = $strptime->parse_datetime($input);
 		} unless $@;
 		diag("[$@]") if $@ ne '';
 		ok($@ eq '',"Parsed with Month Name");
-		
+
 		is($parsed->strftime($pattern),$input,"Matched with Month Name");
 	}
 #	diag( $locale );
@@ -71,16 +71,44 @@
 			on_error=> 'croak',
 		)};
 		ok($@ eq '',"Constructor with Meridian");
-		
+
 		my $parsed;
 		eval {
 			$parsed = $strptime->parse_datetime($input);
 		} unless $@;
 		diag("[$@]") if $@ ne '';
 		ok($@ eq '',"Parsed with Meridian");
-		
+
 		is($parsed->strftime($pattern),$input,"Matched with Meridian");
 	}
 #	diag( $locale );
 }
 
+#diag("\nChecking format_datetime honors strptime's locale rather than the dt's");
+{
+	# Create a parser that has locale 'fr'
+	my $dmy_format = new DateTime::Format::Strptime(
+		pattern => '%d/%m/%Y',
+		locale => 'fr'
+	);
+	is( $dmy_format->locale, 'fr');
+
+	# So, therefore, will a $dt created using it.
+	my $dt = $dmy_format->parse_datetime('03/08/2004');
+	is( $dt->locale->id, 'fr');
+
+	# Now we create a new strptime for formatting, but in a different locale
+	my $pt_format = new DateTime::Format::Strptime(
+		pattern => '%B/%Y',
+		locale => 'pt'
+	);
+	is( $pt_format->locale, 'pt');
+
+	my $string = $pt_format->format_datetime($dt);
+
+	# Make sure the format honored the locale in the strptime
+	is( $string, "agosto/2004" );
+
+	# Make sure the datetime, however, retained its own locale
+	is( $dt->locale->id, 'fr' )
+}

Modified: branches/upstream/libdatetime-format-strptime-perl/current/t/007_edge.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/t/007_edge.t?rev=31365&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/t/007_edge.t (original)
+++ branches/upstream/libdatetime-format-strptime-perl/current/t/007_edge.t Wed Mar  4 01:32:22 2009
@@ -2,7 +2,7 @@
 
 # t/007_edge.t - these tests are for edge case bug report errors
 
-use Test::More tests => 12;
+use Test::More tests => 16;
 use DateTime;
 use DateTime::Format::Strptime;
 
@@ -57,6 +57,30 @@
 is(substr($@,0,39), 'Datetime 0000-00-00 is not a valid date', "Croak message should reflect illegal pattern");
 
 
+#diag("1.09 - Time zones with an underscore");
+{
+	my $parser = new DateTime::Format::Strptime( pattern => '%O' );
+	is($parser->parse_datetime('America/New_York')->time_zone->name, 'America/New_York');
+}
+
+#diag("1.09 - TZs in the wrong case should work (unless they have a cap in the middle of a word)");
+{
+	my $parser = new DateTime::Format::Strptime( pattern => '%O', diagnostic => 1 );
+	is($parser->parse_datetime('AMERICA/NEW_YORK')->time_zone->name, 'America/New_York');
+}
+
+#diag("1.09 - Bogus TZs shouldn't barf, they should follow the on_error setting");
+{
+	my $parser = new DateTime::Format::Strptime( pattern => '%O', on_error => 'undef' );
+	is($parser->parse_datetime('Oz/Munchkinville'), undef);
+}
+
+#diag("1.09 - Month name matching was being too greedy");
+{
+	my $parser = DateTime::Format::Strptime->new( pattern => "%d%b%y" );
+	my $dt = $parser->parse_datetime('15AUG07');
+	is($dt->ymd, '2007-08-15');
+}
 
 sub test {
 	my %arg = @_;

Added: branches/upstream/libdatetime-format-strptime-perl/current/t/008_epoch.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-strptime-perl/current/t/008_epoch.t?rev=31365&op=file
==============================================================================
--- branches/upstream/libdatetime-format-strptime-perl/current/t/008_epoch.t (added)
+++ branches/upstream/libdatetime-format-strptime-perl/current/t/008_epoch.t Wed Mar  4 01:32:22 2009
@@ -1,0 +1,81 @@
+#!perl -w
+
+# t/008_epoch.t - Epoch (%s) tests
+
+use Test::More tests => 23;
+use DateTime;
+use DateTime::Format::Strptime;
+
+my $time = time;
+
+# Epoch in, epoch out, now.
+test(
+	pattern   => "%s",
+	time_zone => 'Asia/Manila',
+	locale    => 'en_PH',
+	input     => $time,
+	epoch     => $time,
+);
+
+
+
+
+# diag("Epoch with a no given time_zone assumes 'floating'. (Though when given an epoch, really should assume UTC ..)");
+{
+	my $parser = DateTime::Format::Strptime->new(
+		pattern   => '%s',
+		locale    => 'en',
+		on_error  => 'undef',
+	);
+	isa_ok($parser, 'DateTime::Format::Strptime');
+	my $parsed = $parser->parse_datetime('1235282552');
+	isa_ok($parsed, 'DateTime');
+	is($parsed->year,2009);
+	is($parsed->month,2);
+	is($parsed->day,22);
+	is($parsed->hour,6);
+	is($parsed->minute,2);
+	is($parsed->second,32);
+	is($parsed->nanosecond * 1,0);
+	is($parsed->time_zone->name,'floating');
+}
+
+# diag("Epoch with a time_zone should return the correct time for that TZ when the epoch occurs in UTC");
+{
+	my $parser = DateTime::Format::Strptime->new(
+		pattern   => '%s',
+		locale    => 'en',
+		on_error  => 'undef',
+		time_zone => 'Asia/Manila',
+	);
+	isa_ok($parser, 'DateTime::Format::Strptime');
+	my $parsed = $parser->parse_datetime('1235282552');
+	isa_ok($parsed, 'DateTime');
+	is($parsed->year,2009);
+	is($parsed->month,2);
+	is($parsed->day,22);
+	is($parsed->hour,14);
+	is($parsed->minute,2);
+	is($parsed->second,32);
+	is($parsed->nanosecond * 1,0);
+	is($parsed->time_zone->name,'Asia/Manila');
+}
+
+
+sub test {
+	my %arg = @_;
+
+	my $strptime = DateTime::Format::Strptime->new(
+		pattern   => $arg{pattern}   || '%F %T',
+		locale    => $arg{locale}    || 'en',
+		time_zone => $arg{time_zone} || 'UTC',
+		diagnostic=> $arg{diagnostic}|| 0,
+		on_error  => 'undef',
+	);
+	isa_ok($strptime, 'DateTime::Format::Strptime');
+
+	my $parsed = $strptime->parse_datetime($arg{input});
+	isa_ok($parsed, 'DateTime');
+
+	is($parsed->epoch,$arg{epoch});
+}




More information about the Pkg-perl-cvs-commits mailing list