| File | /usr/share/perl/5.8/AutoLoader.pm | Statements Executed | 45 | Total Time | 0.000442 seconds |
| Calls | Inclusive Time | Subroutine | |
|---|---|---|---|
| 1 | 0.00031 | AutoLoader:: | AUTOLOAD |
| 0 | 0 | AutoLoader:: | BEGIN |
| 0 | 0 | AutoLoader:: | __ANON__[:96] |
| 0 | 0 | AutoLoader:: | import |
| 0 | 0 | AutoLoader:: | unimport |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 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 | # spent 0.00031s within AutoLoader::AUTOLOAD which was called:
# 1 times (0.00031s) by Cache::Memcached::_load_multi or Cache::Memcached::__ANON__[/usr/local/share/perl/5.8.8/Cache/Memcached.pm:668] at line 660 of /usr/local/share/perl/5.8.8/Cache/Memcached.pm AUTOLOAD { | |||
| 22 | 2 | 2e-06 | 1e-06 | my $sub = $AUTOLOAD; |
| 23 | 2 | 1e-06 | 5e-07 | 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 | 4 | 0.00002 | 4e-06 | my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); |
| 40 | 2 | 5e-06 | 2e-06 | $pkg =~ s#::#/#g; |
| 41 | 2 | 8e-06 | 4e-06 | if (defined($filename = $INC{"$pkg.pm"})) { |
| 42 | 2 | 2e-06 | 1e-06 | if ($is_macos) { |
| 43 | $pkg =~ tr#/#:#; | |||
| 44 | $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; | |||
| 45 | } else { | |||
| 46 | 2 | 0.00005 | 0.00003 | $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 | 2 | 0.00004 | 0.00002 | if (-r $filename) { |
| 56 | 1 | 2e-06 | 2e-06 | 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 | 1 | 1e-06 | 1e-06 | $filename = undef; |
| 82 | } | |||
| 83 | } | |||
| 84 | 2 | 2e-06 | 1e-06 | unless (defined $filename) { |
| 85 | # let C<require> do the searching | |||
| 86 | 1 | 2e-06 | 2e-06 | $filename = "auto/$sub.al"; |
| 87 | 1 | 5e-06 | 5e-06 | $filename =~ s#::#/#g; |
| 88 | } | |||
| 89 | } | |||
| 90 | 2 | 1e-06 | 5e-07 | my $save = $@; |
| 91 | 2 | 0.00001 | 6e-06 | local $!; # Do not munge the value. |
| 92 | 6 | 0.00027 | 0.00005 | eval { local $SIG{__DIE__}; require $filename }; |
| 93 | 2 | 1e-06 | 5e-07 | if ($@) { |
| 94 | 1 | 2e-06 | 2e-06 | if (substr($sub,-9) eq '::DESTROY') { |
| 95 | no strict 'refs'; | |||
| 96 | 2 | 6e-06 | 3e-06 | *$sub = sub {}; |
| 97 | 1 | 1e-06 | 1e-06 | $@ = undef; |
| 98 | } elsif ($@ =~ /^Can't locate/) { | |||
| 99 | # The load might just have failed because the filename was too | |||
| 100 | # long for some old SVR3 systems which treat long names as errors. | |||
| 101 | # If we can successfully truncate a long name then it's worth a go. | |||
| 102 | # There is a slight risk that we could pick up the wrong file here | |||
| 103 | # but autosplit should have warned about that when splitting. | |||
| 104 | if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ | |||
| 105 | eval { local $SIG{__DIE__}; require $filename }; | |||
| 106 | } | |||
| 107 | } | |||
| 108 | 1 | 0 | 0 | if ($@){ |
| 109 | $@ =~ s/ at .*\n//; | |||
| 110 | my $error = $@; | |||
| 111 | require Carp; | |||
| 112 | Carp::croak($error); | |||
| 113 | } | |||
| 114 | } | |||
| 115 | 2 | 0 | 0 | $@ = $save; |
| 116 | 2 | 7e-06 | 3e-06 | goto &$sub; |
| 117 | } | |||
| 118 | ||||
| 119 | sub import { | |||
| 120 | my $pkg = shift; | |||
| 121 | my $callpkg = caller; | |||
| 122 | ||||
| 123 | # | |||
| 124 | # Export symbols, but not by accident of inheritance. | |||
| 125 | # | |||
| 126 | ||||
| 127 | if ($pkg eq 'AutoLoader') { | |||
| 128 | no strict 'refs'; | |||
| 129 | *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD | |||
| 130 | if @_ and $_[0] =~ /^&?AUTOLOAD$/; | |||
| 131 | } | |||
| 132 | ||||
| 133 | # | |||
| 134 | # Try to find the autosplit index file. Eg., if the call package | |||
| 135 | # is POSIX, then $INC{POSIX.pm} is something like | |||
| 136 | # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in | |||
| 137 | # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. | |||
| 138 | # | |||
| 139 | # However, if @INC is a relative path, this might not work. If, | |||
| 140 | # for example, @INC = ('lib'), then | |||
| 141 | # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require | |||
| 142 | # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). | |||
| 143 | # | |||
| 144 | ||||
| 145 | (my $calldir = $callpkg) =~ s#::#/#g; | |||
| 146 | my $path = $INC{$calldir . '.pm'}; | |||
| 147 | if (defined($path)) { | |||
| 148 | # Try absolute path name. | |||
| 149 | if ($is_macos) { | |||
| 150 | (my $malldir = $calldir) =~ tr#/#:#; | |||
| 151 | $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s; | |||
| 152 | } else { | |||
| 153 | $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#; | |||
| 154 | } | |||
| 155 | ||||
| 156 | eval { require $path; }; | |||
| 157 | # If that failed, try relative path with normal @INC searching. | |||
| 158 | if ($@) { | |||
| 159 | $path ="auto/$calldir/autosplit.ix"; | |||
| 160 | eval { require $path; }; | |||
| 161 | } | |||
| 162 | if ($@) { | |||
| 163 | my $error = $@; | |||
| 164 | require Carp; | |||
| 165 | Carp::carp($error); | |||
| 166 | } | |||
| 167 | } | |||
| 168 | } | |||
| 169 | ||||
| 170 | sub unimport { | |||
| 171 | my $callpkg = caller; | |||
| 172 | ||||
| 173 | no strict 'refs'; | |||
| 174 | my $symname = $callpkg . '::AUTOLOAD'; | |||
| 175 | undef *{ $symname } if \&{ $symname } == \&AUTOLOAD; | |||
| 176 | *{ $symname } = \&{ $symname }; | |||
| 177 | } | |||
| 178 | ||||
| 179 | 1; | |||
| 180 | ||||
| 181 | __END__ | |||
| 182 |