First pass at adding key files
This commit is contained in:
dsainty
306
site/slowtwitch.com/cgi-bin/articles/admin/GT/AutoLoader.pm
Normal file
306
site/slowtwitch.com/cgi-bin/articles/admin/GT/AutoLoader.pm
Normal file
@ -0,0 +1,306 @@
|
||||
# ==================================================================
|
||||
# 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
|
||||
Reference in New Issue
Block a user