| Filename | /usr/share/perl/5.20/deprecate.pm |
| Statements | Executed 62 statements in 610µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 3 | 1 | 1 | 119µs | 203µs | deprecate::__loaded_from_core |
| 15 | 2 | 1 | 60µs | 60µs | deprecate::CORE:subst (opcode) |
| 3 | 1 | 1 | 28µs | 236µs | deprecate::import |
| 1 | 1 | 1 | 12µs | 27µs | deprecate::BEGIN@2 |
| 1 | 1 | 1 | 8µs | 13µs | deprecate::BEGIN@3 |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package deprecate; | ||||
| 2 | 2 | 23µs | 2 | 42µs | # spent 27µs (12+15) within deprecate::BEGIN@2 which was called:
# once (12µs+15µs) by if::work at line 2 # spent 27µs making 1 call to deprecate::BEGIN@2
# spent 15µs making 1 call to strict::import |
| 3 | 2 | 369µs | 2 | 19µs | # spent 13µs (8+6) within deprecate::BEGIN@3 which was called:
# once (8µs+6µs) by if::work at line 3 # spent 13µs making 1 call to deprecate::BEGIN@3
# spent 6µs making 1 call to warnings::import |
| 4 | 1 | 300ns | our $VERSION = 0.03; | ||
| 5 | |||||
| 6 | # our %Config can ignore %Config::Config, e.g. for testing | ||||
| 7 | 1 | 100ns | our %Config; | ||
| 8 | 3 | 2µs | unless (%Config) { require Config; *Config = \%Config::Config; } | ||
| 9 | |||||
| 10 | # Debian-specific change: recommend the separate Debian packages of | ||||
| 11 | # deprecated modules where available | ||||
| 12 | |||||
| 13 | 1 | 7µs | our %DEBIAN_PACKAGES = ( | ||
| 14 | 'CGI' => 'libcgi-pm-perl', | ||||
| 15 | 'CGI::Apache' => 'libcgi-pm-perl', | ||||
| 16 | 'CGI::Carp' => 'libcgi-pm-perl', | ||||
| 17 | 'CGI::Cookie' => 'libcgi-pm-perl', | ||||
| 18 | 'CGI::Fast' => 'libcgi-fast-perl', | ||||
| 19 | 'CGI::Pretty' => 'libcgi-pm-perl', | ||||
| 20 | 'CGI::Push' => 'libcgi-pm-perl', | ||||
| 21 | 'CGI::Switch' => 'libcgi-pm-perl', | ||||
| 22 | 'CGI::Util' => 'libcgi-pm-perl', | ||||
| 23 | 'Module::Build' => 'libmodule-build-perl', | ||||
| 24 | 'Package::Constants' => 'libpackage-constants-perl', | ||||
| 25 | ); | ||||
| 26 | |||||
| 27 | # This isn't a public API. It's internal to code maintained by the perl-porters | ||||
| 28 | # If you would like it to be a public API, please send a patch with | ||||
| 29 | # documentation and tests. Until then, it may change without warning. | ||||
| 30 | # spent 203µs (119+84) within deprecate::__loaded_from_core which was called 3 times, avg 68µs/call:
# 3 times (119µs+84µs) by deprecate::import at line 56, avg 68µs/call | ||||
| 31 | 3 | 2µs | my ($package, $file, $expect_leaf) = @_; | ||
| 32 | |||||
| 33 | 3 | 9µs | foreach my $pair ([qw(sitearchexp archlibexp)], | ||
| 34 | [qw(sitelibexp privlibexp)]) { | ||||
| 35 | 6 | 45µs | 12 | 29µs | my ($site, $priv) = @Config{@$pair}; # spent 29µs making 12 calls to Config::FETCH, avg 2µs/call |
| 36 | 6 | 5µs | if ($^O eq 'VMS') { | ||
| 37 | for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; | ||||
| 38 | } | ||||
| 39 | # Just in case anyone managed to configure with trailing /s | ||||
| 40 | 6 | 86µs | 12 | 55µs | s!/*$!!g foreach $site, $priv; # spent 55µs making 12 calls to deprecate::CORE:subst, avg 5µs/call |
| 41 | |||||
| 42 | 6 | 2µs | next if $site eq $priv; | ||
| 43 | 6 | 11µs | if (uc("$priv/$expect_leaf") eq uc($file)) { | ||
| 44 | return 1; | ||||
| 45 | } | ||||
| 46 | } | ||||
| 47 | 3 | 8µs | return 0; | ||
| 48 | } | ||||
| 49 | |||||
| 50 | # spent 236µs (28+208) within deprecate::import which was called 3 times, avg 79µs/call:
# 3 times (28µs+208µs) by CGI::BEGIN@3 or CGI::Cookie::BEGIN@6 or CGI::Util::BEGIN@5 at line 15 of if.pm, avg 79µs/call | ||||
| 51 | 3 | 6µs | my ($package, $file) = caller; | ||
| 52 | |||||
| 53 | 3 | 3µs | my $expect_leaf = "$package.pm"; | ||
| 54 | 3 | 14µs | 3 | 5µs | $expect_leaf =~ s!::!/!g; # spent 5µs making 3 calls to deprecate::CORE:subst, avg 2µs/call |
| 55 | |||||
| 56 | 3 | 14µs | 3 | 203µs | if (__loaded_from_core($package, $file, $expect_leaf)) { # spent 203µs making 3 calls to deprecate::__loaded_from_core, avg 68µs/call |
| 57 | my $call_depth=1; | ||||
| 58 | my @caller; | ||||
| 59 | while (@caller = caller $call_depth++) { | ||||
| 60 | last if $caller[7] # use/require | ||||
| 61 | and $caller[6] eq $expect_leaf; # the package file | ||||
| 62 | } | ||||
| 63 | unless (@caller) { | ||||
| 64 | require Carp; | ||||
| 65 | Carp::cluck(<<"EOM"); | ||||
| 66 | Can't find use/require $expect_leaf in caller stack | ||||
| 67 | EOM | ||||
| 68 | return; | ||||
| 69 | } | ||||
| 70 | |||||
| 71 | # This is fragile, because it | ||||
| 72 | # is directly poking in the internals of warnings.pm | ||||
| 73 | my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; | ||||
| 74 | |||||
| 75 | if (defined $callers_bitmask | ||||
| 76 | && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) | ||||
| 77 | || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { | ||||
| 78 | if (my $deb = $DEBIAN_PACKAGES{$package}) { | ||||
| 79 | warn <<"EOM"; | ||||
| 80 | $package will be removed from the Perl core distribution in the next major release. Please install the separate $deb package. It is being used at $call_file, line $call_line. | ||||
| 81 | EOM | ||||
| 82 | } else { | ||||
| 83 | warn <<"EOM"; | ||||
| 84 | $package will be removed from the Perl core distribution in the next major release. Please install it from CPAN. It is being used at $call_file, line $call_line. | ||||
| 85 | EOM | ||||
| 86 | } | ||||
| 87 | } | ||||
| 88 | } | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | 1 | 4µs | 1; | ||
| 92 | |||||
| 93 | __END__ | ||||
sub deprecate::CORE:subst; # opcode |