X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FAutoLoader.pm;h=e74043157fdf3cb7a05ee4f4ad391a1e797427d3;hb=6a93515622cf0655623a39a9eaff82a4b9b3268b;hp=e2d71700d480c740f4709cb5a35f4acd80f3f4ae;hpb=1be0b951896569eac7ad6c5fd5fd8c3ab526543b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index e2d7170..e740431 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -1,53 +1,141 @@ package AutoLoader; -use Carp; -use vars qw(@EXPORT @EXPORT_OK); +use strict; +use 5.006_001; + +our($VERSION, $AUTOLOAD); + +my $is_dosish; +my $is_epoc; +my $is_vms; +my $is_macos; BEGIN { - require Exporter; - @EXPORT = (); - @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.61'; } 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; - } - } + my $sub = $AUTOLOAD; + my $filename = AutoLoader::find_filename( $sub ); + my $save = $@; - eval {require $name}; + local $!; # Do not munge the value. + eval { local $SIG{__DIE__}; require $filename }; if ($@) { - if (substr($AUTOLOAD,-9) eq '::DESTROY') { - *$AUTOLOAD = sub {}; - } else { + 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 succesfully truncate a long name then it's worth a go. + # 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 ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ - eval {require $name}; - } - if ($@){ - $@ =~ s/ at .*\n//; - croak $@; + 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 &$AUTOLOAD; + goto &$sub; +} + +sub can { + my ($self, $method) = @_; + + my $parent = $self->SUPER::can( $method ); + return $parent if $parent; + + my $package = ref( $self ) || $self; + my $filename = AutoLoader::find_filename( $package . '::' . $method ); + local $@; + return unless eval { require $filename }; + + no strict 'refs'; + return \&{ $package . '::' . $method }; +} + +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 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 =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; + } else { + $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 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 $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 do the searching + $filename = "auto/$sub.al"; + $filename =~ s#::#/#g; + } + } + return $filename; } sub import { @@ -58,7 +146,13 @@ sub import { # Export symbols, but not by accident of inheritance. # - Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader'; + if ($pkg eq 'AutoLoader') { + if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { + no strict 'refs'; + *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; + *{ $callpkg . '::can' } = \&can; + } + } # # Try to find the autosplit index file. Eg., if the call package @@ -72,21 +166,43 @@ 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. - $path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#; + if ($is_macos) { + (my $malldir = $calldir) =~ tr#/#:#; + $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s; + } else { + $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#; + } + eval { require $path; }; # If that failed, try relative path with normal @INC searching. if ($@) { $path ="auto/$calldir/autosplit.ix"; eval { require $path; }; } - carp $@ if ($@); + if ($@) { + my $error = $@; + require Carp; + Carp::carp($error); + } } } +sub unimport { + my $callpkg = caller; + + no strict 'refs'; + + for my $exported (qw( AUTOLOAD can )) { + my $symname = $callpkg . '::' . $exported; + undef *{ $symname } if \&{ $symname } == \&{ $exported }; + *{ $symname } = \&{ $symname }; + } +} + 1; __END__ @@ -131,7 +247,7 @@ such a file exists, AUTOLOAD will read and evaluate it, thus (presumably) defining the needed subroutine. AUTOLOAD will then C the newly defined subroutine. -Once this process completes for a given funtion, it is defined, so +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 @@ -169,22 +285,23 @@ Instead, they should define their own AUTOLOAD subroutines along these lines: use AutoLoader; + use Carp; sub AUTOLOAD { - my $constname; - ($constname = $AUTOLOAD) =~ s/.*:://; + my $sub = $AUTOLOAD; + (my $constname = $sub) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { - if ($! =~ /Invalid/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $sub; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined constant $constname"; } } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; + *$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 @@ -205,6 +322,12 @@ 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 vs. B The B is similar in purpose to B: both delay the @@ -218,7 +341,7 @@ C<__DATA__>, after which routines are cached. B can also handle multiple packages in a file. B only reads code as it is requested, and in many cases -should be faster, but requires a machanism like B be used to +should be faster, but requires a mechanism like B be used to create the individual files. L will invoke B automatically if B is used in a module source file. @@ -236,6 +359,10 @@ to a subroutine may have a shorter name that the routine itself. This can lead to conflicting file names. The I 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 the program +does C. + =head1 SEE ALSO L - an autoloader that doesn't use external files.