X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FAutoLoader.pm;h=666c6cacf92d1d93c1ce997a1e0a9ddcd1f7a8e2;hb=d3cf3892100cfc5e4143b94111b619e8eb2b1937;hp=2773a90f10fcefc59b5d16c30075e54fc8f75aaa;hpb=fb73857aa0bfa8ed43d4d2f972c564c70a57e0c4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index 2773a90..666c6ca 100644
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -2,31 +2,73 @@ package AutoLoader;
 
 use vars qw(@EXPORT @EXPORT_OK);
 
+my $is_dosish;
+my $is_vms;
+
 BEGIN {
     require Exporter;
     @EXPORT = ();
     @EXPORT_OK = qw(AUTOLOAD);
+    $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
+    $is_vms = $^O eq 'VMS';
 }
 
 AUTOLOAD {
     my $name;
     # Braces used to preserve $1 et al.
     {
-     my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
-     $pkg =~ s#::#/#g;
-     if (defined($name=$INC{"$pkg.pm"}))
-      {
-       $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
-       $name = undef unless (-r $name); 
-      }
-     unless (defined $name)
-      {
-       $name = "auto/$AUTOLOAD.al";
-       $name =~ s#::#/#g;
-      }
+	# 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) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
+	$pkg =~ s#::#/#g;
+	if (defined($name=$INC{"$pkg.pm"})) {
+	    $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
+
+	    # 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 (-r $name) {
+	        unless ($name =~ m|^/|) {
+		    if ($is_dosish) {
+			unless ($name =~ m{^([a-z]:)?[\\/]}i) {
+			     $name = "./$name";
+			}
+		    }
+		    elsif ($is_vms) {
+		        # XXX todo by VMSmiths
+			$name = "./$name";
+		    }
+		    else {
+			$name = "./$name";
+		    }
+		}
+	    }
+	    else {
+		$name = undef;
+	    }
+	}
+	unless (defined $name) {
+	    # let C<require> do the searching
+	    $name = "auto/$AUTOLOAD.al";
+	    $name =~ s#::#/#g;
+	}
     }
     my $save = $@;
-    eval {local $SIG{__DIE__};require $name};
+    eval { local $SIG{__DIE__}; require $name };
     if ($@) {
 	if (substr($AUTOLOAD,-9) eq '::DESTROY') {
 	    *$AUTOLOAD = sub {};
@@ -73,7 +115,7 @@ sub import {
     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
     #
 
-    (my $calldir = $callpkg) =~ s#::#/#;
+    (my $calldir = $callpkg) =~ s#::#/#g;
     my $path = $INC{$calldir . '.pm'};
     if (defined($path)) {
 	# Try absolute path name.
@@ -242,6 +284,10 @@ 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.