| Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/AutoLoader.pm |
| Statements | Executed 21 statements in 735µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 14µs | 14µs | AutoLoader::BEGIN@4 |
| 1 | 1 | 1 | 12µs | 26µs | AutoLoader::BEGIN@3 |
| 1 | 1 | 1 | 8µs | 18µs | AutoLoader::BEGIN@138 |
| 1 | 1 | 1 | 7µs | 19µs | AutoLoader::BEGIN@30 |
| 1 | 1 | 1 | 7µs | 16µs | AutoLoader::BEGIN@186 |
| 1 | 1 | 1 | 6µs | 6µs | AutoLoader::BEGIN@13 |
| 0 | 0 | 0 | 0s | 0s | AutoLoader::AUTOLOAD |
| 0 | 0 | 0 | 0s | 0s | AutoLoader::__ANON__[:31] |
| 0 | 0 | 0 | 0s | 0s | AutoLoader::find_filename |
| 0 | 0 | 0 | 0s | 0s | AutoLoader::import |
| 0 | 0 | 0 | 0s | 0s | AutoLoader::unimport |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package AutoLoader; | ||||
| 2 | |||||
| 3 | 2 | 23µs | 2 | 41µs | # spent 26µs (12+15) within AutoLoader::BEGIN@3 which was called:
# once (12µs+15µs) by Benchmark::Perl::Formance::BEGIN@12 at line 3 # spent 26µs making 1 call to AutoLoader::BEGIN@3
# spent 15µs making 1 call to strict::import |
| 4 | 2 | 85µs | 1 | 14µs | # spent 14µs within AutoLoader::BEGIN@4 which was called:
# once (14µs+0s) by Benchmark::Perl::Formance::BEGIN@12 at line 4 # spent 14µs making 1 call to AutoLoader::BEGIN@4 |
| 5 | |||||
| 6 | 1 | 200ns | our($VERSION, $AUTOLOAD); | ||
| 7 | |||||
| 8 | 1 | 200ns | my $is_dosish; | ||
| 9 | 1 | 100ns | my $is_epoc; | ||
| 10 | 1 | 0s | my $is_vms; | ||
| 11 | 1 | 0s | my $is_macos; | ||
| 12 | |||||
| 13 | # spent 6µs within AutoLoader::BEGIN@13 which was called:
# once (6µs+0s) by Benchmark::Perl::Formance::BEGIN@12 at line 19 | ||||
| 14 | 1 | 2µs | $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; | ||
| 15 | 1 | 300ns | $is_epoc = $^O eq 'epoc'; | ||
| 16 | 1 | 300ns | $is_vms = $^O eq 'VMS'; | ||
| 17 | 1 | 300ns | $is_macos = $^O eq 'MacOS'; | ||
| 18 | 1 | 4µs | $VERSION = '5.72'; | ||
| 19 | 1 | 52µs | 1 | 6µs | } # spent 6µs making 1 call to AutoLoader::BEGIN@13 |
| 20 | |||||
| 21 | AUTOLOAD { | ||||
| 22 | my $sub = $AUTOLOAD; | ||||
| 23 | my $filename = AutoLoader::find_filename( $sub ); | ||||
| 24 | |||||
| 25 | my $save = $@; | ||||
| 26 | local $!; # Do not munge the value. | ||||
| 27 | eval { local $SIG{__DIE__}; require $filename }; | ||||
| 28 | if ($@) { | ||||
| 29 | if (substr($sub,-9) eq '::DESTROY') { | ||||
| 30 | 2 | 357µs | 2 | 32µs | # spent 19µs (7+12) within AutoLoader::BEGIN@30 which was called:
# once (7µs+12µs) by Benchmark::Perl::Formance::BEGIN@12 at line 30 # spent 19µs making 1 call to AutoLoader::BEGIN@30
# spent 12µs making 1 call to strict::unimport |
| 31 | *$sub = sub {}; | ||||
| 32 | $@ = undef; | ||||
| 33 | } elsif ($@ =~ /^Can't locate/) { | ||||
| 34 | # The load might just have failed because the filename was too | ||||
| 35 | # long for some old SVR3 systems which treat long names as errors. | ||||
| 36 | # If we can successfully truncate a long name then it's worth a go. | ||||
| 37 | # There is a slight risk that we could pick up the wrong file here | ||||
| 38 | # but autosplit should have warned about that when splitting. | ||||
| 39 | if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ | ||||
| 40 | eval { local $SIG{__DIE__}; require $filename }; | ||||
| 41 | } | ||||
| 42 | } | ||||
| 43 | if ($@){ | ||||
| 44 | $@ =~ s/ at .*\n//; | ||||
| 45 | my $error = $@; | ||||
| 46 | require Carp; | ||||
| 47 | Carp::croak($error); | ||||
| 48 | } | ||||
| 49 | } | ||||
| 50 | $@ = $save; | ||||
| 51 | goto &$sub; | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | sub find_filename { | ||||
| 55 | my $sub = shift; | ||||
| 56 | my $filename; | ||||
| 57 | # Braces used to preserve $1 et al. | ||||
| 58 | { | ||||
| 59 | # Try to find the autoloaded file from the package-qualified | ||||
| 60 | # name of the sub. e.g., if the sub needed is | ||||
| 61 | # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is | ||||
| 62 | # something like '/usr/lib/perl5/Getopt/Long.pm', and the | ||||
| 63 | # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. | ||||
| 64 | # | ||||
| 65 | # However, if @INC is a relative path, this might not work. If, | ||||
| 66 | # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is | ||||
| 67 | # 'lib/Getopt/Long.pm', and we want to require | ||||
| 68 | # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). | ||||
| 69 | # In this case, we simple prepend the 'auto/' and let the | ||||
| 70 | # C<require> take care of the searching for us. | ||||
| 71 | |||||
| 72 | my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); | ||||
| 73 | $pkg =~ s#::#/#g; | ||||
| 74 | if (defined($filename = $INC{"$pkg.pm"})) { | ||||
| 75 | if ($is_macos) { | ||||
| 76 | $pkg =~ tr#/#:#; | ||||
| 77 | $filename = undef | ||||
| 78 | unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; | ||||
| 79 | } else { | ||||
| 80 | $filename = undef | ||||
| 81 | unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; | ||||
| 82 | } | ||||
| 83 | |||||
| 84 | # if the file exists, then make sure that it is a | ||||
| 85 | # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', | ||||
| 86 | # or './lib/auto/foo/bar.al'. This avoids C<require> searching | ||||
| 87 | # (and failing) to find the 'lib/auto/foo/bar.al' because it | ||||
| 88 | # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). | ||||
| 89 | |||||
| 90 | if (defined $filename and -r $filename) { | ||||
| 91 | unless ($filename =~ m|^/|s) { | ||||
| 92 | if ($is_dosish) { | ||||
| 93 | unless ($filename =~ m{^([a-z]:)?[\\/]}is) { | ||||
| 94 | if ($^O ne 'NetWare') { | ||||
| 95 | $filename = "./$filename"; | ||||
| 96 | } else { | ||||
| 97 | $filename = "$filename"; | ||||
| 98 | } | ||||
| 99 | } | ||||
| 100 | } | ||||
| 101 | elsif ($is_epoc) { | ||||
| 102 | unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { | ||||
| 103 | $filename = "./$filename"; | ||||
| 104 | } | ||||
| 105 | } | ||||
| 106 | elsif ($is_vms) { | ||||
| 107 | # XXX todo by VMSmiths | ||||
| 108 | $filename = "./$filename"; | ||||
| 109 | } | ||||
| 110 | elsif (!$is_macos) { | ||||
| 111 | $filename = "./$filename"; | ||||
| 112 | } | ||||
| 113 | } | ||||
| 114 | } | ||||
| 115 | else { | ||||
| 116 | $filename = undef; | ||||
| 117 | } | ||||
| 118 | } | ||||
| 119 | unless (defined $filename) { | ||||
| 120 | # let C<require> do the searching | ||||
| 121 | $filename = "auto/$sub.al"; | ||||
| 122 | $filename =~ s#::#/#g; | ||||
| 123 | } | ||||
| 124 | } | ||||
| 125 | return $filename; | ||||
| 126 | } | ||||
| 127 | |||||
| 128 | sub import { | ||||
| 129 | my $pkg = shift; | ||||
| 130 | my $callpkg = caller; | ||||
| 131 | |||||
| 132 | # | ||||
| 133 | # Export symbols, but not by accident of inheritance. | ||||
| 134 | # | ||||
| 135 | |||||
| 136 | if ($pkg eq 'AutoLoader') { | ||||
| 137 | if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { | ||||
| 138 | 2 | 152µs | 2 | 29µs | # spent 18µs (8+11) within AutoLoader::BEGIN@138 which was called:
# once (8µs+11µs) by Benchmark::Perl::Formance::BEGIN@12 at line 138 # spent 18µs making 1 call to AutoLoader::BEGIN@138
# spent 11µs making 1 call to strict::unimport |
| 139 | *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; | ||||
| 140 | } | ||||
| 141 | } | ||||
| 142 | |||||
| 143 | # | ||||
| 144 | # Try to find the autosplit index file. Eg., if the call package | ||||
| 145 | # is POSIX, then $INC{POSIX.pm} is something like | ||||
| 146 | # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in | ||||
| 147 | # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. | ||||
| 148 | # | ||||
| 149 | # However, if @INC is a relative path, this might not work. If, | ||||
| 150 | # for example, @INC = ('lib'), then | ||||
| 151 | # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require | ||||
| 152 | # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). | ||||
| 153 | # | ||||
| 154 | |||||
| 155 | (my $calldir = $callpkg) =~ s#::#/#g; | ||||
| 156 | my $path = $INC{$calldir . '.pm'}; | ||||
| 157 | if (defined($path)) { | ||||
| 158 | # Try absolute path name, but only eval it if the | ||||
| 159 | # transformation from module path to autosplit.ix path | ||||
| 160 | # succeeded! | ||||
| 161 | my $replaced_okay; | ||||
| 162 | if ($is_macos) { | ||||
| 163 | (my $malldir = $calldir) =~ tr#/#:#; | ||||
| 164 | $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s); | ||||
| 165 | } else { | ||||
| 166 | $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#); | ||||
| 167 | } | ||||
| 168 | |||||
| 169 | eval { require $path; } if $replaced_okay; | ||||
| 170 | # If that failed, try relative path with normal @INC searching. | ||||
| 171 | if (!$replaced_okay or $@) { | ||||
| 172 | $path ="auto/$calldir/autosplit.ix"; | ||||
| 173 | eval { require $path; }; | ||||
| 174 | } | ||||
| 175 | if ($@) { | ||||
| 176 | my $error = $@; | ||||
| 177 | require Carp; | ||||
| 178 | Carp::carp($error); | ||||
| 179 | } | ||||
| 180 | } | ||||
| 181 | } | ||||
| 182 | |||||
| 183 | sub unimport { | ||||
| 184 | my $callpkg = caller; | ||||
| 185 | |||||
| 186 | 2 | 57µs | 2 | 26µs | # spent 16µs (7+9) within AutoLoader::BEGIN@186 which was called:
# once (7µs+9µs) by Benchmark::Perl::Formance::BEGIN@12 at line 186 # spent 16µs making 1 call to AutoLoader::BEGIN@186
# spent 9µs making 1 call to strict::unimport |
| 187 | |||||
| 188 | for my $exported (qw( AUTOLOAD )) { | ||||
| 189 | my $symname = $callpkg . '::' . $exported; | ||||
| 190 | undef *{ $symname } if \&{ $symname } == \&{ $exported }; | ||||
| 191 | *{ $symname } = \&{ $symname }; | ||||
| 192 | } | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | 1 | 2µs | 1; | ||
| 196 | |||||
| 197 | __END__ |