discourse-legacysite-perl/site/glist/lib/GT/AutoLoader.pm
2024-06-17 21:49:12 +10:00

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