Commit | Line | Data |
---|---|---|
e76b2c0c NC |
1 | #!perl -w |
2 | use strict; | |
3 | ||
4 | package deprecate; | |
5 | use Config; | |
6 | use Carp; | |
7 | use warnings; | |
8 | our $VERSION = 0.01; | |
9 | ||
10 | sub import { | |
11 | my ($package, $file, $line) = caller; | |
12 | my $expect_leaf = "$package.pm"; | |
13 | $expect_leaf =~ s!::!/!g; | |
14 | ||
15 | foreach my $pair ([qw(sitearchexp archlibexp)], | |
16 | [qw(sitelibexp privlibexp)]) { | |
17 | my ($site, $priv) = @Config{@$pair}; | |
18 | # Just in case anyone managed to configure with trailing /s | |
19 | s!/*$!!g foreach $site, $priv; | |
20 | ||
21 | next if $site eq $priv; | |
22 | if ("$priv/$expect_leaf" eq $file) { | |
23 | # This is fragile, because it | |
24 | # 1: depends on the number of call stacks in if.pm | |
25 | # 2: is directly poking in the internals of warnings.pm | |
26 | my ($call_file, $call_line, $callers_bitmask) = (caller 3)[1,2,9]; | |
27 | ||
28 | if (defined $callers_bitmask | |
29 | && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) | |
30 | || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { | |
31 | warn <<"EOM"; | |
32 | $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 | |
33 | EOM | |
34 | } | |
35 | return; | |
36 | } | |
37 | } | |
38 | } | |
39 | ||
40 | 1; |