#!/usr/bin/perl -l
# once again, symbol table hacking saves the day
# (or is that 'destroys the day'?)
{
package UNIVERSAL;
BEGIN {
$old_can = \&{'can'};
# a very bizarre effect occurrs if you do this
#undef &{'can'};
*{'can'} = \&hacked_can;
}
}
require Scalar::Util;
{ package Foo;
sub new { bless {} }
sub can { print "{Foo::can called}"; sub { } }
}
{ package Bar;
sub new { bless {} }
sub ooh { }
}
{
package UNIVERSAL;
sub hacked_can {
# detect recursion from ourselves
if ((caller(2))[3] =~ /hacked_can$/) {
# print 'recursion detected';
goto $old_can;
}
return undef unless Scalar::Util::blessed($_[0]);
return $_[0]->can($_[1]);
}
}
$x = new Foo;
$y = new Bar;
print '$x can ooh? ', 0+!!UNIVERSAL::can($x, 'ooh');
print '$y can ooh? ', 0+!!UNIVERSAL::can($y, 'ooh');
print '$x can ahh? ', 0+!!UNIVERSAL::can($x, 'ahh');
print '$y can ahh? ', 0+!!UNIVERSAL::can($y, 'ahh');
|