Tue Apr 4 16:20:55 EDT 2006 Michael G Schwern <schwern@pobox.com>
* Fix it so isa() triggers autouse
use Class::Autouse;
Class::Autouse->autouse('Foo');
print Foo->isa('Foo::Superclass'); # failed because Foo was not loaded.
diff -rN -u old-Class-Autouse-1.24/lib/Class/Autouse.pm new-Class-Autouse-1.24/lib/Class/Autouse.pm
--- old-Class-Autouse-1.24/lib/Class/Autouse.pm 2006-04-04 16:23:34.000000000 -0400
+++ new-Class-Autouse-1.24/lib/Class/Autouse.pm 2006-04-04 16:23:34.000000000 -0400
@@ -32,14 +32,16 @@
# Globals
use vars qw{ $VERSION $DEVEL $SUPERLOAD $NOSTAT }; # Load environment
use vars qw{ %SPECIAL %LOADED %BAD }; # Special cases
-use vars qw{ $HOOKS %chased *_UNIVERSAL_can }; # Working information
+# Working information
+use vars qw{ $HOOKS %chased $UNIVERSAL_can $UNIVERSAL_isa };
# Compile-time Initialisation and Optimisation
BEGIN {
$VERSION = '1.24';
- # We play with UNIVERSAL::can at times, so save a backup copy
- *_UNIVERSAL_can = *UNIVERSAL::can{CODE};
+ # We play with UNIVERSAL::can and isa at times, so save a backup copy
+ $UNIVERSAL_can = \&UNIVERSAL::can;
+ $UNIVERSAL_isa = \&UNIVERSAL::isa;
# We always start with the superloader off
$SUPERLOAD = 0;
@@ -105,7 +107,7 @@
# Because this will never go away, we increment $HOOKS such
# that it will never be decremented, and this the
# UNIVERSAL::can hijack will never be removed.
- _UPDATE_CAN() unless $HOOKS++;
+ _UPDATE_HOOKS() unless $HOOKS++;
}
$SUPERLOAD = 1;
@@ -160,7 +162,7 @@
$INC{$file} = 'Class::Autouse';
# When we add the first hook, hijack UNIVERSAL::can
- _UPDATE_CAN() unless $HOOKS++;
+ _UPDATE_HOOKS() unless $HOOKS++;
}
1;
@@ -297,13 +299,22 @@
_debug(\@_) if defined DEBUG;
}
-# This is the replacement for UNIVERSAL::can
-sub _can {
+
+sub _can {
+ _preload_class($UNIVERSAL_can, @_)
+}
+
+sub _isa {
+ _preload_class($UNIVERSAL_isa, @_)
+}
+
+sub _preload_class {
+ my $real_sub = shift;
my $class = ref $_[0] || $_[0] || return undef;
# Shortcut for the most likely cases
if ( $LOADED{$class} or defined @{"${class}::ISA"} ) {
- goto &_UNIVERSAL_can;
+ goto &{$real_sub};
}
# Does it look like a package?
@@ -335,14 +346,13 @@
die $@ if $@;
}
- # Hand off to the real UNIVERSAL::can
- goto &_UNIVERSAL_can;
+ # Hand off to the real subroutine
+ goto &{$real_sub};
}
-
#####################################################################
# Support Functions
@@ -383,7 +393,7 @@
_cry($@) if $@;
# Give back UNIVERSAL::can if there are no other hooks
- --$HOOKS or _UPDATE_CAN();
+ --$HOOKS or _UPDATE_HOOKS();
$LOADED{$class} = 1;
}
@@ -550,12 +560,16 @@
#####################################################################
# Final Initialisation
-# The _UPDATE_CAN function is intended to turn our hijacking of UNIVERSAL::can
-# on or off, depending on whether we have any live hooks. The idea being, if we
-# don't have any live hooks, why bother intercepting UNIVERSAL::can calls?
-sub _UPDATE_CAN () {
+# The _UPDATE_HOOKS function is intended to turn our hijacking of UNIVERSAL
+# methods on or off, depending on whether we have any live hooks. The idea
+# being, if we don't have any live hooks, why bother intercepting
+# UNIVERSAL::can calls?
+sub _UPDATE_HOOKS () {
local $^W = 0;
- *UNIVERSAL::can = $HOOKS ? *_can{CODE} : *_UNIVERSAL_can{CODE};
+ *UNIVERSAL::can = $HOOKS ? \&_can
+ : $UNIVERSAL_can;
+ *UNIVERSAL::isa = $HOOKS ? \&_isa
+ : $UNIVERSAL_isa;
}
BEGIN {
diff -rN -u old-Class-Autouse-1.24/t/01_main.t new-Class-Autouse-1.24/t/01_main.t
--- old-Class-Autouse-1.24/t/01_main.t 2006-04-04 16:23:33.000000000 -0400
+++ new-Class-Autouse-1.24/t/01_main.t 2006-04-04 16:23:34.000000000 -0400
@@ -43,15 +43,15 @@
# Does ->can for an autoused class correctly load the class and find the method.
my $class = 'D';
-ok( refaddr(*UNIVERSAL::can{CODE}), "We know which version of UNIVERSAL::can we are using" );
-is( refaddr(*UNIVERSAL::can{CODE}), refaddr(*Class::Autouse::_UNIVERSAL_can{CODE}),
+ok( refaddr(\&UNIVERSAL::can), "We know which version of UNIVERSAL::can we are using" );
+is( refaddr(\&UNIVERSAL::can), refaddr($Class::Autouse::UNIVERSAL_can),
"Before autoloading, UNIVERSAL::can is in it's original state, and has been backed up");
ok( Class::Autouse->autouse( $class ), "Test class '$class' autoused ok" );
-is( refaddr(*UNIVERSAL::can{CODE}), refaddr(*Class::Autouse::_can{CODE}),
+is( refaddr(\&UNIVERSAL::can), refaddr(\&Class::Autouse::_can),
"After autoloading, UNIVERSAL::can has been correctly hijacked");
ok( $class->can('method2'), "'can' found sub 'method2' in autoused class '$class'" );
ok( $Class::Autouse::LOADED{$class}, "'can' loaded class '$class' while looking for 'method2'" );
-is( refaddr(*UNIVERSAL::can{CODE}), refaddr(*Class::Autouse::_UNIVERSAL_can{CODE}),
+is( refaddr(\&UNIVERSAL::can), refaddr($Class::Autouse::UNIVERSAL_can),
"When all classes are loaded, UNIVERSAL::can reverts back to the original states");
# Use the loaded hash again to avoid a warning
diff -rN -u old-Class-Autouse-1.24/t/07_isa.t new-Class-Autouse-1.24/t/07_isa.t
--- old-Class-Autouse-1.24/t/07_isa.t 1969-12-31 19:00:00.000000000 -0500
+++ new-Class-Autouse-1.24/t/07_isa.t 2006-04-04 16:23:34.000000000 -0400
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -wl
+
+use strict;
+use lib ();
+use File::Spec::Functions ':ALL';
+BEGIN {
+ $| = 1;
+ if ( $ENV{HARNESS_ACTIVE} ) {
+ lib->import( catdir( curdir(), 't', 'modules' ) );
+ } else {
+ require FindBin;
+ chdir ($FindBin::Bin = $FindBin::Bin); # Avoid a warning
+ lib->import( 'modules' );
+ }
+}
+
+use Test::More tests => 2;
+use Scalar::Util 'refaddr';
+
+use Class::Autouse;
+Class::Autouse->autouse('baseB');
+
+ok( baseB->isa('baseA'), 'isa() triggers autouse' );
+
+is( refaddr(\&UNIVERSAL::isa), refaddr($Class::Autouse::UNIVERSAL_isa),
+ 'UNIVERSAL::isa() is restored once all classes are loaded' );
