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. { # 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) = $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 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 do the searching $name = "auto/$AUTOLOAD.al"; $name =~ s#::#/#g; } } my $save = $@; eval { local $SIG{__DIE__}; require $name }; if ($@) { if (substr($AUTOLOAD,-9) eq '::DESTROY') { *$AUTOLOAD = 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 ($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); } } } $@ = $save; goto &$AUTOLOAD; } sub import { my $pkg = shift; my $callpkg = caller; # # Export symbols, but not by accident of inheritance. # Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader'; # # 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. $path =~ s#^(.*)$calldir\.pm$#$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; }; } if ($@) { my $error = $@; require Carp; Carp::carp($error); } } } 1;