AoC 2023 day 13 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature  qw(say);

$/ = '';  # Paragraph mode

my @Grids = map { y/.#/01/; my @g = split /\n/; [map {[split //]} @g] } <>;

sub print_grid($)  { my $g = shift; say "\t", join( '', @$_ ) foreach ($g->@*); }

sub as_num(@)      { oct("0b" . join('', @_)) }
sub one_bit_set($) { my $n = shift; return (($n & ($n - 1)) == 0) }

sub clean_reflect {
    my @cols = @_;

    my $i;
    my @stack = ($cols[0]);
    for ($i = 1; $i < @cols; $i++) {
        if ($cols[$i] == $stack[-1]) {
            pop( @stack );
        } else {
            push( @stack, $cols[$i] );
        }

        return (($i + 1) / 2) if (!@stack);
    }

    return (0);
}

sub smudge_reflect {
    my @cols = @_;

    my $size = @cols;

    my @stack = shift( @cols );
    my @pops  = shift( @cols );
    for (my $j = 0; $j < int($size / 2); $j++) {

        my $foo = 0;
        for (my $i = 0; $i < @stack; $i++) {
            next if ($stack[$i] == $pops[$i]);
            $foo += (one_bit_set( $stack[$i] ^ $pops[$i] )) ? 1 : 2;
        }

        return ($j + 1) if ($foo == 1);

        push( @stack, pop( @pops ) );
        unshift( @pops, shift( @cols ) );
        unshift( @pops, shift( @cols ) );
    }

    return (0);
}

sub test_reflect {
    my ($func, @cols) = @_;

    my $reflect = &$func( @cols );
    if (!$reflect) {
        $reflect = &$func( reverse @cols );
        $reflect = @cols - $reflect  if ($reflect);
    }

    return ($reflect);
}

my $part1 = 0;
my $part2 = 0;

foreach my $grid (@Grids) {
    my @rows = map { &as_num(@$_) } $grid->@*;

    $part1 += 100 * &test_reflect( \&clean_reflect,  @rows );
    $part2 += 100 * &test_reflect( \&smudge_reflect, @rows );

    my @cols;
    foreach my $x (0 .. $grid->[0]->$#*) {
        push( @cols, &as_num(map {$grid->[$_][$x]} (0 .. $grid->$#*)) );
    }

    $part1 += &test_reflect( \&clean_reflect,  @cols );
    $part2 += &test_reflect( \&smudge_reflect, @cols );
}

say "Part 1: $part1";
say "Part 2: $part2";