package AutoLoader;
-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.63';
}
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 {local $SIG{__DIE__};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 {local $SIG{__DIE__};require $name};
- }
- if ($@){
- $@ =~ s/ at .*\n//;
- my $error = $@;
- require Carp;
- Carp::croak($error);
+ 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<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 {
# 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
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 ($@) {
}
}
+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__
thus (presumably) defining the needed subroutine. AUTOLOAD will then
C<goto> 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
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";
}
}
- *$AUTOLOAD = sub { $val }; # same as: 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
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
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 machanism like B<AutoSplit> be used to
+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.
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.