Partial desription of a date matching regex

date.pl

#!/usr/bin/env perl
use Test::Most;
use Veure::Script; # strict, warnings, postderef, sigs, and more
use re 'eval';     # needed for (??{}) in the regex

# the (??{}) construct will execute code and consider the result of that
# to be a regex to match on.
my $yyyy_mm_dd = qr/
  ^
        # any four digit year
        (?<year>[0-9]{4})
        -

        # match 01-12
        (?<month>0[1-9]|1[012])
        -

        # 01 to 31
        (?<day>0[1-9]|1[0-9]|2[0-9]|3[01])

        # now make sure it's valid
        (??{ valid_date($+{year}, $+{month}, $+{day}) })
  $
/x;

sub valid_date ( $year, $month, $day ) {

    # we needed this to be fast and DateTime has overhead we didn't need.
    # Merely constructing a DateTime object would be easier and more likely
    # to be correct

    # The (?=a)[^a] is a regex that must always fail (lookahead requires next
    # character to be an "a" and then match on anything that is not an "a")
    my $fail    = '(?=a)[^a]';
    my $success = '.?';          # always succeeds

    # these months only have 30 days
    if ($day == 31
        and (
            $month == 4          # April
            or $month == 6       # June
            or $month == 9       # September
            or $month == 11      # November
        )
      )
    {
        return $fail;
    }
    if ( $month == 2 ) {         # February
        if ( $day >= 30 ) {
            return $fail;
        }
        elsif (
            $day == 29
            and not( $year % 4 == 0
                and ( $year % 100 != 0 or $year % 400 == 0 ) )
          )
        {
            # Feb 29, but not a leap year
            return $fail;
        }
    }

    return $success;
}

my %examples_for = (
    pass => [
        '1999-12-31',
        '1999-12-30',
        '1999-12-01',
        '1999-01-31',
        '2000-02-29',
        '1904-02-29',
    ],
    fail => [
        '1999-02-31',
        '1999-2-31',
        '1999-20-12',
        '1999-12-00',
        '99-01-31',
        '1999-00-31',
        '1900-02-29',
        '2019-02-29',
    ]
);

foreach my $date ( $examples_for{pass}->@* ) {
    ok $date =~ $yyyy_mm_dd, "$date should be a valid date";
}
foreach my $date ( $examples_for{fail}->@* ) {
    ok $date !~ $yyyy_mm_dd, "$date should not be a valid date";
}

done_testing;