1use strict; 2use warnings; 3package UNIVERSAL::isa; # git description: 1.20150614-11-gdfa589a 4# ABSTRACT: Attempt to recover from people calling UNIVERSAL::isa as a function 5 6our $VERSION = '1.20171012'; 7 8use 5.006002; 9 10use Scalar::Util (); 11use warnings::register; # creates a warnings category for this module 12 13my ( $orig, $verbose_warning ); 14 15BEGIN { $orig = \&UNIVERSAL::isa } 16 17sub original_isa { goto $orig } 18 19sub import 20{ 21 my $class = shift; 22 no strict 'refs'; 23 24 for my $arg (@_) 25 { 26 *{ caller() . '::isa' } = \&UNIVERSAL::isa if $arg eq 'isa'; 27 $verbose_warning = 1 if $arg eq 'verbose'; 28 } 29} 30 31our $_recursing; 32 33no warnings 'redefine'; 34sub UNIVERSAL::isa 35{ 36 goto &original_isa if $_recursing; 37 my $type = _invocant_type(@_); 38 $type->(@_); 39} 40use warnings; 41 42sub _invocant_type 43{ 44 my $invocant = shift; 45 return \&_nonsense unless defined($invocant); 46 return \&_object_or_class if Scalar::Util::blessed($invocant); 47 return \&_reference if ref($invocant); 48 return \&_nonsense unless $invocant; 49 return \&_object_or_class; 50} 51 52sub _nonsense 53{ 54 _report_warning('on invalid invocant') if $verbose_warning; 55 return; 56} 57 58sub _object_or_class 59{ 60 local $@; 61 local $_recursing = 1; 62 63 if ( my $override = eval { $_[0]->can('isa') } ) 64 { 65 unless ( $override == \&UNIVERSAL::isa ) 66 { 67 _report_warning(); 68 my $obj = shift; 69 return $obj->$override(@_); 70 } 71 } 72 73 _report_warning() if $verbose_warning; 74 goto &original_isa; 75} 76 77sub _reference 78{ 79 _report_warning('Did you mean to use Scalar::Util::reftype() instead?') 80 if $verbose_warning; 81 goto &original_isa; 82} 83 84sub _report_warning 85{ 86 my $extra = shift; 87 $extra = $extra ? " ($extra)" : ''; 88 89 if ( warnings::enabled() ) 90 { 91 # check calling sub 92 return if (( caller(3) )[3] || '') =~ /::isa$/; 93 # check calling package - exempt Test::Builder?? 94 return if (( caller(3) )[0] || '') =~ /^Test::Builder/; 95 return if (( caller(2) )[0] || '') =~ /^Test::Stream/; 96 97 warnings::warn( 98 "Called UNIVERSAL::isa() as a function, not a method$extra" ); 99 } 100} 101 102__PACKAGE__; 103 104__END__ 105 106=pod 107 108=encoding UTF-8 109 110=head1 NAME 111 112UNIVERSAL::isa - Attempt to recover from people calling UNIVERSAL::isa as a function 113 114=head1 VERSION 115 116version 1.20171012 117 118=head1 SYNOPSIS 119 120 # from the shell 121 echo 'export PERL5OPT=-MUNIVERSAL::isa' >> /etc/profile 122 123 # within your program 124 use UNIVERSAL::isa; 125 126 # enable warnings for all dodgy uses of UNIVERSAL::isa 127 use UNIVERSAL::isa 'verbose'; 128 129=head1 DESCRIPTION 130 131Whenever you use L<UNIVERSAL/isa> as a function, a kitten using 132L<Test::MockObject> dies. Normally, the kittens would be helpless, but if they 133use L<UNIVERSAL::isa> (the module whose docs you are reading), the kittens can 134live long and prosper. 135 136This module replaces C<UNIVERSAL::isa> with a version that makes sure that, 137when called as a function on objects which override C<isa>, C<isa> will call 138the appropriate method on those objects 139 140In all other cases, the real C<UNIVERSAL::isa> gets called directly. 141 142B<NOTE:> You should use this module only for debugging purposes. It does not 143belong as a dependency in running code. 144 145=head1 FUNCTIONS 146 147=head2 original_isa 148 149This sub contains the definition of the I<original> C<UNIVERSAL::isa> 150definition, in case you need it. 151 152=head1 WARNINGS 153 154If the lexical warnings pragma is available, this module will emit a warning 155for each naughty invocation of C<UNIVERSAL::isa>. Silence these warnings by 156saying: 157 158 no warnings 'UNIVERSAL::isa'; 159 160in the lexical scope of the naughty code. 161 162After version 1.00, warnings only appear when naughty code calls 163UNIVERSAL::isa() as a function on an invocant for which there is an overridden 164isa(). These are really truly I<active> bugs, and you should fix them rather 165than relying on this module to find them. 166 167To get warnings for all potentially dangerous uses of UNIVERSAL::isa() as a 168function, not a method (that is, for I<all> uses of the method as a function, 169which are latent bugs, if not bugs that will break your code as it exists now), 170pass the C<verbose> flag when using the module. This can generate many extra 171warnings, but they're more specific as to the actual wrong practice and they 172usually suggest proper fixes. 173 174=head1 SEE ALSO 175 176L<Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa> 177 178L<UNIVERSAL::can> for another discussion of the problem at hand. 179 180L<Test::MockObject> for one example of a module that really needs to override 181C<isa()>. 182 183Any decent explanation of OO to understand why calling methods as functions is 184a staggeringly bad idea. 185 186=head1 SUPPORT 187 188Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=UNIVERSAL-isa> 189(or L<bug-UNIVERSAL-isa@rt.cpan.org|mailto:bug-UNIVERSAL-isa@rt.cpan.org>). 190 191=head1 AUTHORS 192 193=over 4 194 195=item * 196 197Audrey Tang <cpan@audreyt.org> 198 199=item * 200 201chromatic <chromatic@wgz.org> 202 203=item * 204 205יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> 206 207=back 208 209=head1 CONTRIBUTORS 210 211=for stopwords Karen Etheridge Graham Knop Ricardo Signes 212 213=over 4 214 215=item * 216 217Karen Etheridge <ether@cpan.org> 218 219=item * 220 221Graham Knop <haarg@haarg.org> 222 223=item * 224 225Ricardo Signes <rjbs@cpan.org> 226 227=back 228 229=head1 COPYRIGHT AND LICENCE 230 231This software is copyright (c) 2011 by chromatic@wgz.org. 232 233This is free software; you can redistribute it and/or modify it under 234the same terms as the Perl 5 programming language system itself. 235 236=cut 237