File Coverage

blib/lib/Class/Autouse.pm

Criterion	Covered	Total	%
statement	2017	2059	97.9
branch	148	214	69.1
condition	33	51	64.7
subroutine	607	609	99.6
pod	8	9	88.8
total	2813	2942	95.6

package Class::Autouse;

# See POD at end of file for documentation

use 5.006;
use strict;
no strict 'refs'; # We _really_ abuse refs :)
use UNIVERSAL ();

# Load required modules
# Luckily, these are so common they are basically free
use Carp            ();
use Exporter        ();
use File::Spec 0.80 ();
use List::Util 1.18 ();
use Scalar::Util    ();

# Globals
use vars qw{ $VERSION @ISA $DB $DEBUG };
use vars qw{ $DEVEL $SUPERLOAD $NOSTAT $NOPREBLESS $STATICISA   }; # Load environment
use vars qw{ %SPECIAL %LOADED %BAD %TRIED_CLASS %TRIED_METHOD   }; # Special cases
use vars qw{ @LOADERS @SUGAR $HOOKS $ORIGINAL_CAN $ORIGINAL_ISA }; # Working information

# Handle optimisation switches via constants to allow debugging and
# similar functions to be optimised out at compile time if not in use.
BEGIN {
	$DB    = 0 unless defined &DB::DB;
	$DEBUG = 0 unless defined $DEBUG;
}
use constant DB    => !! $DB;
use constant DEBUG => !! $DEBUG;
print "Class::Autouse -> Debugging Activated.\n" if DEBUG;

# Compile-time Initialisation and Optimisation
BEGIN {
	$VERSION = '2.01';

	# Become an exporter so we don't get complaints when we act as a pragma.
	# I don't fully understand the reason for this, but it works and I can't
	# recall how to replicate the problem, so leaving it in to avoid any
	# possible reversion. Besides, so many things use Exporter it should
	# be practically free to do this.
	@ISA = qw{ Exporter };

	# We always start with the superloader off
	$SUPERLOAD = 0;

	# When set, disables $obj->isa/can where $obj is blessed before its class is loaded
	# Things will operate more quickly when set, but this breaks things if you're
	# unserializing objects from Data::Dumper, etc., and relying on this module to
	# load the related classes on demand.
	$NOPREBLESS = 0;

	# Disable stating for situations where modules are on remote disks
	$NOSTAT = 0;

	# AUTOLOAD hook counter
	$HOOKS = 0;

	# ERRATA
	# Special classes are internal and should be left alone.
	# Loaded modules are those already loaded by us.
	# Bad classes are those that are incompatible with us.
	%BAD = map { $_ => 1 } qw{
		IO::File
	};

	%SPECIAL = map { $_ => 1 } qw{
		CORE  main UNIVERSAL
		ARRAY HASH SCALAR REF GLOB
	};

	%LOADED = map { $_ => 1 } qw{
		UNIVERSAL
		Carp
		Exporter
		File::Spec
		List::Util
		Scalar::Util
		Class::Autouse
	};

	# "Have we tried to autoload a class before?"
	# Per-class loop protection and improved shortcutting.
	# Defaults to specials+preloaded to prevent attempting them.
	%TRIED_CLASS = ( %SPECIAL, %LOADED );

	# "Have we tried to autoload a method before?"
	# Per-method loop protection and improved shortcutting
	%TRIED_METHOD = ();

	# Storage for dynamic loaders (regular and sugar)
	@LOADERS = ();
	@SUGAR   = ();

	# We play with UNIVERSAL:: functions, so save backup copies
	$ORIGINAL_CAN = \&UNIVERSAL::can;
	$ORIGINAL_ISA = \&UNIVERSAL::isa;
}





#####################################################################
# Configuration and Setting up

# Developer mode flag.
# Cannot be turned off once turned on.
sub devel {
	_debug(\@_, 1) if DEBUG;

	# Enable if not already
	return 1 if $DEVEL++;

	# Load any unloaded modules.
	# Most of the time there should be nothing here.
	foreach my $class ( grep { $INC{$_} eq 'Class::Autouse' } keys %INC ) {
		$class =~ s/\//::/;
		$class =~ s/\.pm$//i;
		Class::Autouse->load($class);
	}
}

# Happy Fun Super Loader!
# The process here is to replace the &UNIVERSAL::AUTOLOAD sub
# ( which is just a dummy by default ) with a flexible class loader.
sub superloader {
	_debug(\@_, 1) if DEBUG;

	# Shortcut if needed
	return 1 if $SUPERLOAD++;

	# Enable the global hooks
	_GLOBAL_HOOKS();

	return 1;
}

sub sugar {
	# Operate as a function or a method
	shift if $_[0] eq 'Class::Autouse';

	# Ignore calls with no arguments
	return 1 unless @_;

	_debug(\@_) if DEBUG;

	foreach my $callback ( grep { $_ } @_ ) {
		# Handle a callback or regex
		unless ( ref $callback eq 'CODE' ) {
			die(
				__PACKAGE__
				. ' takes a code reference for syntactic sugar handlers'
				. ": unexpected value $callback has type "
				. ref($callback)
			);
		}
		push @SUGAR, $callback;

		# Enable global hooking
		_GLOBAL_HOOKS();
	}

	return 1;
}

# The main autouse sub
sub autouse {
	# Operate as a function or a method
	shift if $_[0] eq 'Class::Autouse';

	# Ignore calls with no arguments
	return 1 unless @_;

	_debug(\@_) if DEBUG;

	foreach my $class ( grep { $_ } @_ ) {
		if ( ref $class ) {
			unless ( ref $class eq 'Regexp' or ref $class eq 'CODE') {
				die( __PACKAGE__
					. ' can autouse explicit class names, or take a regex or subroutine reference'
					. ": unexpected value $class has type "
					. ref($class)
				);
			}
			push @LOADERS, $class;

			# Enable the global hooks
			_GLOBAL_HOOKS();

			# Reset shortcut cache, since we may have previously
			# tried a class and failed, which could now work
			%TRIED_CLASS = ( %SPECIAL, %LOADED );
			next;
		}

		# Control flag handling
		if ( substr($class, 0, 1) eq ':' ) {
			if ( $class eq ':superloader' ) {
				# Turn on the superloader
				Class::Autouse->superloader;
			} elsif ( $class eq ':devel' ) {
				# Turn on devel mode
				Class::Autouse->devel(1);
			} elsif ( $class eq ':nostat' ) {
				# Disable stat checks
				$NOSTAT = 1;
			} elsif ( $class eq ':noprebless') {
				# Disable support for objects blessed before their class module is loaded
				$NOPREBLESS = 1;
			} elsif ( $class eq ':staticisa') {
				# Expect that @ISA won't change after loading
				# This allows some performance tweaks
				$STATICISA = 1;
			}
			next;
		}

		# Load now if in devel mode, or if its a bad class
		if ( $DEVEL || $BAD{$class} ) {
			Class::Autouse->load($class);
			next;
		}

		# Does the file for the class exist?
		my $file = _class_file($class);
		next if exists $INC{$file};
		unless ( $NOSTAT or _file_exists($file) ) {
			my $inc = join ', ', @INC;
			_cry("Can't locate $file in \@INC (\@INC contains: $inc)");
		}

		# Don't actually do anything if the superloader is on.
		# It will catch all AUTOLOAD calls.
		next if $SUPERLOAD;

		# Add the AUTOLOAD hook and %INC lock to prevent 'use'ing
		*{"${class}::AUTOLOAD"} = \&_AUTOLOAD;
		$INC{$file} = 'Class::Autouse';

		# When we add the first hook, hijack UNIVERSAL::can/isa
		_UPDATE_HOOKS() unless $HOOKS++;
	}

	return 1;
}

# Import behaves the same as autouse
sub import {
	shift->autouse(@_);
}





#####################################################################
# Explicit Actions

# Completely load a class ( The class and all its dependencies ).
sub load {
	_debug(\@_, 1) if DEBUG;

	my $class = $_[1] or _cry('No class name specified to load');
	return 1 if $LOADED{$class};

	my @search = _super( $class, \&_load );

	# If called an an array context, return the ISA tree.
	# In scalar context, just return true.
	wantarray ? @search : 1;
}

# Is a particular class installed in out @INC somewhere
# OR is it loaded in our program already
sub class_exists {
	_debug(\@_, 1) if DEBUG;
	_namespace_occupied($_[1]) or _file_exists($_[1]);
}

# A more general method to answer the question
# "Can I call a method on this class and expect it to work"
# Returns undef if the class does not exist
# Returns 0 if the class is not loaded ( or autouse'd )
# Returns 1 if the class can be used.
sub can_call_methods {
	_debug(\@_, 1) if DEBUG;
	_namespace_occupied($_[1]) or exists $INC{_class_file($_[1])};
}

# Recursive methods currently only work withing the scope of the single @INC
# entry containing the "top" module, and will probably stay this way

# Autouse not only a class, but all others below it.
sub autouse_recursive {
	_debug(\@_, 1) if DEBUG;

	# Just load if in devel mode
	return Class::Autouse->load_recursive($_[1]) if $DEVEL;

	# Don't need to do anything if the super loader is on
	return 1 if $SUPERLOAD;

	# Find all the child classes, and hand them to the autouse method
	Class::Autouse->autouse( $_[1], _children($_[1]) );
}

# Load not only a class and all others below it
sub load_recursive {
	_debug(\@_, 1) if DEBUG;

	# Load the parent class, and its children
	foreach ( $_[1], _children($_[1]) ) {
		Class::Autouse->load($_);
	}

	return 1;
}





#####################################################################
# Symbol Table Hooks

# These get hooked to various places on the symbol table,
# to enable the autoload functionality

# Linked to each individual class via the symbol table
sub _AUTOLOAD {
	_debug(\@_, 0, ", AUTOLOAD = '$Class::Autouse::AUTOLOAD'") if DEBUG;

	# Loop detection (just in case)
	my $method = $Class::Autouse::AUTOLOAD or _cry('Missing method name');
	_cry("Undefined subroutine &$method called") if ++$TRIED_METHOD{$method} > 10;

	# Don't bother with special classes
	my ($class, $function) = $method =~ m/^(.*)::(.*)\z/s;
	_cry("Undefined subroutine &$method called") if $SPECIAL{$class};

	# Load the class and it's dependancies, and get the search path
	my @search = Class::Autouse->load($class);

	# Find and go to the named method
	my $found = List::Util::first {
		defined *{"${_}::$function"}{CODE}
	} @search;
	goto &{"${found}::$function"} if $found;

	# Check for package AUTOLOADs
	foreach my $c ( @search ) {
		if ( defined *{"${c}::AUTOLOAD"}{CODE} ) {
			# Simulate a normal autoload call
			${"${c}::AUTOLOAD"} = $method;
			goto &{"${c}::AUTOLOAD"};
		}
	}

	# Can't find the method anywhere. Throw the same error Perl does.
	_cry("Can't locate object method \"$function\" via package \"$class\"");
}

# This is a special version of the above for use in UNIVERSAL
# It does the :superloader, and/or also any regex or callback (code ref) loaders
sub _UNIVERSAL_AUTOLOAD {
	_debug(\@_, 0, ", \$AUTOLOAD = '$Class::Autouse::AUTOLOAD'") if DEBUG;

	# Loop detection ( Just in case )
	my $method = $Class::Autouse::AUTOLOAD or _cry('Missing method name');
	_cry("Undefined subroutine &$method called") if ++$TRIED_METHOD{ $method } > 10;

	# Don't bother with special classes
	my ($class, $function) = $method =~ m/^(.*)::(.*)\z/s;
	_cry("Undefined subroutine &$method called") if $SPECIAL{$class};

	my @search;
	if ( $SUPERLOAD ) {
		# Only try direct loading of the class if the superloader is active.
		# This might be installed in universal for either the superloader, special loaders, or both.

		# Load the class and it's dependancies, and get the search path
		@search = Class::Autouse->load($class);
	}

	unless ( @search ) {
		# The special loaders will attempt to dynamically instantiate the class.
		# They will not fire if the superloader is turned on and has already loaded the class.
		if ( _try_loaders($class, $function, @_) ) {
			my $fref = $ORIGINAL_CAN->($class, $function);
			if ( $fref ) {
				goto $fref;
			} else {
				@search = _super($class);
			}
		}
	}

	# Find and go to the named method
	my $found = List::Util::first { defined *{"${_}::$function"}{CODE} } @search;
	goto &{"${found}::$function"} if $found;

	# Check for package AUTOLOADs
	foreach my $c ( @search ) {
		if ( defined *{"${c}::AUTOLOAD"}{CODE} ) {
			# Simulate a normal autoload call
			${"${c}::AUTOLOAD"} = $method;
			goto &{"${c}::AUTOLOAD"};
		}
	}

	for my $callback ( @SUGAR ) {
		my $rv = $callback->( $class, $function, @_ );
		goto $rv if $rv;
	}

	# Can't find the method anywhere. Throw the same error Perl does.
	_cry("Can't locate object method \"$function\" via package \"$class\"");
}

# This just handles the call and does nothing.
# It prevents destroy calls going through to the AUTOLOAD hooks.
sub _UNIVERSAL_DESTROY {
	_debug(\@_) if DEBUG;
}

sub _isa {
	# Optional performance hack
	goto $ORIGINAL_ISA if ref $_[0] and $NOPREBLESS;

	# Load the class, unless we are sure it is already
	my $class = ref $_[0] || $_[0] || return undef;
	unless ( $TRIED_CLASS{$class} or $LOADED{$class} ) {
		_preload($_[0]);
	}

	goto &{$ORIGINAL_ISA};
}

# This is the replacement for UNIVERSAL::can
sub _can {
	# Optional performance hack
	goto $ORIGINAL_CAN if ref $_[0] and $NOPREBLESS;

	# Load the class, unless we are sure it is already
	my $class = ref $_[0] || $_[0] || return undef;
	unless ( $TRIED_CLASS{$class} or $LOADED{$class} ) {
		_preload($_[0]);
	}

	goto &{$ORIGINAL_CAN};
}





#####################################################################
# Support Functions

sub _preload {
	_debug(\@_) if DEBUG;

	# Does it look like a package?
	my $class = ref $_[0] || $_[0];
	unless ( $class and $class =~ /^[^\W\d]\w*(?:(?:\'|::)[^\W]\w*)*$/o ) {
		return $LOADED{$class} = 1;
	}

	# Do we try to load the class
	my $load = 0;
	my $file = _class_file($class);
	if ( defined $INC{$file} and $INC{$file} eq 'Class::Autouse' ) {
		# It's an autoused class
		$load = 1;
	} elsif ( ! $SUPERLOAD ) {
		# Superloader isn't on, don't load
		$load = 0;
	} elsif ( _namespace_occupied($class) ) {
		# Superloader is on, but there is something already in the class
		# This can't be the autouse loader, because we would have caught
		# that case already.
		$load = 0;
	} else {
		# The rules of the superloader say we assume loaded unless we can
		# tell otherwise. Thus, we have to have a go at loading.
		$load = 1;
	}

	# If needed, load the class and all its dependencies.
	Class::Autouse->load($class) if $load;

	unless ( $LOADED{$class} ) {
		_try_loaders($class);
		unless ( $LOADED{$class} ) {
			if ( _namespace_occupied($class) ) {
				# The class is not flagged as loaded by autouse, but exists
				# to ensure its ancestry is loaded before calling $orig
				$LOADED{$class} = 1;
				_load_ancestors($class);
			}
		}
	}

	return 1;
}

sub _try_loaders {
	_debug(\@_, 0) if DEBUG;
	my ($class, $function, @optional_args) = @_;
	# The function and args are only present to help callbacks whose main goal is to
	# do "syntactic sugar" instead of really writing a class

	# This allows us to shortcut out of re-checking a class
	$TRIED_CLASS{$class}++;

	if ( _namespace_occupied($class) ) {
		$LOADED{$class} = 1;
		_load_ancestors($class);
		return 1;
	}

	# Try each of the special loaders, if there are any.
	for my $loader ( @LOADERS ) {
		my $ref = ref($loader);
		if ( $ref ) {
			if ( $ref eq "Regexp" ) {
				next unless $class =~ $loader;
				my $file = _class_file($class);
				next unless grep { -e $_ . '/' . $file } @INC;
				local $^W = 0;
				local $@;
				eval "use $class";
				die "Class::Autouse found module $file for class $class matching regex '$loader',"
					. " but it failed to compile with the following error: $@" if $@;
			} elsif ( $ref eq "CODE" ) {
				unless ( $loader->( $class,$function,@optional_args ) ) {
					next;
				}
			} else {
				die "Unexpected loader.  Expected qr//, sub{}, or class name string."
			}
			$LOADED{$class} = 1;
			_load_ancestors($class);
			return 1;
		} else {
			die "Odd loader $loader passed to " . __PACKAGE__;
		}
	}

	return;
}

# This is called after any class is hit by load/preload to ensure that parent classes are also loaded
sub _load_ancestors {
	_debug(\@_, 0) if DEBUG;
	my $class = $_[0];
	my ($this_class,@ancestors) = _super($class);
	for my $ancestor ( @ancestors ) {
		# this is a bit ugly, _preload presumes either isa or can is being called,
		# and does a goto at the end of it, we just want the core logic, not the redirection
		# so we pass undef as the subref parameter
		_preload($ancestor);
	}
	if ( $STATICISA ) {
		# Optional performance optimization.
		# After we have the entire ancestry,
		# set the greatest grandparent's can/isa to the originals.
		# This keeps the versions in this module from being used where they're not needed.
		my $final_parent = $ancestors[-1] || $this_class;
		no strict 'refs';
		*{ $final_parent . '::can'} = $ORIGINAL_CAN;
		*{ $final_parent . '::isa'} = $ORIGINAL_ISA;
	}
	return 1;
}

# This walks the @ISA tree, optionally calling a subref on each class
# and returns the inherited classes in a list, including $class itself.
sub _super {
	_debug(\@_) if DEBUG;
	my $class  = shift;
	my $load   = shift;
	my @stack  = ( $class );
	my %seen   = ( UNIVERSAL => 1 );
	my @search = ();

	while ( my $c = shift @stack ) {
		next if $seen{$c}++;

		# This may load the class in question, so
		# we call it before checking @ISA.
		if ( $load and not $LOADED{$c} ) {
			$load->($c);
		}

		# Add the class to the search list,
		# and add the @ISA to the load stack.
		push @search, $c;
		unshift @stack, @{"${c}::ISA"};
	}

	return @search;
}

# Load a single class
sub _load ($) {
	_debug(\@_) if DEBUG;

	# Don't attempt to load special classes
	my $class = shift or _cry('Did not specify a class to load');
	$TRIED_CLASS{$class}++;

	return 1 if $SPECIAL{$class};

	# Run some checks
	my $file = _class_file($class);
	if ( defined $INC{$file} ) {
		# If the %INC lock is set to any other value, the file is
		# already loaded. We do not need to do anything.
		if ( $INC{$file} ne 'Class::Autouse') {
			return $LOADED{$class} = 1;
		}

		# Because we autoused it earlier, we know the file for this
		# class MUST exist.
		# Removing the AUTOLOAD hook and %INC lock is all we have to do
		delete ${"${class}::"}{'AUTOLOAD'};
		delete $INC{$file};

	} elsif ( not _file_exists($file) ) {
		# We might still be loaded, if the class was defined
		# in some other module without it's own file.
		if ( _namespace_occupied($class) ) {
			return $LOADED{$class} = 1;
		}

		# Not loaded and no file either.
		# Try to generate the class instead.
		if ( _try_loaders($class) ) {
			return 1;
		}

		# We've run out of options, it just doesn't exist
		my $inc = join ', ', @INC;
		_cry("Can't locate $file in \@INC (\@INC contains: $inc)");
	}

	# Load the file for this class
	print _depth(1) . "  Class::Autouse::load -> Loading in $file\n" if DEBUG;
	eval {
		CORE::require($file);
	};
	_cry($@) if $@;

	# Give back UNIVERSAL::can/isa if there are no other hooks
	--$HOOKS or _UPDATE_HOOKS();

	$LOADED{$class} = 1;
	_load_ancestors($class);
	return 1;
}

# Find all the child classes for a parent class.
# Returns in the list context.
sub _children ($) {
	_debug(\@_) if DEBUG;

	# Find where it is in @INC
	my $base_file = _class_file(shift);
	my $inc_path  = List::Util::first {
		-f File::Spec->catfile($_, $base_file)
	} @INC or return;

	# Does the file have a subdirectory
	# i.e. Are there child classes
	my $child_path      = substr( $base_file, 0, length($base_file) - 3 );
	my $child_path_full = File::Spec->catdir( $inc_path, $child_path );
	return 0 unless -d $child_path_full and -r _;

	# Main scan loop
	local *FILELIST;
	my ($dir, @files, @modules) = ();
	my @queue = ( $child_path );
	while ( $dir = pop @queue ) {
		my $full_dir = File::Spec->catdir($inc_path, $dir);

		# Read in the raw file list
		# Skip directories we can't open
		opendir( FILELIST, $full_dir ) or next;
		@files = readdir FILELIST;
		closedir FILELIST;

		# Iterate over them
		@files = map  { File::Spec->catfile($dir, $_) } # Full relative path
		         grep { ! /^\./ } @files;               # Ignore hidden files
		foreach my $file ( @files ) {
			my $full_file = File::Spec->catfile($inc_path, $file);

			# Add to the queue if its a directory we can descend
			if ( -d $full_file and -r _ ) {
				push @queue, $file;
				next;
			}

			# We only want .pm files we can read
			next unless substr( $file, length($file) - 3 ) eq '.pm';
			next unless -f _;

			push @modules, $file;
		}
	}

	# Convert the file names into modules
	map { join '::', File::Spec->splitdir($_) }
	map { substr($_, 0, length($_) - 3)       } @modules;
}





#####################################################################
# Private support methods

# Does a class or file exists somewhere in our include path. For
# convenience, returns the unresolved file name ( even if passed a class )
sub _file_exists ($) {
	_debug(\@_) if DEBUG;

	# What are we looking for?
	my $file = shift or return undef;
	return undef if $file =~ m/(?:\012|\015)/o;

	# If provided a class name, convert it
	$file = _class_file($file) if $file =~ /::/o;

	# Scan @INC for the file
	foreach ( @INC ) {
		next if ref $_ eq 'CODE';
		return $file if -f File::Spec->catfile($_, $file);
	}

	undef;
}

# Is a namespace occupied by anything significant
sub _namespace_occupied ($) {
	_debug(\@_) if DEBUG;

	# Handle the most likely case
	my $class = shift or return undef;
	return 1 if @{"${class}::ISA"};

	# Get the list of glob names, ignoring namespaces
	foreach ( keys %{"${class}::"} ) {
		next if substr($_, -2) eq '::';

		# Only check for methods, since that's all that's reliable
		if (defined *{"${class}::$_"}{CODE}) {
			if ($_ eq 'AUTOLOAD' and \&{"${class}::$_"} == \&_AUTOLOAD) {
				# This is a Class::Autouse hook.  Ignore.
				next;
			}
			return 1;
		}
	}

	'';
}

# For a given class, get the file name
sub _class_file ($) {
	join( '/', split /(?:\'|::)/, shift ) . '.pm';
}

# Establish our call depth
sub _depth {
	my $spaces = shift;
	if ( DEBUG and ! $spaces ) {
		_debug(\@_);
	}

	# Search up the caller stack to find the first call that isn't us.
	my $level = 0;
	while( $level++ < 1000 ) {
		my @call = caller($level);
		if ( @call ) {
			next if $call[3] eq '(eval)';
			next if $call[3] =~ /^Class::Autouse::\w+\z/;
		}

		# Subtract 1 for this sub's call
		$level -= 1;
		return $spaces ? join( '', (' ') x ($level - 2)) : $level;
	}

	Carp::croak('Infinite loop trying to find call depth');
}

# Die gracefully
sub _cry {
	_debug() if DEBUG;
	local $Carp::CarpLevel = $Carp::CarpLevel;
	$Carp::CarpLevel += _depth();
	$_[0] =~ s/\s+at\s+\S+Autouse\.pm line \d+\.$//;
	Carp::croak($_[0]);
}

# Adaptive debug print generation
BEGIN {
	eval <<'END_DEBUG' if DEBUG;

sub _debug {
	my $args    = shift;
	my $method  = !! shift;
	my $message = shift || '';
	my @c       = caller(1);
	my $msg     = _depth(1) . $c[3];
	if ( ref $args ) {
		my @mapped = map { defined $_ ? "'$_'" : 'undef' } @$args;
		shift @mapped if $method;
		$msg .= @mapped ? '( ' . ( join ', ', @mapped ) . ' )' : '()';
	}
	print "$msg$message\n";
}

END_DEBUG
}





#####################################################################
# Final Initialisation

# The _UPDATE_HOOKS 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_HOOKS () {
	local $^W = 0;
	*UNIVERSAL::can = $HOOKS ? \&_can : $ORIGINAL_CAN;
	*UNIVERSAL::isa = $HOOKS ? \&_isa : $ORIGINAL_ISA;
}

# The _GLOBAL_HOOKS function turns on the universal autoloader hooks
sub _GLOBAL_HOOKS () {
	return if \&UNIVERSAL::AUTOLOAD == \&_UNIVERSAL_AUTOLOAD;

	# Overwrite UNIVERSAL::AUTOLOAD and catch any
	# UNIVERSAL::DESTROY calls so they don't trigger
	# UNIVERSAL::AUTOLOAD. Anyone handling DESTROY calls
	# via an AUTOLOAD should be summarily shot.
	*UNIVERSAL::AUTOLOAD = \&_UNIVERSAL_AUTOLOAD;
	*UNIVERSAL::DESTROY  = \&_UNIVERSAL_DESTROY;

	# Because this will never go away, we increment $HOOKS such
	# that it will never be decremented, and thus the
	# UNIVERSAL::can/isa hijack will never be removed.
	_UPDATE_HOOKS() unless $HOOKS++;
}

BEGIN {
	# Optional integration with prefork.pm (if installed)
	local $@;
	eval { require prefork };
	if ( $@ ) {
		# prefork is not installed.
		# Do manual detection of mod_perl
		$DEVEL = 1 if $ENV{MOD_PERL};
	} else {
		# Go into devel mode when prefork is enabled
		$LOADED{prefork} = 1;
		local $@;
		eval "prefork::notify( sub { Class::Autouse->devel(1) } )";
		die $@ if $@;
	}
}

1;

__END__