| 1 | package AutoLoader;
|
|---|
| 2 |
|
|---|
| 3 | use strict;
|
|---|
| 4 | use 5.006_001;
|
|---|
| 5 |
|
|---|
| 6 | our($VERSION, $AUTOLOAD);
|
|---|
| 7 |
|
|---|
| 8 | my $is_dosish;
|
|---|
| 9 | my $is_epoc;
|
|---|
| 10 | my $is_vms;
|
|---|
| 11 | my $is_macos;
|
|---|
| 12 |
|
|---|
| 13 | BEGIN {
|
|---|
| 14 | $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
|
|---|
| 15 | $is_epoc = $^O eq 'epoc';
|
|---|
| 16 | $is_vms = $^O eq 'VMS';
|
|---|
| 17 | $is_macos = $^O eq 'MacOS';
|
|---|
| 18 | $VERSION = '5.60';
|
|---|
| 19 | }
|
|---|
| 20 |
|
|---|
| 21 | AUTOLOAD {
|
|---|
| 22 | my $sub = $AUTOLOAD;
|
|---|
| 23 | my $filename;
|
|---|
| 24 | # Braces used to preserve $1 et al.
|
|---|
| 25 | {
|
|---|
| 26 | # Try to find the autoloaded file from the package-qualified
|
|---|
| 27 | # name of the sub. e.g., if the sub needed is
|
|---|
| 28 | # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
|
|---|
| 29 | # something like '/usr/lib/perl5/Getopt/Long.pm', and the
|
|---|
| 30 | # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
|
|---|
| 31 | #
|
|---|
| 32 | # However, if @INC is a relative path, this might not work. If,
|
|---|
| 33 | # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
|
|---|
| 34 | # 'lib/Getopt/Long.pm', and we want to require
|
|---|
| 35 | # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
|
|---|
| 36 | # In this case, we simple prepend the 'auto/' and let the
|
|---|
| 37 | # C<require> take care of the searching for us.
|
|---|
| 38 |
|
|---|
| 39 | my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
|
|---|
| 40 | $pkg =~ s#::#/#g;
|
|---|
| 41 | if (defined($filename = $INC{"$pkg.pm"})) {
|
|---|
| 42 | if ($is_macos) {
|
|---|
| 43 | $pkg =~ tr#/#:#;
|
|---|
| 44 | $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
|
|---|
| 45 | } else {
|
|---|
| 46 | $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
|
|---|
| 47 | }
|
|---|
| 48 |
|
|---|
| 49 | # if the file exists, then make sure that it is a
|
|---|
| 50 | # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
|
|---|
| 51 | # or './lib/auto/foo/bar.al'. This avoids C<require> searching
|
|---|
| 52 | # (and failing) to find the 'lib/auto/foo/bar.al' because it
|
|---|
| 53 | # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
|
|---|
| 54 |
|
|---|
| 55 | if (-r $filename) {
|
|---|
| 56 | unless ($filename =~ m|^/|s) {
|
|---|
| 57 | if ($is_dosish) {
|
|---|
| 58 | unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
|
|---|
| 59 | if ($^O ne 'NetWare') {
|
|---|
| 60 | $filename = "./$filename";
|
|---|
| 61 | } else {
|
|---|
| 62 | $filename = "$filename";
|
|---|
| 63 | }
|
|---|
| 64 | }
|
|---|
| 65 | }
|
|---|
| 66 | elsif ($is_epoc) {
|
|---|
| 67 | unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
|
|---|
| 68 | $filename = "./$filename";
|
|---|
| 69 | }
|
|---|
| 70 | }
|
|---|
| 71 | elsif ($is_vms) {
|
|---|
| 72 | # XXX todo by VMSmiths
|
|---|
| 73 | $filename = "./$filename";
|
|---|
| 74 | }
|
|---|
| 75 | elsif (!$is_macos) {
|
|---|
| 76 | $filename = "./$filename";
|
|---|
| 77 | }
|
|---|
| 78 | }
|
|---|
| 79 | }
|
|---|
| 80 | else {
|
|---|
| 81 | $filename = undef;
|
|---|
| 82 | }
|
|---|
| 83 | }
|
|---|
| 84 | unless (defined $filename) {
|
|---|
| 85 | # let C<require> do the searching
|
|---|
| 86 | $filename = "auto/$sub.al";
|
|---|
| 87 | $filename =~ s#::#/#g;
|
|---|
| 88 | }
|
|---|
| 89 | }
|
|---|
| 90 | my $save = $@;
|
|---|
| 91 | local $!; # Do not munge the value.
|
|---|
| 92 | eval { local $SIG{__DIE__}; require $filename };
|
|---|
| 93 | if ($@) {
|
|---|
| 94 | if (substr($sub,-9) eq '::DESTROY') {
|
|---|
|
|---|
