AoC 2023 day 20, part 2 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say);
use List::Util      qw(reduce all);
use Math::Utils     qw(lcm);

my %Circ;

while (<>) {
    my ($type, $name, $out) = m#(.)(\w+) -> (.*)#;

    $name = 'broadcaster' if ($type eq 'b');

    my @out = split( /, /, $out );

    $Circ{$name}{type} = $type;
    $Circ{$name}{out}  = [@out];
    push( $Circ{$_}{in}->@*, $name )  foreach (@out);
}

# Make sure type is defined for everything to avoid warnings
$Circ{$_}{type} //= ''  foreach (keys %Circ);

# ASSUME: rx has one input, a NAND gate that collects from several NAND gates.
# Those gates should receive all high at some point on a cycle, and when they
# all line up, rx will receive a low pulse.
my %collect = map { $_ => [] } $Circ{ $Circ{rx}{in}[0] }{in}->@*;
my $presses = 0;

LOOP:
while (1) {
    # broadcaster is honourary flip-flop, always start high
    $Circ{broadcaster}{state} = 1;
    my @queue = ([0, 'broadcaster', 'button']);
    $presses++;

    PULSE:
    while (my $pulse = shift @queue) {
        my ($bit, $targ, $src) = @$pulse;

        next PULSE  if (!$Circ{$targ}{type});   # output from tests

        if ($Circ{$targ}{type} eq '&') {
            # NAND
            $Circ{$targ}{$src} = $bit;

            my $state = int !(reduce {$a & $b} (1, map {$Circ{$targ}{$_} // 0} $Circ{$targ}{in}->@*));
            push( $collect{$targ}->@*, $presses ) if (exists $collect{$targ} and $state);

            push( @queue, map { [$state, $_, $targ] } $Circ{$targ}{out}->@* );

        } else {
            # flip-flop or 'b'roadcast
            next PULSE if ($bit);

            my $state = $Circ{$targ}{state} = int !($Circ{$targ}{state} // 0);
            push( @queue, map { [$state, $_, $targ] } $Circ{$targ}{out}->@* );
        }
    }

    # XXX: Just getting the first appearance of each seems to give us the cycles we want.
    last LOOP  if (all { scalar $collect{$_}->@* } keys %collect);
}

say "Sections all set at: ", join( ', ', map { $_->[0] } values %collect );
say "Part 2: ", lcm map { $_->[0] } values %collect;