Commit | Line | Data |
3fea05b9 |
1 | package UNIVERSAL::isa; |
2 | |
3 | use strict; |
4 | use vars qw( $VERSION $recursing ); |
5 | |
6 | use UNIVERSAL (); |
7 | |
8 | use Scalar::Util 'blessed'; |
9 | use warnings::register; |
10 | |
11 | $VERSION = '1.03'; |
12 | |
13 | my ( $orig, $verbose_warning ); |
14 | |
15 | BEGIN { $orig = \&UNIVERSAL::isa } |
16 | |
17 | no warnings 'redefine'; |
18 | |
19 | sub 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 | |
31 | sub UNIVERSAL::isa |
32 | { |
33 | goto &$orig if $recursing; |
34 | my $type = invocant_type(@_); |
35 | $type->(@_); |
36 | } |
37 | |
38 | sub invocant_type |
39 | { |
40 | my $invocant = shift; |
41 | return \&nonsense unless defined($invocant); |
42 | return \&object_or_class if blessed($invocant); |
43 | return \&reference if ref($invocant); |
44 | return \&nonsense unless $invocant; |
45 | return \&object_or_class; |
46 | } |
47 | |
48 | sub nonsense |
49 | { |
50 | report_warning('on invalid invocant') if $verbose_warning; |
51 | return; |
52 | } |
53 | |
54 | sub object_or_class |
55 | { |
56 | |
57 | local $@; |
58 | local $recursing = 1; |
59 | |
60 | if ( my $override = eval { $_[0]->can('isa') } ) |
61 | { |
62 | unless ( $override == \&UNIVERSAL::isa ) |
63 | { |
64 | report_warning(); |
65 | my $obj = shift; |
66 | return $obj->$override(@_); |
67 | } |
68 | } |
69 | |
70 | report_warning() if $verbose_warning; |
71 | goto &$orig; |
72 | } |
73 | |
74 | sub reference |
75 | { |
76 | report_warning('Did you mean to use Scalar::Util::reftype() instead?') |
77 | if $verbose_warning; |
78 | goto &$orig; |
79 | } |
80 | |
81 | sub report_warning |
82 | { |
83 | my $extra = shift; |
84 | $extra = $extra ? " ($extra)" : ''; |
85 | |
86 | if ( warnings::enabled() ) |
87 | { |
88 | my $calling_sub = ( caller(3) )[3] || ''; |
89 | return if $calling_sub =~ /::isa$/; |
90 | warnings::warn( |
91 | "Called UNIVERSAL::isa() as a function, not a method$extra" ); |
92 | } |
93 | } |
94 | |
95 | __PACKAGE__; |
96 | |
97 | __END__ |
98 | |
99 | =pod |
100 | |
101 | =head1 NAME |
102 | |
103 | UNIVERSAL::isa - Attempt to recover from people calling UNIVERSAL::isa as a |
104 | function |
105 | |
106 | =head1 SYNOPSIS |
107 | |
108 | # from the shell |
109 | echo 'export PERL5OPT=-MUNIVERSAL::isa' >> /etc/profile |
110 | |
111 | # within your program |
112 | use UNIVERSAL::isa; |
113 | |
114 | # enable warnings for all dodgy uses of UNIVERSAL::isa |
115 | use UNIVERSAL::isa 'verbose'; |
116 | |
117 | =head1 DESCRIPTION |
118 | |
119 | Whenever you use L<UNIVERSAL/isa> as a function, a kitten using |
120 | L<Test::MockObject> dies. Normally, the kittens would be helpless, but if they |
121 | use L<UNIVERSAL::isa> (the module whose docs you are reading), the kittens can |
122 | live long and prosper. |
123 | |
124 | This module replaces C<UNIVERSAL::isa> with a version that makes sure that, |
125 | when called as a function on objects which override C<isa>, C<isa> will call |
126 | the appropriate method on those objects |
127 | |
128 | In all other cases, the real C<UNIVERSAL::isa> gets called directly. |
129 | |
130 | =head1 WARNINGS |
131 | |
132 | If the lexical warnings pragma is available, this module will emit a warning |
133 | for each naughty invocation of C<UNIVERSAL::isa>. Silence these warnings by |
134 | saying: |
135 | |
136 | no warnings 'UNIVERSAL::isa'; |
137 | |
138 | in the lexical scope of the naughty code. |
139 | |
140 | After version 1.00, warnings only appear when naughty code calls |
141 | UNIVERSAL::isa() as a function on an invocant for which there is an overridden |
142 | isa(). These are really truly I<active> bugs, and you should fix them rather |
143 | than relying on this module to find them. |
144 | |
145 | To get warnings for all potentially dangerous uses of UNIVERSAL::isa() as a |
146 | function, not a method (that is, for I<all> uses of the method as a function, |
147 | which are latent bugs, if not bugs that will break your code as it exists now), |
148 | pass the C<verbose> flag when using the module. This can generate many extra |
149 | warnings, but they're more specific as to the actual wrong practice and they |
150 | usually suggest proper fixes. |
151 | |
152 | =head1 SEE ALSO |
153 | |
154 | L<UNIVERSAL::can> for another discussion of the problem at hand. |
155 | |
156 | L<Test::MockObject> for one example of a module that really needs to override |
157 | C<isa()>. |
158 | |
159 | Any decent explanation of OO to understand why calling methods as functions is |
160 | a staggeringly bad idea. |
161 | |
162 | =head1 AUTHORS |
163 | |
164 | Audrey Tang <cpan@audreyt.org> |
165 | |
166 | chromatic <chromatic@wgz.org> |
167 | |
168 | Yuval Kogman <nothingmuch@woobling.org> |
169 | |
170 | =head1 COPYRIGHT & LICENSE |
171 | |
172 | Artistic Licence 2.0, (c) 2005 - 2009. |
173 | |
174 | =cut |