X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3b825e419da1c361eab06a1e6d287276c0aef241..58ab674396867145170e9c1fbd7457883b386ab8:/lib/AutoLoader.pm diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index b42d5ff..e05372f 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -1,7 +1,9 @@ package AutoLoader; +use strict; use 5.006_001; -our(@EXPORT, @EXPORT_OK, $VERSION); + +our($VERSION, $AUTOLOAD); my $is_dosish; my $is_epoc; @@ -9,18 +11,48 @@ my $is_vms; my $is_macos; BEGIN { - require Exporter; - @EXPORT = @EXPORT = (); - @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD); $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.59'; + $VERSION = '5.68'; } AUTOLOAD { my $sub = $AUTOLOAD; + 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; + goto &$sub; +} + +sub find_filename { + my $sub = shift; my $filename; # Braces used to preserve $1 et al. { @@ -42,9 +74,11 @@ AUTOLOAD { if (defined($filename = $INC{"$pkg.pm"})) { if ($is_macos) { $pkg =~ tr#/#:#; - $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; } else { - $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; } # if the file exists, then make sure that it is a @@ -53,15 +87,15 @@ AUTOLOAD { # (and failing) to find the 'lib/auto/foo/bar.al' because it # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). - if (-r $filename) { + 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"; - } + if ($^O ne 'NetWare') { + $filename = "./$filename"; + } else { + $filename = "$filename"; + } } } elsif ($is_epoc) { @@ -88,31 +122,7 @@ AUTOLOAD { $filename =~ s#::#/#g; } } - my $save = $@; - local $!; # Do not munge the value. - eval { local $SIG{__DIE__}; require $filename }; - if ($@) { - if (substr($sub,-9) eq '::DESTROY') { - *$sub = sub {}; - } else { - # 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 succesfully 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; - goto &$sub; + return $filename; } sub import { @@ -124,8 +134,10 @@ sub import { # if ($pkg eq 'AutoLoader') { - local $Exporter::ExportLevel = 1; - Exporter::import $pkg, @_; + if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { + no strict 'refs'; + *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; + } } # @@ -143,17 +155,20 @@ sub import { (my $calldir = $callpkg) =~ s#::#/#g; my $path = $INC{$calldir . '.pm'}; if (defined($path)) { - # Try absolute path name. + # 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#/#:#; - $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s; + $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s); } else { - $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#; + $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#); } - eval { require $path; }; + eval { require $path; } if $replaced_okay; # If that failed, try relative path with normal @INC searching. - if ($@) { + if (!$replaced_okay or $@) { $path ="auto/$calldir/autosplit.ix"; eval { require $path; }; } @@ -166,8 +181,15 @@ sub import { } sub unimport { - my $callpkg = caller; - eval "package $callpkg; sub AUTOLOAD;"; + my $callpkg = caller; + + no strict 'refs'; + + for my $exported (qw( AUTOLOAD )) { + my $symname = $callpkg . '::' . $exported; + undef *{ $symname } if \&{ $symname } == \&{ $exported }; + *{ $symname } = \&{ $symname }; + } } 1; @@ -334,4 +356,74 @@ does C. L - an autoloader that doesn't use external files. +=head1 AUTHOR + +C 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 + +Maintainer of the CPAN release: Steffen Mueller + +=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 + 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., 59 Temple Place, Suite 330, Boston, MA + 02111-1307, 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