Initial Commit
This commit is contained in:
453
database/perl/lib/AutoLoader.pm
Normal file
453
database/perl/lib/AutoLoader.pm
Normal file
@@ -0,0 +1,453 @@
|
||||
package AutoLoader;
|
||||
|
||||
use strict;
|
||||
use 5.006_001;
|
||||
|
||||
our($VERSION, $AUTOLOAD);
|
||||
|
||||
my $is_dosish;
|
||||
my $is_epoc;
|
||||
my $is_vms;
|
||||
my $is_macos;
|
||||
|
||||
BEGIN {
|
||||
$is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
|
||||
$is_epoc = $^O eq 'epoc';
|
||||
$is_vms = $^O eq 'VMS';
|
||||
$is_macos = $^O eq 'MacOS';
|
||||
$VERSION = '5.74';
|
||||
}
|
||||
|
||||
AUTOLOAD {
|
||||
my $sub = $AUTOLOAD;
|
||||
autoload_sub($sub);
|
||||
goto &$sub;
|
||||
}
|
||||
|
||||
sub autoload_sub {
|
||||
my $sub = shift;
|
||||
|
||||
my $filename = AutoLoader::find_filename( $sub );
|
||||
|
||||
my $save = $@;
|
||||
local $!; # Do not munge the value.
|
||||
eval { local $SIG{__DIE__}; require $filename };
|
||||
if ($@) {
|
||||
if (substr($sub,-9) eq '::DESTROY') {
|
||||
no strict 'refs';
|
||||
*$sub = sub {};
|
||||
$@ = undef;
|
||||
} elsif ($@ =~ /^Can't locate/) {
|
||||
# The load might just have failed because the filename was too
|
||||
# long for some old SVR3 systems which treat long names as errors.
|
||||
# If we can successfully truncate a long name then it's worth a go.
|
||||
# There is a slight risk that we could pick up the wrong file here
|
||||
# but autosplit should have warned about that when splitting.
|
||||
if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
|
||||
eval { local $SIG{__DIE__}; require $filename };
|
||||
}
|
||||
}
|
||||
if ($@){
|
||||
$@ =~ s/ at .*\n//;
|
||||
my $error = $@;
|
||||
require Carp;
|
||||
Carp::croak($error);
|
||||
}
|
||||
}
|
||||
$@ = $save;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub find_filename {
|
||||
my $sub = shift;
|
||||
my $filename;
|
||||
# Braces used to preserve $1 et al.
|
||||
{
|
||||
# Try to find the autoloaded file from the package-qualified
|
||||
# name of the sub. e.g., if the sub needed is
|
||||
# Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
|
||||
# something like '/usr/lib/perl5/Getopt/Long.pm', and the
|
||||
# autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
|
||||
#
|
||||
# However, if @INC is a relative path, this might not work. If,
|
||||
# for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
|
||||
# 'lib/Getopt/Long.pm', and we want to require
|
||||
# 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
|
||||
# In this case, we simple prepend the 'auto/' and let the
|
||||
# C<require> take care of the searching for us.
|
||||
|
||||
my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
|
||||
$pkg =~ s#::#/#g;
|
||||
if (defined($filename = $INC{"$pkg.pm"})) {
|
||||
if ($is_macos) {
|
||||
$pkg =~ tr#/#:#;
|
||||
$filename = undef
|
||||
unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
|
||||
} else {
|
||||
$filename = undef
|
||||
unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
|
||||
}
|
||||
|
||||
# if the file exists, then make sure that it is a
|
||||
# a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
|
||||
# or './lib/auto/foo/bar.al'. This avoids C<require> searching
|
||||
# (and failing) to find the 'lib/auto/foo/bar.al' because it
|
||||
# looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
|
||||
|
||||
if (defined $filename and -r $filename) {
|
||||
unless ($filename =~ m|^/|s) {
|
||||
if ($is_dosish) {
|
||||
unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
|
||||
if ($^O ne 'NetWare') {
|
||||
$filename = "./$filename";
|
||||
} else {
|
||||
$filename = "$filename";
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($is_epoc) {
|
||||
unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
|
||||
$filename = "./$filename";
|
||||
}
|
||||
}
|
||||
elsif ($is_vms) {
|
||||
# XXX todo by VMSmiths
|
||||
$filename = "./$filename";
|
||||
}
|
||||
elsif (!$is_macos) {
|
||||
$filename = "./$filename";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$filename = undef;
|
||||
}
|
||||
}
|
||||
unless (defined $filename) {
|
||||
# let C<require> do the searching
|
||||
$filename = "auto/$sub.al";
|
||||
$filename =~ s#::#/#g;
|
||||
}
|
||||
}
|
||||
return $filename;
|
||||
}
|
||||
|
||||
sub import {
|
||||
my $pkg = shift;
|
||||
my $callpkg = caller;
|
||||
|
||||
#
|
||||
# Export symbols, but not by accident of inheritance.
|
||||
#
|
||||
|
||||
if ($pkg eq 'AutoLoader') {
|
||||
if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) {
|
||||
no strict 'refs';
|
||||
*{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Try to find the autosplit index file. Eg., if the call package
|
||||
# is POSIX, then $INC{POSIX.pm} is something like
|
||||
# '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
|
||||
# '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
|
||||
#
|
||||
# However, if @INC is a relative path, this might not work. If,
|
||||
# for example, @INC = ('lib'), then
|
||||
# $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
|
||||
# 'auto/POSIX/autosplit.ix' (without the leading 'lib').
|
||||
#
|
||||
|
||||
(my $calldir = $callpkg) =~ s#::#/#g;
|
||||
my $path = $INC{$calldir . '.pm'};
|
||||
if (defined($path)) {
|
||||
# Try absolute path name, but only eval it if the
|
||||
# transformation from module path to autosplit.ix path
|
||||
# succeeded!
|
||||
my $replaced_okay;
|
||||
if ($is_macos) {
|
||||
(my $malldir = $calldir) =~ tr#/#:#;
|
||||
$replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s);
|
||||
} else {
|
||||
$replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#);
|
||||
}
|
||||
|
||||
eval { require $path; } if $replaced_okay;
|
||||
# If that failed, try relative path with normal @INC searching.
|
||||
if (!$replaced_okay or $@) {
|
||||
$path ="auto/$calldir/autosplit.ix";
|
||||
eval { require $path; };
|
||||
}
|
||||
if ($@) {
|
||||
my $error = $@;
|
||||
require Carp;
|
||||
Carp::carp($error);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub unimport {
|
||||
my $callpkg = caller;
|
||||
|
||||
no strict 'refs';
|
||||
|
||||
for my $exported (qw( AUTOLOAD )) {
|
||||
my $symname = $callpkg . '::' . $exported;
|
||||
undef *{ $symname } if \&{ $symname } == \&{ $exported };
|
||||
*{ $symname } = \&{ $symname };
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
AutoLoader - load subroutines only on demand
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Foo;
|
||||
use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine
|
||||
|
||||
package Bar;
|
||||
use AutoLoader; # don't import AUTOLOAD, define our own
|
||||
sub AUTOLOAD {
|
||||
...
|
||||
$AutoLoader::AUTOLOAD = "...";
|
||||
goto &AutoLoader::AUTOLOAD;
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The B<AutoLoader> module works with the B<AutoSplit> module and the
|
||||
C<__END__> token to defer the loading of some subroutines until they are
|
||||
used rather than loading them all at once.
|
||||
|
||||
To use B<AutoLoader>, the author of a module has to place the
|
||||
definitions of subroutines to be autoloaded after an C<__END__> token.
|
||||
(See L<perldata>.) The B<AutoSplit> module can then be run manually to
|
||||
extract the definitions into individual files F<auto/funcname.al>.
|
||||
|
||||
B<AutoLoader> implements an AUTOLOAD subroutine. When an undefined
|
||||
subroutine in is called in a client module of B<AutoLoader>,
|
||||
B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a
|
||||
file with a name related to the location of the file from which the
|
||||
client module was read. As an example, if F<POSIX.pm> is located in
|
||||
F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl
|
||||
subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where
|
||||
the C<.al> file has the same name as the subroutine, sans package. If
|
||||
such a file exists, AUTOLOAD will read and evaluate it,
|
||||
thus (presumably) defining the needed subroutine. AUTOLOAD will then
|
||||
C<goto> the newly defined subroutine.
|
||||
|
||||
Once this process completes for a given function, it is defined, so
|
||||
future calls to the subroutine will bypass the AUTOLOAD mechanism.
|
||||
|
||||
=head2 Subroutine Stubs
|
||||
|
||||
In order for object method lookup and/or prototype checking to operate
|
||||
correctly even when methods have not yet been defined it is necessary to
|
||||
"forward declare" each subroutine (as in C<sub NAME;>). See
|
||||
L<perlsub/"SYNOPSIS">. Such forward declaration creates "subroutine
|
||||
stubs", which are place holders with no code.
|
||||
|
||||
The AutoSplit and B<AutoLoader> modules automate the creation of forward
|
||||
declarations. The AutoSplit module creates an 'index' file containing
|
||||
forward declarations of all the AutoSplit subroutines. When the
|
||||
AutoLoader module is 'use'd it loads these declarations into its callers
|
||||
package.
|
||||
|
||||
Because of this mechanism it is important that B<AutoLoader> is always
|
||||
C<use>d and not C<require>d.
|
||||
|
||||
=head2 Using B<AutoLoader>'s AUTOLOAD Subroutine
|
||||
|
||||
In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must>
|
||||
explicitly import it:
|
||||
|
||||
use AutoLoader 'AUTOLOAD';
|
||||
|
||||
=head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine
|
||||
|
||||
Some modules, mainly extensions, provide their own AUTOLOAD subroutines.
|
||||
They typically need to check for some special cases (such as constants)
|
||||
and then fallback to B<AutoLoader>'s AUTOLOAD for the rest.
|
||||
|
||||
Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine.
|
||||
Instead, they should define their own AUTOLOAD subroutines along these
|
||||
lines:
|
||||
|
||||
use AutoLoader;
|
||||
use Carp;
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $sub = $AUTOLOAD;
|
||||
(my $constname = $sub) =~ s/.*:://;
|
||||
my $val = constant($constname, @_ ? $_[0] : 0);
|
||||
if ($! != 0) {
|
||||
if ($! =~ /Invalid/ || $!{EINVAL}) {
|
||||
$AutoLoader::AUTOLOAD = $sub;
|
||||
goto &AutoLoader::AUTOLOAD;
|
||||
}
|
||||
else {
|
||||
croak "Your vendor has not defined constant $constname";
|
||||
}
|
||||
}
|
||||
*$sub = sub { $val }; # same as: eval "sub $sub { $val }";
|
||||
goto &$sub;
|
||||
}
|
||||
|
||||
If any module's own AUTOLOAD subroutine has no need to fallback to the
|
||||
AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit
|
||||
subroutines), then that module should not use B<AutoLoader> at all.
|
||||
|
||||
=head2 Package Lexicals
|
||||
|
||||
Package lexicals declared with C<my> in the main block of a package
|
||||
using B<AutoLoader> will not be visible to auto-loaded subroutines, due to
|
||||
the fact that the given scope ends at the C<__END__> marker. A module
|
||||
using such variables as package globals will not work properly under the
|
||||
B<AutoLoader>.
|
||||
|
||||
The C<vars> pragma (see L<perlmod/"vars">) may be used in such
|
||||
situations as an alternative to explicitly qualifying all globals with
|
||||
the package namespace. Variables pre-declared with this pragma will be
|
||||
visible to any autoloaded routines (but will not be invisible outside
|
||||
the package, unfortunately).
|
||||
|
||||
=head2 Not Using AutoLoader
|
||||
|
||||
You can stop using AutoLoader by simply
|
||||
|
||||
no AutoLoader;
|
||||
|
||||
=head2 B<AutoLoader> vs. B<SelfLoader>
|
||||
|
||||
The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the
|
||||
loading of subroutines.
|
||||
|
||||
B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>.
|
||||
While this avoids the use of a hierarchy of disk files and the
|
||||
associated open/close for each routine loaded, B<SelfLoader> suffers a
|
||||
startup speed disadvantage in the one-time parsing of the lines after
|
||||
C<__DATA__>, after which routines are cached. B<SelfLoader> can also
|
||||
handle multiple packages in a file.
|
||||
|
||||
B<AutoLoader> only reads code as it is requested, and in many cases
|
||||
should be faster, but requires a mechanism like B<AutoSplit> be used to
|
||||
create the individual files. L<ExtUtils::MakeMaker> will invoke
|
||||
B<AutoSplit> automatically if B<AutoLoader> is used in a module source
|
||||
file.
|
||||
|
||||
=head2 Forcing AutoLoader to Load a Function
|
||||
|
||||
Sometimes, it can be necessary or useful to make sure that a certain
|
||||
function is fully loaded by AutoLoader. This is the case, for example,
|
||||
when you need to wrap a function to inject debugging code. It is also
|
||||
helpful to force early loading of code before forking to make use of
|
||||
copy-on-write as much as possible.
|
||||
|
||||
Starting with AutoLoader 5.73, you can call the
|
||||
C<AutoLoader::autoload_sub> function with the fully-qualified name of
|
||||
the function to load from its F<.al> file. The behaviour is exactly
|
||||
the same as if you called the function, triggering the regular
|
||||
C<AUTOLOAD> mechanism, but it does not actually execute the
|
||||
autoloaded function.
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
AutoLoaders prior to Perl 5.002 had a slightly different interface. Any
|
||||
old modules which use B<AutoLoader> should be changed to the new calling
|
||||
style. Typically this just means changing a require to a use, adding
|
||||
the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader>
|
||||
from C<@ISA>.
|
||||
|
||||
On systems with restrictions on file name length, the file corresponding
|
||||
to a subroutine may have a shorter name that the routine itself. This
|
||||
can lead to conflicting file names. The I<AutoSplit> package warns of
|
||||
these potential conflicts when used to split a module.
|
||||
|
||||
AutoLoader may fail to find the autosplit files (or even find the wrong
|
||||
ones) in cases where C<@INC> contains relative paths, B<and> the program
|
||||
does C<chdir>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<SelfLoader> - an autoloader that doesn't use external files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C<AutoLoader> is maintained by the perl5-porters. Please direct
|
||||
any questions to the canonical mailing list. Anything that
|
||||
is applicable to the CPAN release can be sent to its maintainer,
|
||||
though.
|
||||
|
||||
Author and Maintainer: The Perl5-Porters <perl5-porters@perl.org>
|
||||
|
||||
Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This package has been part of the perl core since the first release
|
||||
of perl5. It has been released separately to CPAN so older installations
|
||||
can benefit from bug fixes.
|
||||
|
||||
This package has the same copyright and license as the perl core:
|
||||
|
||||
Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
|
||||
2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
|
||||
2011, 2012, 2013
|
||||
by Larry Wall and others
|
||||
|
||||
All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of either:
|
||||
|
||||
a) the GNU General Public License as published by the Free
|
||||
Software Foundation; either version 1, or (at your option) any
|
||||
later version, or
|
||||
|
||||
b) the "Artistic License" which comes with this Kit.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
|
||||
the GNU General Public License or the Artistic License for more details.
|
||||
|
||||
You should have received a copy of the Artistic License with this
|
||||
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
|
||||
|
||||
You should also have received a copy of the GNU General Public License
|
||||
along with this program in the file named "Copying". If not, write to the
|
||||
Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
|
||||
MA 02110-1301, USA or visit their web page on the internet at
|
||||
http://www.gnu.org/copyleft/gpl.html.
|
||||
|
||||
For those of you that choose to use the GNU General Public License,
|
||||
my interpretation of the GNU General Public License is that no Perl
|
||||
script falls under the terms of the GPL unless you explicitly put
|
||||
said script under the terms of the GPL yourself. Furthermore, any
|
||||
object code linked with perl does not automatically fall under the
|
||||
terms of the GPL, provided such object code only adds definitions
|
||||
of subroutines and variables, and does not otherwise impair the
|
||||
resulting interpreter from executing any standard Perl script. I
|
||||
consider linking in C subroutines in this manner to be the moral
|
||||
equivalent of defining subroutines in the Perl language itself. You
|
||||
may sell such an object file as proprietary provided that you provide
|
||||
or offer to provide the Perl source, as specified by the GNU General
|
||||
Public License. (This is merely an alternate way of specifying input
|
||||
to the program.) You may also sell a binary produced by the dumping of
|
||||
a running Perl script that belongs to you, provided that you provide or
|
||||
offer to provide the Perl source as specified by the GPL. (The
|
||||
fact that a Perl interpreter and your code are in the same binary file
|
||||
is, in this case, a form of mere aggregation.) This is my interpretation
|
||||
of the GPL. If you still have concerns or difficulties understanding
|
||||
my intent, feel free to contact me. Of course, the Artistic License
|
||||
spells all this out for your protection, so you may prefer to use that.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user