068c1b9564150f4d59262ab20154e7dda985e923
[perl.git] / lib / deprecate.pm
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             my $call_depth=1;
24             my @caller;
25             while (@caller = caller $call_depth++) {
26                 last if $caller[7]                      # use/require
27                     and $caller[6] eq $expect_leaf;     # the package file
28             }
29             unless (@caller) {
30                 require Carp;
31                 Carp::cluck(<<"EOM");
32 Can't find use/require $expect_leaf in caller stack
33 EOM
34                 next;
35             }
36
37             # This is fragile, because it
38             # is directly poking in the internals of warnings.pm
39             my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9];
40
41             if (defined $callers_bitmask
42                 && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1)
43                     || vec($callers_bitmask, $warnings::Offsets{all}, 1))) {
44                 warn <<"EOM";
45 $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
46 EOM
47             }
48             return;
49         }
50     }
51 }
52
53 1;