package Perl::Critic::Policy::GoodLabels;

use strict;
use warnings;

our $VERSION = 0.01;
use 5.032;
use Perl::Critic::Utils qw{};
use parent 'Perl::Critic::Policy';

my $description = q{Unknown Label};
my $explanation = <<'UNKNOWN_LABEL';
The label '%s' used as a target of next, last, or redo is not defined
in the current scope
UNKNOWN_LABEL
chomp $explanation;

sub supported_parameters { return; }
sub default_severity     { return $Perl::Critic::Utils::SEVERITY_HIGHEST; }
sub applies_to           { return 'PPI::Statement::Break' }

sub prepare_to_scan_document {
    my ( $self, $document ) = @_;

    return 1;
}

my %allowed_labels;

sub violates {
    my ( $self, $element, $document ) = @_;

    %allowed_labels or _collect_labels($document);

    my @children = $element->schildren();
    if (   $children[0]->content() ne 'next'
        && $children[0]->content() ne 'last'
        && $children[0]->content() ne 'redo' )
    {
        return;
    }

    my $label   = $children[0]->snext_sibling();
    my $content = $label->content;

    my $found = 0;
  CANDIDATE:
    for my $allowed ( @{ $allowed_labels{$content} } ) {
        if ( $allowed->contains($label) ) {
            $found = 1;
            last CANDIDATE;
        }
    }
    if ( !$found ) {
        return $self->violation( $description,
            sprintf( $explanation, $content ), $label );
    }

    return;
}

sub _collect_labels {
    my ($document) = @_;
    my $compounds = $document->find(q(Statement::Compound));
    for my $compound ( @{$compounds} ) {
        for my $label ( grep { $_->isa(q(PPI::Token::Label)) }
            $compound->children )
        {
            my $content = $label->content;
            $content =~ s/:$//xms;
            $allowed_labels{$content} //= [];
            push @{ $allowed_labels{$content} }, $compound;
        }
    }
    return;
}

1;