307 lines
10 KiB
Perl
307 lines
10 KiB
Perl
|
# ==================================================================
|
||
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||
|
|
#
|
||
|
|
# GT::AutoLoader
|
||
|
|
# Author: Jason Rhinelander
|
||
|
|
# $Id: AutoLoader.pm,v 1.13 2005/03/21 06:57:58 jagerman Exp $
|
||
|
|
#
|
||
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||
|
|
# ==================================================================
|
||
|
|
|
||
|
|
package GT::AutoLoader;
|
||
|
|
|
||
|
|
use vars qw($AUTOLOAD %LOG %PACKAGES);
|
||
|
|
use strict qw/vars subs/; # no strict 'refs' - we need several soft references here.
|
||
|
|
|
||
|
|
sub import {
|
||
|
|
shift; # Discard the package, as 'use GT::AutoLoader' calls GT::AutoLoader->import(ARGS)
|
||
|
|
my %opts = @_;
|
||
|
|
|
||
|
|
my $pkg = caller;
|
||
|
|
++$PACKAGES{$pkg};
|
||
|
|
|
||
|
|
if ($opts{LOG} and ref $opts{LOG} eq 'CODE') {
|
||
|
|
$LOG{$pkg} = delete $opts{LOG}; # Everything that requests a log will get one for all modules
|
||
|
|
}
|
||
|
|
|
||
|
|
delete $opts{NAME} if $opts{NAME} and $opts{NAME} eq 'AUTOLOAD'; # Allows "if ($opts{NAME})" later on.
|
||
|
|
|
||
|
|
my $COMPILE;
|
||
|
|
*{$pkg . ($opts{NAME} ? "::$opts{NAME}" : '::AUTOLOAD')} = sub {
|
||
|
|
if ($opts{NAME} or !$AUTOLOAD) { # If they're using another name, it most likely means they are wrapping the AUTOLOAD, which means we have to check for $AUTOLOAD in their package.
|
||
|
|
$AUTOLOAD = ${$pkg . '::AUTOLOAD'};
|
||
|
|
}
|
||
|
|
my ($func) = $AUTOLOAD =~ /([^:]+)$/; # How odd - we use $GT::AutoLoader::AUTOLOAD, even though this is run in some other package
|
||
|
|
|
||
|
|
if ($COMPILE = \%{$pkg . '::COMPILE'}) {
|
||
|
|
if (defined $COMPILE->{$func}) {
|
||
|
|
for (keys %LOG) { $LOG{$_}->($pkg, $func, 'COMPILE') }
|
||
|
|
|
||
|
|
_compile($COMPILE, $pkg, $func);
|
||
|
|
|
||
|
|
$AUTOLOAD = '';
|
||
|
|
|
||
|
|
goto &{"$pkg\::$func"};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($opts{NEXT}) {
|
||
|
|
my ($pack, $func) = $opts{NEXT} =~ /(?:(.+)::)?([^:]+?)$/;
|
||
|
|
$pack ||= $pkg;
|
||
|
|
${$pack . '::AUTOLOAD'} = $AUTOLOAD;
|
||
|
|
my $next = "$pack\::$func";
|
||
|
|
$AUTOLOAD = '';
|
||
|
|
goto &$next;
|
||
|
|
}
|
||
|
|
|
||
|
|
# It doesn't exist in %COMPILE, which means we have to look through @ISA for another AUTOLOAD to pass this to
|
||
|
|
if (my @inh = @{"$pkg\::ISA"}) {
|
||
|
|
while (my $inh = shift @inh) {
|
||
|
|
my $al = $inh . '::AUTOLOAD';
|
||
|
|
if (defined &$al) {
|
||
|
|
$$al = "$pkg\::$func"; # Sets $Other::Package::AUTOLOAD
|
||
|
|
$AUTOLOAD = '';
|
||
|
|
goto &$al;
|
||
|
|
}
|
||
|
|
elsif (my @isa = @{$inh . '::ISA'}) {
|
||
|
|
unshift @inh, @isa;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my ($file, $line) = (caller)[1,2];
|
||
|
|
$AUTOLOAD = '';
|
||
|
|
die "$pkg ($$, GT::AutoLoader): Unknown method '$func' called at $file line $line.\n";
|
||
|
|
};
|
||
|
|
|
||
|
|
my $compile = "$pkg\::COMPILE";
|
||
|
|
*$compile = \%$compile; # Implements "use vars qw/%COMPILE/" for you
|
||
|
|
|
||
|
|
1;
|
||
|
|
}
|
||
|
|
|
||
|
|
BEGIN {
|
||
|
|
if ($^C) {
|
||
|
|
eval <<'CHECK';
|
||
|
|
sub CHECK {
|
||
|
|
# ------------------------------------------------------------------------------
|
||
|
|
# In Perl 5.6+ this allows you to do: perl -cMMy::Module -e0 to make sure all
|
||
|
|
# your %COMPILE subs compile. In versions of Perl prior to 5.6, this is simply
|
||
|
|
# treated as a sub named "CHECK", which is never called. $^C is also 5.6+
|
||
|
|
# specific - whether or not you are running under "-c"
|
||
|
|
compile_all();
|
||
|
|
}
|
||
|
|
CHECK
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub compile_all {
|
||
|
|
my @pkg = @_;
|
||
|
|
if (@pkg) {
|
||
|
|
@pkg = grep +($PACKAGES{$_} or (warn "$_ is not loaded, does not use GT::AutoLoader, or is not a valid package" and 0)), @pkg;
|
||
|
|
@pkg or die "No valid packages passed to compile_all()!";
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
@pkg = keys %PACKAGES;
|
||
|
|
}
|
||
|
|
|
||
|
|
for my $pkg (@pkg) {
|
||
|
|
my $COMPILE = \%{$pkg . '::COMPILE'} or next;
|
||
|
|
for my $func (keys %$COMPILE) {
|
||
|
|
_compile($COMPILE, $pkg, $func) if $COMPILE->{$func};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _compile {
|
||
|
|
# ------------------------------------------------------------------------------
|
||
|
|
# Compiles a subroutine from a module's %COMPILE into the module's package.
|
||
|
|
# die()s if the subroutine cannot compile or still does not exist after
|
||
|
|
# compiling. Takes three arguments: A reference to the packages %COMPILE hash,
|
||
|
|
# the package, and the name of the function to load.
|
||
|
|
#
|
||
|
|
my ($COMPILE, $pkg, $func) = @_;
|
||
|
|
|
||
|
|
my $linenum = ($COMPILE->{$func} =~ s/^(\d+)//) ? $1+1 : 0;
|
||
|
|
eval "package $pkg;\n#line $linenum$pkg\::$func\n$COMPILE->{$func}";
|
||
|
|
if ($@) { die "Unable to load $pkg\::$func: $@" }
|
||
|
|
if (not defined &{"$pkg\::$func"}) {
|
||
|
|
die "Unable to load $pkg\::$func: Subroutine did not compile correctly (possible bad name).";
|
||
|
|
}
|
||
|
|
|
||
|
|
undef $COMPILE->{$func}; # Leave the key in the compile hash so that things can test to see if it was defined in the compile hash
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|
||
|
|
|
||
|
|
__END__
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
GT::AutoLoader - load subroutines on demand
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
package GT::Module;
|
||
|
|
use GT::AutoLoader; # You now have an AUTOLOAD subroutine that will check for entries in %COMPILE
|
||
|
|
|
||
|
|
or
|
||
|
|
|
||
|
|
package GT::OtherModule;
|
||
|
|
use GT::AutoLoader(NAME => '_AUTOLOAD'); # Import AUTOLOAD as _AUTOLOAD, define our own AUTOLOAD
|
||
|
|
sub AUTOLOAD {
|
||
|
|
...
|
||
|
|
goto &_AUTOLOAD;
|
||
|
|
}
|
||
|
|
|
||
|
|
then:
|
||
|
|
|
||
|
|
$COMPILE{sub} = __LINE__ . <<'END_OF_SUB';
|
||
|
|
sub method_name {
|
||
|
|
...
|
||
|
|
}
|
||
|
|
END_OF_SUB
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
The B<GT::AutoLoader> module works as a way to speed up your code. Currently,
|
||
|
|
the only thing it does is scan for a %COMPILE hash in your package. If it finds
|
||
|
|
it, it looks for the subroutine you called, and if found compiles and runs it.
|
||
|
|
|
||
|
|
If unable to find a subroutine to compile in %COMPILE, B<GT::AutoLoader> will
|
||
|
|
scan your inheritance tree (@ISA) for another AUTOLOAD subroutine to pass this
|
||
|
|
off to. If there isn't any, a fatal error occurs.
|
||
|
|
|
||
|
|
To use B<GT::AutoLoader>, in its standard behaviour, simply put:
|
||
|
|
C<use GT::AutoLoader;> in your module. When you use GT::AutoLoader, two things
|
||
|
|
will happen. First, an C<AUTOLOAD> subroutine will be imported into your
|
||
|
|
namespace that will automatically compile your subroutines only when they are
|
||
|
|
needed, thus speeding up compile time. Secondly, a %COMPILE hash will be defined
|
||
|
|
in your package, eliminating the need for you to: use vars qw/%COMPILE/;
|
||
|
|
|
||
|
|
=head1 USE
|
||
|
|
|
||
|
|
You can pass options to GT::AutoLoader to change the behaviour of the module.
|
||
|
|
Currently, logging is the only option, however more options (perhaps including
|
||
|
|
a different compiling scheme) will be added at some future point.
|
||
|
|
|
||
|
|
Options are specified as import() arguments. For example:
|
||
|
|
|
||
|
|
use GT::AutoLoader(OPTION => "value");
|
||
|
|
|
||
|
|
=over 4
|
||
|
|
|
||
|
|
=item NAME
|
||
|
|
|
||
|
|
If you want to import the autoload subroutine as something other than
|
||
|
|
'Package::AUTOLOAD', the 'NAME' option should be used. Its value is the name
|
||
|
|
to import as. For example, to import a GT::AutoLoader AUTOLOAD named _AUTOLOAD
|
||
|
|
(this is useful when declaring your own AUTOLOAD behaviour, but still using
|
||
|
|
GT::AutoLoader's behaviour as a fallback), you would do something like:
|
||
|
|
|
||
|
|
use GT::AutoLoader(NAME => '_AUTOLOAD');
|
||
|
|
|
||
|
|
=item LOG
|
||
|
|
|
||
|
|
Takes a code reference as its value. The code reference will be called three
|
||
|
|
arguments - the package name, the name of the function, and the autoload method
|
||
|
|
(Currently only 'COMPILE'). Note that this will be called for ALL autoloaded
|
||
|
|
subroutines, not just the ones in your package.
|
||
|
|
|
||
|
|
WARNING - you cannot put code in your log that relies on autoloaded methods -
|
||
|
|
you'll end up throwing the program into an infinite loop.
|
||
|
|
|
||
|
|
For example, to get a line of debugging after each subroutine is compiled, you
|
||
|
|
could C<use GT::AutoLoader> like this:
|
||
|
|
|
||
|
|
use GT::AutoLoader(LOG => sub {
|
||
|
|
print "Compiled $_[1] in package $_[0]\n"
|
||
|
|
});
|
||
|
|
|
||
|
|
=item NEXT
|
||
|
|
|
||
|
|
Normally, GT::AutoLoader will look for another AUTOLOAD to call in your
|
||
|
|
package's @ISA inheritance tree. You can alter this behaviour and tell
|
||
|
|
GT::AutoLoader what to call next using the NEXT option.
|
||
|
|
|
||
|
|
For example, if you have a sub _AUTOLOAD { } that you wanted to call if the
|
||
|
|
method isn't found by GT::AutoLoader, you would use GT::AutoLoader like this:
|
||
|
|
|
||
|
|
use GT::AutoLoader(NEXT => 'Package::Name::_AUTOLOAD');
|
||
|
|
|
||
|
|
The _AUTOLOAD function in your package will now be called if GT::AutoLoader
|
||
|
|
can't load the method on its own. $AUTOLOAD will be set for you in whichever
|
||
|
|
package the function you provide is in. Note that if you simply want to use an
|
||
|
|
inherited AUTOLOAD, you B<should not> use this option; GT::AutoLoader will
|
||
|
|
handle that just fine on its own.
|
||
|
|
|
||
|
|
You may omit the package (Package::Name::) if the function is in your current
|
||
|
|
package.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=head1 compile_all
|
||
|
|
|
||
|
|
A function exists in GT::AutoLoader to compile all %COMPILE-subroutines. By
|
||
|
|
default (without arguments) compile_all() compiles every %COMPILE-subroutine in
|
||
|
|
every package that has used GT::AutoLoader. You can, however, pass in a list of
|
||
|
|
packages which compile_all() will check instead of compiling everything. Note
|
||
|
|
that GT::AutoLoader will only compile %COMPILE-subroutines in packages that
|
||
|
|
have used GT::AutoLoader, so if you specify package "Foo", but "Foo" hasn't
|
||
|
|
used GT::AutoLoader, it will be ignored.
|
||
|
|
|
||
|
|
You can do something like:
|
||
|
|
|
||
|
|
GT::AutoLoader::compile_all(__PACKAGE__) if MOD_PERL;
|
||
|
|
|
||
|
|
to have a GT::AutoLoader compile every %COMPILE-subroutine in the current
|
||
|
|
package automatically under mod_perl, or you could add this code to your
|
||
|
|
mod_perl startup file or test script:
|
||
|
|
|
||
|
|
GT::AutoLoader::compile_all;
|
||
|
|
|
||
|
|
Test scripts should definately use compile_all() to ensure that all subroutines
|
||
|
|
compile correctly!
|
||
|
|
|
||
|
|
=head1 REQUIREMENTS
|
||
|
|
|
||
|
|
None.
|
||
|
|
|
||
|
|
=head1 CAVEATS
|
||
|
|
|
||
|
|
Due to the nature of Perl's AUTOLOAD handling, you must take care when using
|
||
|
|
GT::AutoLoader in a subclass. In short, subclassed methods B<MUST NOT> be put
|
||
|
|
into the %COMPILE hash.
|
||
|
|
|
||
|
|
The problem is that since the subroutine does not exist in the package, Perl,
|
||
|
|
while decending the inheritance tree, will not see it but will probably see the
|
||
|
|
parent's method (unless nothing else has called the method, but you should
|
||
|
|
never count on that), and call it rather than looking for your package's
|
||
|
|
AUTOLOAD.
|
||
|
|
|
||
|
|
This isn't to say that subclasses cannot use AUTOLOAD - just that subclasses
|
||
|
|
cannot use autoloaded methods (%COMPILE-subroutines) if a method of the same
|
||
|
|
name exists in the parent class. Autoloaded function calls are not affected.
|
||
|
|
|
||
|
|
=head1 MAINTAINER
|
||
|
|
|
||
|
|
Jason Rhinelander
|
||
|
|
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
L<GT::Base>
|
||
|
|
|
||
|
|
=head1 COPYRIGHT
|
||
|
|
|
||
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||
|
|
http://www.gossamer-threads.com/
|
||
|
|
|
||
|
|
=head1 VERSION
|
||
|
|
|
||
|
|
Revision: $Id: AutoLoader.pm,v 1.13 2005/03/21 06:57:58 jagerman Exp $
|
||
|
|
|
||
|
|
=cut
|