Filename | /usr/share/perl/5.18/deprecate.pm |
Statements | Executed 45 statements in 598µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 74µs | 127µs | __loaded_from_core | deprecate::
10 | 2 | 1 | 46µs | 46µs | CORE:subst (opcode) | deprecate::
2 | 1 | 1 | 13µs | 145µs | import | deprecate::
1 | 1 | 1 | 9µs | 20µs | BEGIN@2 | deprecate::
1 | 1 | 1 | 6µs | 10µs | BEGIN@3 | deprecate::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package deprecate; | ||||
2 | 2 | 20µs | 2 | 30µs | # spent 20µs (9+11) within deprecate::BEGIN@2 which was called:
# once (9µs+11µs) by if::work at line 2 # spent 20µs making 1 call to deprecate::BEGIN@2
# spent 11µs making 1 call to strict::import |
3 | 2 | 420µs | 2 | 15µs | # spent 10µs (6+4) within deprecate::BEGIN@3 which was called:
# once (6µs+4µs) by if::work at line 3 # spent 10µs making 1 call to deprecate::BEGIN@3
# spent 4µs making 1 call to warnings::import |
4 | 1 | 300ns | our $VERSION = 0.02; | ||
5 | |||||
6 | # our %Config can ignore %Config::Config, e.g. for testing | ||||
7 | 1 | 200ns | 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 | 20µs | our %DEBIAN_PACKAGES = ( | ||
14 | 'Archive::Extract' => 'libarchive-extract-perl', | ||||
15 | 'B::Lint' => 'libb-lint-perl', | ||||
16 | 'B::Lint::Debug' => 'libb-lint-perl', | ||||
17 | 'CPANPLUS::Dist::Build' => 'libcpanplus-dist-build-perl', | ||||
18 | 'CPANPLUS::Dist::Build::Constants' => 'libcpanplus-dist-build-perl', | ||||
19 | 'CPANPLUS' => 'libcpanplus-perl', | ||||
20 | 'CPANPLUS::Backend' => 'libcpanplus-perl', | ||||
21 | 'CPANPLUS::Backend::RV' => 'libcpanplus-perl', | ||||
22 | 'CPANPLUS::Config' => 'libcpanplus-perl', | ||||
23 | 'CPANPLUS::Config::HomeEnv' => 'libcpanplus-perl', | ||||
24 | 'CPANPLUS::Configure' => 'libcpanplus-perl', | ||||
25 | 'CPANPLUS::Configure::Setup' => 'libcpanplus-perl', | ||||
26 | 'CPANPLUS::Dist' => 'libcpanplus-perl', | ||||
27 | 'CPANPLUS::Dist::Autobundle' => 'libcpanplus-perl', | ||||
28 | 'CPANPLUS::Dist::Base' => 'libcpanplus-perl', | ||||
29 | 'CPANPLUS::Dist::MM' => 'libcpanplus-perl', | ||||
30 | 'CPANPLUS::Dist::Sample' => 'libcpanplus-perl', | ||||
31 | 'CPANPLUS::Error' => 'libcpanplus-perl', | ||||
32 | 'CPANPLUS::Internals' => 'libcpanplus-perl', | ||||
33 | 'CPANPLUS::Internals::Constants' => 'libcpanplus-perl', | ||||
34 | 'CPANPLUS::Internals::Constants::Report' => 'libcpanplus-perl', | ||||
35 | 'CPANPLUS::Internals::Extract' => 'libcpanplus-perl', | ||||
36 | 'CPANPLUS::Internals::Fetch' => 'libcpanplus-perl', | ||||
37 | 'CPANPLUS::Internals::Report' => 'libcpanplus-perl', | ||||
38 | 'CPANPLUS::Internals::Search' => 'libcpanplus-perl', | ||||
39 | 'CPANPLUS::Internals::Source' => 'libcpanplus-perl', | ||||
40 | 'CPANPLUS::Internals::Source::Memory' => 'libcpanplus-perl', | ||||
41 | 'CPANPLUS::Internals::Source::SQLite' => 'libcpanplus-perl', | ||||
42 | 'CPANPLUS::Internals::Source::SQLite::Tie' => 'libcpanplus-perl', | ||||
43 | 'CPANPLUS::Internals::Utils' => 'libcpanplus-perl', | ||||
44 | 'CPANPLUS::Internals::Utils::Autoflush' => 'libcpanplus-perl', | ||||
45 | 'CPANPLUS::Module' => 'libcpanplus-perl', | ||||
46 | 'CPANPLUS::Module::Author' => 'libcpanplus-perl', | ||||
47 | 'CPANPLUS::Module::Author::Fake' => 'libcpanplus-perl', | ||||
48 | 'CPANPLUS::Module::Checksums' => 'libcpanplus-perl', | ||||
49 | 'CPANPLUS::Module::Fake' => 'libcpanplus-perl', | ||||
50 | 'CPANPLUS::Module::Signature' => 'libcpanplus-perl', | ||||
51 | 'CPANPLUS::Selfupdate' => 'libcpanplus-perl', | ||||
52 | 'CPANPLUS::Shell' => 'libcpanplus-perl', | ||||
53 | 'CPANPLUS::Shell::Classic' => 'libcpanplus-perl', | ||||
54 | 'CPANPLUS::Shell::Default' => 'libcpanplus-perl', | ||||
55 | 'CPANPLUS::Shell::Default::Plugins::CustomSource' => 'libcpanplus-perl', | ||||
56 | 'CPANPLUS::Shell::Default::Plugins::Remote' => 'libcpanplus-perl', | ||||
57 | 'CPANPLUS::Shell::Default::Plugins::Source' => 'libcpanplus-perl', | ||||
58 | 'File::CheckTree' => 'libfile-checktree-perl', | ||||
59 | 'Log::Message::Simple' => 'liblog-message-simple-perl', | ||||
60 | 'Log::Message' => 'liblog-message-perl', | ||||
61 | 'Log::Message::Config' => 'liblog-message-perl', | ||||
62 | 'Log::Message::Handlers' => 'liblog-message-perl', | ||||
63 | 'Log::Message::Item' => 'liblog-message-perl', | ||||
64 | 'Devel::InnerPackage' => 'libmodule-pluggable-perl', | ||||
65 | 'Module::Pluggable' => 'libmodule-pluggable-perl', | ||||
66 | 'Module::Pluggable::Object' => 'libmodule-pluggable-perl', | ||||
67 | 'Object::Accessor' => 'libobject-accessor-perl', | ||||
68 | 'Pod::LaTeX' => 'libpod-latex-perl', | ||||
69 | 'Term::UI' => 'libterm-ui-perl', | ||||
70 | 'Term::UI::History' => 'libterm-ui-perl', | ||||
71 | 'Text::Soundex' => 'libtext-soundex-perl', | ||||
72 | ); | ||||
73 | |||||
74 | # This isn't a public API. It's internal to code maintained by the perl-porters | ||||
75 | # If you would like it to be a public API, please send a patch with | ||||
76 | # documentation and tests. Until then, it may change without warning. | ||||
77 | # spent 127µs (74+53) within deprecate::__loaded_from_core which was called 2 times, avg 64µs/call:
# 2 times (74µs+53µs) by deprecate::import at line 103, avg 64µs/call | ||||
78 | 2 | 1µs | my ($package, $file, $expect_leaf) = @_; | ||
79 | |||||
80 | 2 | 5µs | foreach my $pair ([qw(sitearchexp archlibexp)], | ||
81 | [qw(sitelibexp privlibexp)]) { | ||||
82 | 4 | 30µs | 8 | 12µs | my ($site, $priv) = @Config{@$pair}; # spent 12µs making 8 calls to Config::FETCH, avg 1µs/call |
83 | 4 | 4µs | if ($^O eq 'VMS') { | ||
84 | for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; | ||||
85 | } | ||||
86 | # Just in case anyone managed to configure with trailing /s | ||||
87 | 4 | 57µs | 8 | 41µs | s!/*$!!g foreach $site, $priv; # spent 41µs making 8 calls to deprecate::CORE:subst, avg 5µs/call |
88 | |||||
89 | 4 | 500ns | next if $site eq $priv; | ||
90 | 4 | 7µs | if (uc("$priv/$expect_leaf") eq uc($file)) { | ||
91 | return 1; | ||||
92 | } | ||||
93 | } | ||||
94 | 2 | 5µs | return 0; | ||
95 | } | ||||
96 | |||||
97 | # spent 145µs (13+132) within deprecate::import which was called 2 times, avg 73µs/call:
# 2 times (13µs+132µs) by Devel::InnerPackage::BEGIN@7 or Module::Pluggable::Object::BEGIN@11 at line 15 of if.pm, avg 73µs/call | ||||
98 | 2 | 2µs | my ($package, $file) = caller; | ||
99 | |||||
100 | 2 | 900ns | my $expect_leaf = "$package.pm"; | ||
101 | 2 | 9µs | 2 | 5µs | $expect_leaf =~ s!::!/!g; # spent 5µs making 2 calls to deprecate::CORE:subst, avg 2µs/call |
102 | |||||
103 | 2 | 7µs | 2 | 127µs | if (__loaded_from_core($package, $file, $expect_leaf)) { # spent 127µs making 2 calls to deprecate::__loaded_from_core, avg 64µs/call |
104 | my $call_depth=1; | ||||
105 | my @caller; | ||||
106 | while (@caller = caller $call_depth++) { | ||||
107 | last if $caller[7] # use/require | ||||
108 | and $caller[6] eq $expect_leaf; # the package file | ||||
109 | } | ||||
110 | unless (@caller) { | ||||
111 | require Carp; | ||||
112 | Carp::cluck(<<"EOM"); | ||||
113 | Can't find use/require $expect_leaf in caller stack | ||||
114 | EOM | ||||
115 | return; | ||||
116 | } | ||||
117 | |||||
118 | # This is fragile, because it | ||||
119 | # is directly poking in the internals of warnings.pm | ||||
120 | my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; | ||||
121 | |||||
122 | if (defined $callers_bitmask | ||||
123 | && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) | ||||
124 | || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { | ||||
125 | if (my $deb = $DEBIAN_PACKAGES{$package}) { | ||||
126 | warn <<"EOM"; | ||||
127 | $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. | ||||
128 | EOM | ||||
129 | } else { | ||||
130 | warn <<"EOM"; | ||||
131 | $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. | ||||
132 | EOM | ||||
133 | } | ||||
134 | } | ||||
135 | } | ||||
136 | } | ||||
137 | |||||
138 | 1 | 8µs | 1; | ||
139 | |||||
140 | __END__ | ||||
sub deprecate::CORE:subst; # opcode |