File Coverage

blib/lib/Package/Watchdog/Sub/Forbidden.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	11	14	78.5
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	54	57	94.7

package Package::Watchdog::Sub::Forbidden;
use strict;
use warnings;
use Package::Watchdog::Util;
use base 'Package::Watchdog::Sub';
use Carp;

#{{{ POD

=pod

=head1 NAME

Package::Watchdog::Sub::Forbidden - Object to manage a forbidden sub.

=head1 DESCRIPTION

Inherits methods from Package::Watchdog::Sub.

=head1 METHODS

=over 4

=item new_sub()

Returns the sub reference that will replace the original forbidden sub.

=cut

#}}}

sub new_sub {
    my $self = shift;

    return sub {
        my %seen;
        for my $call ( @{ $self->tracker->stack }) {
            my ( $watch, $watch_context ) = @$call;

            my $react = $watch->react;
            next if $seen{ $react }++;
            my $fatal = $react eq 'die' ? 'fatal' : undef;

            my $context = {
                watch => $watch,
                %$watch_context,
                forbidden => $self,
                forbidden_params => [ @_ ],
                forbid => $self->tracker,
            };

            if ( ref( $react )) {
                $watch->do_react( %$context );
            }
            else {
                $watch->warn( $context, $fatal );
                croak( 'At least one watch with a die reaction has been triggered.' )
                    if $fatal;
            }
        }

        my $want = wantarray();
        my @out = proper_return( $want, $self->original, @_ );
        return @out if $want;
        return shift( @out ) if defined( $want );
        return @out if @out > 1;
        return shift( @out );
    };
}

1;

__END__