#!/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');