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             # 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;