| Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/deprecate.pm |
| Statements | Executed 61 statements in 516µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 15 | 2 | 1 | 111µs | 111µs | deprecate::CORE:subst (opcode) |
| 3 | 1 | 1 | 104µs | 231µs | deprecate::__loaded_from_core |
| 3 | 1 | 1 | 23µs | 261µs | deprecate::import |
| 1 | 1 | 1 | 11µs | 22µs | deprecate::BEGIN@2 |
| 1 | 1 | 1 | 8µs | 12µs | deprecate::BEGIN@3 |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package deprecate; | ||||
| 2 | 2 | 22µs | 2 | 33µs | # spent 22µs (11+11) within deprecate::BEGIN@2 which was called:
# once (11µs+11µs) by if::work at line 2 # spent 22µs making 1 call to deprecate::BEGIN@2
# spent 11µs making 1 call to strict::import |
| 3 | 2 | 263µs | 2 | 16µs | # spent 12µs (8+4) within deprecate::BEGIN@3 which was called:
# once (8µs+4µs) by if::work at line 3 # spent 12µ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 | 100ns | our %Config; | ||
| 8 | 3 | 2µs | unless (%Config) { require Config; *Config = \%Config::Config; } | ||
| 9 | |||||
| 10 | # This isn't a public API. It's internal to code maintained by the perl-porters | ||||
| 11 | # If you would like it to be a public API, please send a patch with | ||||
| 12 | # documentation and tests. Until then, it may change without warning. | ||||
| 13 | # spent 231µs (104+127) within deprecate::__loaded_from_core which was called 3 times, avg 77µs/call:
# 3 times (104µs+127µs) by deprecate::import at line 39, avg 77µs/call | ||||
| 14 | 3 | 1µs | my ($package, $file, $expect_leaf) = @_; | ||
| 15 | |||||
| 16 | 3 | 7µs | foreach my $pair ([qw(sitearchexp archlibexp)], | ||
| 17 | [qw(sitelibexp privlibexp)]) { | ||||
| 18 | 6 | 37µs | 12 | 23µs | my ($site, $priv) = @Config{@$pair}; # spent 23µs making 12 calls to Config::FETCH, avg 2µs/call |
| 19 | 6 | 3µs | if ($^O eq 'VMS') { | ||
| 20 | for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; | ||||
| 21 | } | ||||
| 22 | # Just in case anyone managed to configure with trailing /s | ||||
| 23 | 6 | 130µs | 12 | 104µs | s!/*$!!g foreach $site, $priv; # spent 104µs making 12 calls to deprecate::CORE:subst, avg 9µs/call |
| 24 | |||||
| 25 | 6 | 600ns | next if $site eq $priv; | ||
| 26 | 6 | 9µs | if (uc("$priv/$expect_leaf") eq uc($file)) { | ||
| 27 | return 1; | ||||
| 28 | } | ||||
| 29 | } | ||||
| 30 | 3 | 7µs | return 0; | ||
| 31 | } | ||||
| 32 | |||||
| 33 | # spent 261µs (23+238) within deprecate::import which was called 3 times, avg 87µs/call:
# 3 times (23µs+238µs) by Devel::InnerPackage::BEGIN@7 or Module::Pluggable::BEGIN@7 or Module::Pluggable::Object::BEGIN@11 at line 15 of if.pm, avg 87µs/call | ||||
| 34 | 3 | 4µs | my ($package, $file) = caller; | ||
| 35 | |||||
| 36 | 3 | 1µs | my $expect_leaf = "$package.pm"; | ||
| 37 | 3 | 14µs | 3 | 7µs | $expect_leaf =~ s!::!/!g; # spent 7µs making 3 calls to deprecate::CORE:subst, avg 2µs/call |
| 38 | |||||
| 39 | 3 | 13µs | 3 | 231µs | if (__loaded_from_core($package, $file, $expect_leaf)) { # spent 231µs making 3 calls to deprecate::__loaded_from_core, avg 77µs/call |
| 40 | my $call_depth=1; | ||||
| 41 | my @caller; | ||||
| 42 | while (@caller = caller $call_depth++) { | ||||
| 43 | last if $caller[7] # use/require | ||||
| 44 | and $caller[6] eq $expect_leaf; # the package file | ||||
| 45 | } | ||||
| 46 | unless (@caller) { | ||||
| 47 | require Carp; | ||||
| 48 | Carp::cluck(<<"EOM"); | ||||
| 49 | Can't find use/require $expect_leaf in caller stack | ||||
| 50 | EOM | ||||
| 51 | return; | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | # This is fragile, because it | ||||
| 55 | # is directly poking in the internals of warnings.pm | ||||
| 56 | my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; | ||||
| 57 | |||||
| 58 | if (defined $callers_bitmask | ||||
| 59 | && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) | ||||
| 60 | || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { | ||||
| 61 | warn <<"EOM"; | ||||
| 62 | $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. | ||||
| 63 | EOM | ||||
| 64 | } | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | 1 | 3µs | 1; | ||
| 69 | |||||
| 70 | __END__ | ||||
sub deprecate::CORE:subst; # opcode |