File Coverage

blib/lib/Sub/Apply.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	7	8	87.5
condition	4	6	66.6
subroutine	9	9	100.0
pod	2	2	100.0
total	61	64	95.3

package Sub::Apply;

use 5.008008;
use strict;
use warnings;
use parent 'Exporter';
use Carp ();

our $VERSION   = '0.06';
our @EXPORT_OK = qw(apply apply_if);

our $WARNING = 0;

sub apply {
    my $orig   = shift;
    my $caller = caller;
    my $proc   = _find_proc( $caller, $orig );
    Carp::croak "No such proc $orig" unless $proc;
    $proc->(@_);
}

sub apply_if {
    my $orig   = shift;
    my $caller = caller;
    my $proc   = _find_proc( $caller, $orig );
    unless ( $proc ) {
        Carp::carp "No such proc $orig" if $WARNING;
        return;
    }
    $proc->(@_);
}

sub _find_proc {
    my ( $caller, $proc ) = @_;
    ( my $package, $proc ) = $proc =~ m/^(?:(.+)::)?(.+)$/;
    $package ||= $caller;
    my $code = do {
        no strict 'refs';
        my $stash = \%{ $package . '::' };
        $stash && $stash->{$proc} && *{ $stash->{$proc} }{CODE};
    };
    return $code;
}

1;
__END__