Bug #25001 for Date-PeriodParser: Support "this week", "last week", "this month" and "last month"

The attached patch adds support for the following phrases: "this week", "last week", "this month" and "last month". The patch also adds tests for those phrases.

=== t/this-week.t ================================================================== --- t/this-week.t (revision 1920) +++ t/this-week.t (patch - level 1) @@ -0,0 +1,49 @@ +use strict; +use warnings; +use Test::More; +use Time::Local; +use Date::PeriodParser; +use POSIX qw( strftime ); +require 't/helpers.pl'; + +# Tests for "this week" and "last week" + +my %phrases = ( + 'this week' => [ + [ + '2006-12-28T21:33:40', # base + '2006-12-25T00:00:00', # expected from + '2006-12-31T23:59:59', # expected to + ], + [ + '2007-01-19T10:07:22', # base + '2007-01-15T00:00:00', # expected from + '2007-01-21T23:59:59', # expected to + ], + ], + 'last week' => [ + [ + '2006-12-28T21:33:40', # base + '2006-12-18T00:00:00', # expected from + '2006-12-24T23:59:59', # expected to + ], + [ + '2007-01-19T10:07:22', # base + '2007-01-08T00:00:00', # expected from + '2007-01-14T23:59:59', # expected to + ], + ], +); + +plan tests => 2 * 4; + +while ( my ($phrase, $tests) = each %phrases ) { + for my $test (@$tests) { + my ($base, $right_from, $right_to) = @$test; + set_time($base); + + my ( $from, $to ) = parse_period($phrase); + is( iso($from), $right_from, "$phrase 'from' ok" ); + is( iso($to), $right_to, "$phrase 'to' ok" ); + } +} === t/helpers.pl ================================================================== --- t/helpers.pl (revision 1920) +++ t/helpers.pl (patch - level 1) @@ -0,0 +1,20 @@ +use strict; +use warnings; + +1; + +sub set_time { + my ($timestamp) = @_; + + my ($year, $mon, $day, $hour, $min, $sec) = split /[-T:]/, $timestamp; + $year -= 1900; + $mon--; + + $Date::PeriodParser::TestTime = + timelocal( $sec, $min, $hour, $day, $mon, $year ); +} + +sub iso { + my ($time) = @_; + return strftime( "%Y-%m-%dT%H:%M:%S", localtime($time) ); +} === t/this-month.t ================================================================== --- t/this-month.t (revision 1920) +++ t/this-month.t (patch - level 1) @@ -0,0 +1,49 @@ +use strict; +use warnings; +use Test::More; +use Time::Local; +use Date::PeriodParser; +use POSIX qw( strftime ); +require 't/helpers.pl'; + +# Tests for "this month" and "last month" + +my %phrases = ( + 'this month' => [ + [ + '2006-12-28T21:33:40', # base + '2006-12-01T00:00:00', # expected from + '2006-12-31T23:59:59', # expected to + ], + [ + '2007-01-19T10:07:22', # base + '2007-01-01T00:00:00', # expected from + '2007-01-31T23:59:59', # expected to + ], + ], + 'last month' => [ + [ + '2006-12-28T21:33:40', # base + '2006-11-01T00:00:00', # expected from + '2006-11-30T23:59:59', # expected to + ], + [ + '2007-01-19T10:07:22', # base + '2006-12-01T00:00:00', # expected from + '2006-12-31T23:59:59', # expected to + ], + ], +); + +plan tests => 4 * 2; + +while ( my ($phrase, $tests) = each %phrases ) { + for my $test (@$tests) { + my ($base, $right_from, $right_to) = @$test; + set_time($base); + + my ( $from, $to ) = parse_period($phrase); + is( iso($from), $right_from, "$phrase 'from' ok" ); + is( iso($to), $right_to, "$phrase 'to' ok" ); + } +} === MANIFEST ================================================================== --- MANIFEST (revision 1920) +++ MANIFEST (patch - level 1) @@ -12,6 +12,9 @@ t/07junk.t t/08now.t t/09vague.t +t/helpers.pl t/pod.t t/pod-coverage.t +t/this-week.t +t/this-month.t META.yml Module meta-data (added by MakeMaker) === PeriodParser.pm ================================================================== --- PeriodParser.pm (revision 1920) +++ PeriodParser.pm (patch - level 1) @@ -5,7 +5,12 @@ use strict; use warnings; use Time::Local; -use Date::Calc; +use Date::Calc qw( + Add_Delta_Days + Date_to_Time + Day_of_Week + Days_in_Month +); use constant GIBBERISH => -1; use constant AMBIGUOUS => -2; @@ -60,6 +65,41 @@ return ($from, $to); } + # "this week", "last week" + if ( m/(this|last) week/ ) { + my $modifier = $1; + my @today = _today(); + if ( $modifier eq 'last' ) { + @today = Add_Delta_Days( @today, -7 ); + } + my $today = Day_of_Week(@today); + my $monday = 1; + my $sunday = 7; + + # Monday at midnight and sunday just before midnight + my @monday = ( Add_Delta_Days(@today, $monday - $today), 0, 0, 0 ); + my @sunday = ( Add_Delta_Days(@today, $sunday - $today), 23, 59, 59 ); + + return ( _timelocal(@monday), _timelocal(@sunday) ); + } + + # "this month", "last month" + if (m/(this|last) month/) { + my $modifier = $1; + my ( $year, $month, undef ) = _today(); + + # find a day in the previous month + if ( $modifier eq 'last' ) { + ( $year, $month ) = Add_Delta_Days( $year, $month, 1, -1 ); + } + + my @first = ( $year, $month, 1, 0, 0, 0 ); # first day at midnight + my $last_day_of_month = Days_in_Month( $year, $month ); + my @last = ( $year, $month, $last_day_of_month , 23, 59, 59 ); + + return ( _timelocal(@first), _timelocal(@last) ); + } + # Recent times if (/(the day (before|after) )?(yesterday|today|tomorrow)/ || /^this (morning|afternoon|evening|lunchtime)/ || @@ -202,6 +242,29 @@ $from -= $leeway; $to += $leeway; return ($from, $to); } + +# similar to Time::Local::timelocal but accepts the offsets returned by +# Date::Calc::Today_and_Now() +sub _timelocal { + my ( $year, $mon, $day, $hour, $min, $sec ) = @_; + + # make offsets as expected by timelocal + $year -= 1900; + $mon--; + + return timelocal( $sec, $min, $hour, $day, $mon, $year ); +} + +# same as Date::Calc::Today but respect $TestTime so that +# we can test periods based on today's date +sub _today { + my $now = $TestTime || time; + my ( $day, $month, $year ) = ( localtime $now )[ 3 .. 5 ]; + $year += 1900; + $month++; + return ($year, $month, $day); +} + 1; __END__ @@ -260,6 +323,12 @@ disambiguate relative to the current time. For instance, if it's afternoon and "in the morning" is specified, this implies "tomorrow morning". +=item * this week, last week, this month, last month + +"This" means the week or month which includes the current day. Weeks begin on +Monday and end of Sunday. "Last" means the week or month preceeding "this +week/month". + =item * "ago" and "from now" Offsets in days and "a week" are accepted; you cannot cross a month