File Coverage

blib/lib/UNIVERSAL/isa.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	30	34	88.2
condition	3	6	50.0
subroutine	17	17	100.0
pod	1	1	100.0
total	114	121	94.2

package UNIVERSAL::isa;
# git description: 1.20140824-2-g1cfb04c
$UNIVERSAL::isa::VERSION = '1.20140927';
# ABSTRACT: Attempt to recover from people calling UNIVERSAL::isa as a function

use strict;
use warnings;
use 5.6.2;

use UNIVERSAL ();
use Scalar::Util 'blessed';
use warnings::register;

my ( $orig, $verbose_warning );

BEGIN { $orig = \&UNIVERSAL::isa }

sub import
{
    my $class = shift;
    no strict 'refs';

    for my $arg (@_)
    {
        *{ caller() . '::isa' } = \&UNIVERSAL::isa if $arg eq 'isa';
        $verbose_warning = 1 if $arg eq 'verbose';
    }
}

our $_recursing;

no warnings 'redefine';
sub UNIVERSAL::isa
{
    goto &$orig if $_recursing;
    my $type = _invocant_type(@_);
    $type->(@_);
}
use warnings;

sub _invocant_type
{
    my $invocant = shift;
    return \&_nonsense unless defined($invocant);
    return \&_object_or_class if blessed($invocant);
    return \&_reference       if ref($invocant);
    return \&_nonsense unless $invocant;
    return \&_object_or_class;
}

sub _nonsense
{
    _report_warning('on invalid invocant') if $verbose_warning;
    return;
}

sub _object_or_class
{
    local $@;
    local $_recursing = 1;

    if ( my $override = eval { $_[0]->can('isa') } )
    {
        unless ( $override == \&UNIVERSAL::isa )
        {
            _report_warning();
            my $obj = shift;
            return $obj->$override(@_);
        }
    }

    _report_warning() if $verbose_warning;
    goto &$orig;
}

sub _reference
{
    _report_warning('Did you mean to use Scalar::Util::reftype() instead?')
        if $verbose_warning;
    goto &$orig;
}

sub _report_warning
{
    my $extra = shift;
    $extra = $extra ? " ($extra)" : '';

    if ( warnings::enabled() )
    {
        # check calling sub
        return if (( caller(3) )[3] || '') =~ /::isa$/;
        # check calling package - exempt Test::Builder??
        return if (( caller(3) )[0] || '') =~ /^Test::Builder/;
        return if (( caller(2) )[0] || '') =~ /^Test::Stream/;

        warnings::warn(
            "Called UNIVERSAL::isa() as a function, not a method$extra" );
    }
}

__PACKAGE__;

__END__