diff options
author | Robin Barker <Robin.Barker@npl.co.uk> | 2009-02-24 09:57:23 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2009-02-24 15:58:54 +0100 |
commit | d4be36a8ea2b96180ed1c8dd5001a069eb7348d6 (patch) | |
tree | 750a685c049d0f0adc9d422369c8ce4abc5ae354 /lib/deprecate.pm | |
parent | 7ffb7798185e72d66b671d7209f888cedcf783be (diff) | |
download | perl-d4be36a8ea2b96180ed1c8dd5001a069eb7348d6.tar.gz |
remove explicit caller depth in deprecate.pm by searching caller stack for use/require Module.pm
Diffstat (limited to 'lib/deprecate.pm')
-rw-r--r-- | lib/deprecate.pm | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/lib/deprecate.pm b/lib/deprecate.pm index 23c045b4e9..068c1b9564 100644 --- a/lib/deprecate.pm +++ b/lib/deprecate.pm @@ -20,10 +20,23 @@ sub import { next if $site eq $priv; if ("$priv/$expect_leaf" eq $file) { + my $call_depth=1; + my @caller; + while (@caller = caller $call_depth++) { + last if $caller[7] # use/require + and $caller[6] eq $expect_leaf; # the package file + } + unless (@caller) { + require Carp; + Carp::cluck(<<"EOM"); +Can't find use/require $expect_leaf in caller stack +EOM + next; + } + # This is fragile, because it - # 1: depends on the number of call stacks in if.pm - # 2: is directly poking in the internals of warnings.pm - my ($call_file, $call_line, $callers_bitmask) = (caller 3)[1,2,9]; + # is directly poking in the internals of warnings.pm + my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; if (defined $callers_bitmask && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) |