File Coverage

blib/lib/Caller/Hide.pm

Criterion	Covered	Total	%
statement	35	36	97.2
branch	14	16	87.5
condition	5	5	100.0
subroutine	9	9	100.0
pod	2	2	100.0
total	65	68	95.5

package Caller::Hide;
use strict;
use warnings;
use version 0.77; our $VERSION = version->declare('v0.0.1');
use parent 'Exporter';
use Carp;

our @EXPORT_OK   = qw[ hide_package reveal_package ];
our %EXPORT_TAGS = (ALL => \@EXPORT_OK);

my %hidden;

{    # adapted from Hook::LexWrap
    no warnings 'redefine';
    *CORE::GLOBAL::caller = sub (;$) {
        my ($height) = ($_[0] || 0);
        my $i = 1;
        my $name_cache;
        while (1) {
            my @caller
                = CORE::caller() eq 'DB'
                ? do { package DB; CORE::caller($i++) }
                : CORE::caller($i++);
            return if not @caller;
            $caller[3] = $name_cache if $name_cache;
            $name_cache = $hidden{ $caller[0] } ? $caller[3] : '';
            next if $name_cache || $height-- != 0;
            return wantarray ? @_ ? @caller : @caller[ 0 .. 2 ] : $caller[0];
        }
    };
}

sub hide_package {
    my ($package) = @_;
    $hidden{$package} = 1;
    return;
}

sub reveal_package {
    my ($package) = @_;
    Carp::carp "$package not hidden" if not $hidden{$package};

    delete $hidden{$package};
    return;
}

1;
__END__