Bug #67631 for DateTime: Fix for %U and %W strftime patterns + some minor optimizations

The attached file contains several patches, first patch addresses a bug in %U and %W, the rest is optimizations. %U formula is off by one in years where January 1st is a Sunday, such as 2006, 2012 .. 2006-02-01 Expected: 05 DT: 04 2012-02-01 Expected: 05 DT: 04 2017-02-01 Expected: 05 DT: 04 %W formula is off by one in years where January 1st is either a Sunday or Monday 2006, 2007, 2012 .. 2006-02-01 Expected: 05 DT: 04 2007-02-01 Expected: 05 DT: 04 2012-02-01 Expected: 05 DT: 04 -- chansen

# HG changeset patch # User chansen <chansen@cpan.org> # Date 1303203118 -7200 # Branch chansen # Node ID 985444736637b5f9c68909ddc8ab71e28a5e268d # Parent e877dc806b3e75ac04bc09115d6b4172e3f9e5cd Fix %U and %W strftime patterns, off by one in certain years diff -r e877dc806b3e -r 985444736637 lib/DateTime.pm --- a/lib/DateTime.pm Fri Nov 26 15:39:59 2010 -0600 +++ b/lib/DateTime.pm Tue Apr 19 10:51:58 2011 +0200 @@ -1013,13 +1013,9 @@ 't' => sub {"\t"}, 'T' => sub { $_[0]->strftime('%H:%M:%S') }, 'u' => sub { $_[0]->day_of_week }, - - # algorithm from Date::Format::wkyr 'U' => sub { - my $dow = $_[0]->day_of_week; - $dow = 0 if $dow == 7; # convert to 0-6, Sun-Sat - my $doy = $_[0]->day_of_year - 1; - return sprintf( '%02d', int( ( $doy - $dow + 13 ) / 7 - 1 ) ); + my $sun = $_[0]->day_of_year - ($_[0]->day_of_week + 7) % 7; + return sprintf( '%02d', int( ( $sun + 6 ) / 7) ); }, 'V' => sub { sprintf( '%02d', $_[0]->week_number ) }, 'w' => sub { @@ -1027,9 +1023,8 @@ return $dow % 7; }, 'W' => sub { - my $dow = $_[0]->day_of_week; - my $doy = $_[0]->day_of_year - 1; - return sprintf( '%02d', int( ( $doy - $dow + 13 ) / 7 - 1 ) ); + my $mon = $_[0]->day_of_year - ($_[0]->day_of_week + 6) % 7; + return sprintf( '%02d', int( ( $mon + 6 ) / 7 ) ); }, 'x' => sub { $_[0]->format_cldr( $_[0]->{locale}->date_format_default() ); diff -r e877dc806b3e -r 985444736637 t/13strftime.t --- a/t/13strftime.t Fri Nov 26 15:39:59 2010 -0600 +++ b/t/13strftime.t Tue Apr 19 10:51:58 2011 +0200 @@ -265,3 +265,10 @@ %z => '+0000' %{month} => '9' %{year} => '1999' +year => 2012, month => 1, day => 1 +%U => '01' +%W => '00' +year => 2012, month => 1, day => 10 +%U => '02' +%W => '02' + # HG changeset patch # User chansen <chansen@cpan.org> # Date 1303205242 -7200 # Branch chansen # Node ID 15377a87417d24a447ad0b55d0d736caf700d1c3 # Parent 985444736637b5f9c68909ddc8ab71e28a5e268d optimized formula in ->week_of_month diff -r 985444736637 -r 15377a87417d lib/DateTime.pm --- a/lib/DateTime.pm Tue Apr 19 10:51:58 2011 +0200 +++ b/lib/DateTime.pm Tue Apr 19 11:27:22 2011 +0200 @@ -910,18 +910,10 @@ # ISO says that the first week of a year is the first week containing # a Thursday. Extending that says that the first week of the month is # the first week containing a Thursday. ICU agrees. -# -# Algorithm supplied by Rick Measham, who doesn't understand how it -# works. Neither do I. Please feel free to explain this to me! sub week_of_month { my $self = shift; - - # Faster than cloning just to get the dow - my $first_wday_of_month = ( 8 - ( $self->day - $self->dow ) % 7 ) % 7; - $first_wday_of_month = 7 unless $first_wday_of_month; - - my $wom = int( ( $self->day + $first_wday_of_month - 2 ) / 7 ); - return ( $first_wday_of_month <= 4 ) ? $wom + 1 : $wom; + my $thu = $self->day + 4 - $self->day_of_week; + return int( ( $thu + 6 ) / 7 ); } sub time_zone { # HG changeset patch # User chansen <chansen@cpan.org> # Date 1303205393 -7200 # Branch chansen # Node ID 2087d6604b1c946c7af1b96c62aedca93c27833b # Parent 15377a87417d24a447ad0b55d0d736caf700d1c3 minor optimization in ->new, only invoke ->_month_length if day is greater than 28 diff -r 15377a87417d -r 2087d6604b1c lib/DateTime.pm --- a/lib/DateTime.pm Tue Apr 19 11:27:22 2011 +0200 +++ b/lib/DateTime.pm Tue Apr 19 11:29:53 2011 +0200 @@ -197,7 +197,7 @@ Carp::croak( "Invalid day of month (day = $p{day} - month = $p{month} - year = $p{year})\n" - ) if $p{day} > $class->_month_length( $p{year}, $p{month} ); + ) if $p{day} > 28 && $p{day} > $class->_month_length( $p{year}, $p{month} ); return $class->_new(%p); } # HG changeset patch # User chansen <chansen@cpan.org> # Date 1303206107 -7200 # Branch chansen # Node ID 51a5753ea680caf53117c8381e9e25dd5c31c414 # Parent 2087d6604b1c946c7af1b96c62aedca93c27833b optimized ->from_day_of_year, only invoke ->_month_length once per iteration diff -r 2087d6604b1c -r 51a5753ea680 lib/DateTime.pm --- a/lib/DateTime.pm Tue Apr 19 11:29:53 2011 +0200 +++ b/lib/DateTime.pm Tue Apr 19 11:41:47 2011 +0200 @@ -617,18 +617,19 @@ my $class = shift; my %p = validate( @_, $FromDayOfYearValidate ); - my $is_leap_year = $class->_is_leap_year( $p{year} ); - Carp::croak("$p{year} is not a leap year.\n") - if $p{day_of_year} == 366 && !$is_leap_year; + if $p{day_of_year} == 366 && !$class->_is_leap_year( $p{year} ); my $month = 1; my $day = delete $p{day_of_year}; - while ( $month <= 12 && $day > $class->_month_length( $p{year}, $month ) ) - { - $day -= $class->_month_length( $p{year}, $month ); - $month++; + if ($day > 31) { + my $dim = $class->_month_length( $p{year}, $month ); + while ($day > $dim) { + $day -= $dim; + $month++; + $dim = $class->_month_length( $p{year}, $month ); + } } return $class->_new( # HG changeset patch # User chansen <chansen@cpan.org> # Date 1303208862 -7200 # Branch chansen # Node ID b9bf1e80fd07d3cff21049f22a8309221af1c609 # Parent 51a5753ea680caf53117c8381e9e25dd5c31c414 optimize ->_weeks_in_year diff -r 51a5753ea680 -r b9bf1e80fd07 lib/DateTime.pm --- a/lib/DateTime.pm Tue Apr 19 11:41:47 2011 +0200 +++ b/lib/DateTime.pm Tue Apr 19 12:27:42 2011 +0200 @@ -894,15 +894,15 @@ return @{ $self->{local_c} }{ 'week_year', 'week_number' }; } -# Also from DateCalc.c sub _weeks_in_year { my $self = shift; my $year = shift; - my $jan_one_dow = ( ( $self->_ymd2rd( $year, 1, 1 ) + 6 ) % 7 ) + 1; - my $dec_31_dow = ( ( $self->_ymd2rd( $year, 12, 31 ) + 6 ) % 7 ) + 1; - - return $jan_one_dow == 4 || $dec_31_dow == 4 ? 53 : 52; + my $dow = $self->_ymd2rd( $year, 1, 1 ) % 7; # Sun=0 + + # All years starting with Thursday, and leap years starting with Wednesday + # has 53 weeks. + return ($dow == 4 || ($dow == 3 && $self->_is_leap_year($year))) ? 53 : 52; } sub week_year { ( $_[0]->week )[0] }