AoC 2023 day 12 (Perl)

#!/usr/bin/perl

use v5.26;
use warnings;

use List::Util      qw(sum);

no warnings 'recursion';

# Get input as array of characters
my @input;
while (<>) {
    my @sec  = split / /;
    my $str  = $sec[0];
    my @nums = map {int} split( /,/, $sec[1] );

    push($input[1]->@*, {str => $str, groups => [@nums]});
    push($input[2]->@*, {str => $str . (('?'. $str) x 4), groups => [(@nums) x 5]});
}

my %memo;
sub recurse {
    # str to process, current potential group length, groups left to see
    my ($str, $len, @groups) = @_;

    # Grab state of params called with to access memo with later.
    my $state = join( $;, $str, $len, @groups );

    # Check memo
    return ($memo{$state}) if (exists $memo{$state});

    my $ret = 0;

    if (!$str) {
        # Out of input, must decide if we found a match:
        # All groups accounted for, no hanging group.
        $ret = 1  if (@groups == 0 and $len == 0);

        # Check if hanging group is the size of the only remaining group:
        $ret = 1  if (@groups == 1 and $groups[0] == $len);

        return( $memo{$state} = $ret );
    }

    # If out of groups, use regex to check if no manditory groups remain
    return( $memo{$state} = ($str =~ m/^[^#]*$/) ) if (!@groups);

    # ASSERT: length($str) > 0, $len >= 0, @groups > 0

    # Advance one character:
    my $chr = substr( $str, 0, 1, '' );

    if ($chr ne '.') {   # ? or #
        # adv making grouping larger
        $ret += &recurse( $str, $len + 1, @groups );
    }

    if ($chr ne '#') {   # ? or .
        if ($len == 0) {
            # no current grouping, just advance
            $ret += &recurse( $str, 0, @groups );

        } elsif ($len == $groups[0]) {
            # current grouping matches current target
            shift @groups;
            $ret += &recurse( $str, 0, @groups );
        }
        # else: Bad block length!  Fail match, recurse no further
    }

    return( $memo{$state} = $ret );
}

foreach (1 .. 2) {
    say "Part $_: ", sum map { &recurse( $_->{str}, 0, $_->{groups}->@* ) } $input[$_]->@*;
}