<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">use strict;
use warnings;
package UNIVERSAL::isa; # git description: 1.20140927-9-g397ee12
# ABSTRACT: Attempt to recover from people calling UNIVERSAL::isa as a function

our $VERSION = '1.20150614';

use 5.006002;

use Scalar::Util ();
use warnings::register; # creates a warnings category for this module

my ( $orig, $verbose_warning );

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

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

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

our $_recursing;

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

sub _invocant_type
{
    my $invocant = shift;
    return \&amp;_nonsense unless defined($invocant);
    return \&amp;_object_or_class if Scalar::Util::blessed($invocant);
    return \&amp;_reference       if ref($invocant);
    return \&amp;_nonsense unless $invocant;
    return \&amp;_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]-&gt;can('isa') } )
    {
        unless ( $override == \&amp;UNIVERSAL::isa )
        {
            _report_warning();
            my $obj = shift;
            return $obj-&gt;$override(@_);
        }
    }

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

sub _reference
{
    _report_warning('Did you mean to use Scalar::Util::reftype() instead?')
        if $verbose_warning;
    goto &amp;$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__

=pod

=encoding UTF-8

=head1 NAME

UNIVERSAL::isa - Attempt to recover from people calling UNIVERSAL::isa as a function

=head1 VERSION

version 1.20150614

=head1 SYNOPSIS

    # from the shell
    echo 'export PERL5OPT=-MUNIVERSAL::isa' &gt;&gt; /etc/profile

    # within your program
    use UNIVERSAL::isa;

    # enable warnings for all dodgy uses of UNIVERSAL::isa
    use UNIVERSAL::isa 'verbose';

=head1 DESCRIPTION

Whenever you use L&lt;UNIVERSAL/isa&gt; as a function, a kitten using
L&lt;Test::MockObject&gt; dies. Normally, the kittens would be helpless, but if they
use L&lt;UNIVERSAL::isa&gt; (the module whose docs you are reading), the kittens can
live long and prosper.

This module replaces C&lt;UNIVERSAL::isa&gt; with a version that makes sure that,
when called as a function on objects which override C&lt;isa&gt;, C&lt;isa&gt; will call
the appropriate method on those objects

In all other cases, the real C&lt;UNIVERSAL::isa&gt; gets called directly.

B&lt;NOTE:&gt; You should use this module only for debugging purposes. It does not
belong as a dependency in running code.

=head1 WARNINGS

If the lexical warnings pragma is available, this module will emit a warning
for each naughty invocation of C&lt;UNIVERSAL::isa&gt;. Silence these warnings by
saying:

    no warnings 'UNIVERSAL::isa';

in the lexical scope of the naughty code.

After version 1.00, warnings only appear when naughty code calls
UNIVERSAL::isa() as a function on an invocant for which there is an overridden
isa().  These are really truly I&lt;active&gt; bugs, and you should fix them rather
than relying on this module to find them.

To get warnings for all potentially dangerous uses of UNIVERSAL::isa() as a
function, not a method (that is, for I&lt;all&gt; uses of the method as a function,
which are latent bugs, if not bugs that will break your code as it exists now),
pass the C&lt;verbose&gt; flag when using the module.  This can generate many extra
warnings, but they're more specific as to the actual wrong practice and they
usually suggest proper fixes.

=head1 SEE ALSO

L&lt;Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa&gt;

L&lt;UNIVERSAL::can&gt; for another discussion of the problem at hand.

L&lt;Test::MockObject&gt; for one example of a module that really needs to override
C&lt;isa()&gt;.

Any decent explanation of OO to understand why calling methods as functions is
a staggeringly bad idea.

=head1 AUTHORS

=over 4

=item *

Audrey Tang &lt;cpan@audreyt.org&gt;

=item *

chromatic &lt;chromatic@wgz.org&gt;

=item *

×™×•×‘×œ ×§×•×’'×ž×Ÿ (Yuval Kogman) &lt;nothingmuch@woobling.org&gt;

=back

=head1 CONTRIBUTORS

=for stopwords Karen Etheridge Ricardo Signes

=over 4

=item *

Karen Etheridge &lt;ether@cpan.org&gt;

=item *

Ricardo Signes &lt;rjbs@cpan.org&gt;

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by chromatic@wgz.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
</pre></body></html>