Search code examples
datetimeperl

Perl Date::Manip::Recur usage on none dates


I have been attempting to use Date::Manip::Recur to solve a problem - it sounded super easy to resolve, but I'm struggling with the correct solution. However, after reading the documentation multiple times I'm still unable to identify the 'correct' way to resolve the problem. The modules documentation is here:

https://metacpan.org/pod/Date::Manip::Recur

Please see the following code.

Essentially, I'm looking for the code to return the dates of all reoccurrences of a 'day in the month' in which a customer would owe money, effectively. For example, the customer could owe money on the 15th of each month (in advance) in between a range of random start/end dates.

The code works great from 1st to the 28th. But, as you can imagine, the 29th, 30th and 31st can be missed out by this library. The obvious answer is never set the customers dates to the 29th, 30th or 31st but the damage has already been done! Thus, some contracts require payment on the 31st of each month, including February, which doesn't exist.

Hope that makes sense - I'm sure the library/module can resolve this! The documentation does note:


  1. Most recurrences have a known number of events (equal to the number of combinations of values in the rtime) for each date. For these, calculating the Nth date is much faster. However, in this case, some of them may refer to an invalid date. For example, if the frequency is 'the 31st of every month' and the base (0th) date is Jan 31, the 1st event would refer to Feb 31. Since that isn't valid, undef would be returned for $n=1. Obviously, it would be possible to actually determine the Nth valid event by calculating all N-1 dates, but in the interest of performance, this is not done.

Thank you,

#!/usr/bin/perl

use strict;
use warnings;

use Date::Manip::Recur;
use Date::Manip::Date;
use DateTime::Format::Strptime;

use String::Util qw(trim);

my $reoccur_date = 30;

#
# Create objects
#
my $start_manip = new Date::Manip::Date;
my $end_manip = new Date::Manip::Date;

$start_manip->parse_format('%d/%m/%Y', '29/10/2023');
$end_manip->parse_format('%d/%m/%Y', '28/09/2024');

#
# Reoccurence
#
my $freq = "0:1:0*$reoccur_date:0:0:0";

my $recur = new Date::Manip::Recur;

$recur->new_date();

my $err =$recur->parse(
    $freq,
    $start_manip,
    $start_manip,
    $end_manip
);
my @dates_reoccur = $recur->dates();

my $dates_found = @dates_reoccur;

print "There are $dates_found list members\n";

foreach my $i (@dates_reoccur){
    my $tmp = $i->value;

    # Create a custom date format
    my $dt_format = DateTime::Format::Strptime->new(
        pattern   => '%Y%m%d%H:%M:%S',
        on_error  => 'croak',
    );

    # Parse the input string
    my $datetime = $dt_format->parse_datetime(trim($tmp));

    print "Found date: " . $datetime->strftime('%d %B %Y') . "\n";
}

Ideally, the code would show the 28th or the closest date to the end of the month in the below code, which demonstrates February being missed on the list. The problem also exists on the 31st, in which some months don't have.


Solution

  • Date::Manip::Recur is not the right tool for the job, as its dates method skips undefined dates you mentioned - the paragraph comes from the documentation of the nth method, which isn't helpful either, because it doesn't know what month the undefined value belongs to.

    You don't need any of the modules, though. You can just use Time::Piece which is a core module:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use experimental qw( signatures );
    
    use Time::Piece;
    use Time::Seconds qw( ONE_DAY );
    
    sub dates($reoccur, $start_date, $end_date) {
        my $start = 'Time::Piece'->strptime($start_date, '%d/%m/%Y');
        my $end   = 'Time::Piece'->strptime($end_date, '%d/%m/%Y');
    
        my $date = $start;
    
        my $starts_this_month = $date->mday <= $reoccur;
    
        my @dates;
        while ($date <= $end) {
            $date += ONE_DAY * (1 + $date->month_last_day - $date->mday)
                unless $starts_this_month;
            $starts_this_month = 0;
    
            my $last = $date->month_last_day;
            my $day = $last > $reoccur ? $reoccur : $last;
            $date += ONE_DAY * ($day - $date->mday);
    
            push @dates, $date->ymd;
        }
        pop @dates; # The last date is after end.
        return \@dates
    }
    
    use Test2::V0;
    
    is dates(30, '29/10/2023', '28/05/2024'), [
        '2023-10-30',
        '2023-11-30',
        '2023-12-30',
        '2024-01-30',
        '2024-02-29',
        '2024-03-30',
        '2024-04-30',
    ];
    
    is dates(30, '17/02/2023', '30/06/2023'), [
        '2023-02-28',
        '2023-03-30',
        '2023-04-30',
        '2023-05-30',
        '2023-06-30',
    ];
    
    is dates(28, '28/02/2023', '28/06/2023'), [
        '2023-02-28',
        '2023-03-28',
        '2023-04-28',
        '2023-05-28',
        '2023-06-28',
    ];
    
    is dates(30, '31/01/2023', '28/06/2023'), [
        '2023-02-28',
        '2023-03-30',
        '2023-04-30',
        '2023-05-30',
    ];
    
    is dates(29, '30/01/2023', '30/03/2024'), [
        '2023-02-28',
        '2023-03-29',
        '2023-04-29',
        '2023-05-29',
        '2023-06-29',
        '2023-07-29',
        '2023-08-29',
        '2023-09-29',
        '2023-10-29',
        '2023-11-29',
        '2023-12-29',
        '2024-01-29',
        '2024-02-29',
        '2024-03-29',
    ];
    
    is dates(21, '21/02/2023', '28/06/2023'), [
        '2023-02-21',
        '2023-03-21',
        '2023-04-21',
        '2023-05-21',
        '2023-06-21'
    ];
    
    is dates(29, '17/01/2023', '28/02/2023'), [
        '2023-01-29',
        '2023-02-28',
    ];
    
    is dates(31, '28/02/2023', '28/02/2023'), [
        '2023-02-28',
    ];
    
    
    done_testing();
    

    Test cases included, but I'm not sure I've covered everything. Feel free to reuse the test cases for any other solution you consider.