1package deprecate; 2use strict; 3use warnings; 4our $VERSION = 0.01; 5 6# our %Config can ignore %Config::Config, e.g. for testing 7our %Config; 8unless (%Config) { require Config; *Config = \%Config::Config; } 9 10sub 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 if ($^O eq 'VMS') { 19 for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; 20 } 21 # Just in case anyone managed to configure with trailing /s 22 s!/*$!!g foreach $site, $priv; 23 24 next if $site eq $priv; 25 if (uc("$priv/$expect_leaf") eq uc($file)) { 26 my $call_depth=1; 27 my @caller; 28 while (@caller = caller $call_depth++) { 29 last if $caller[7] # use/require 30 and $caller[6] eq $expect_leaf; # the package file 31 } 32 unless (@caller) { 33 require Carp; 34 Carp::cluck(<<"EOM"); 35Can't find use/require $expect_leaf in caller stack 36EOM 37 next; 38 } 39 40 # This is fragile, because it 41 # is directly poking in the internals of warnings.pm 42 my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; 43 44 if (defined $callers_bitmask 45 && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) 46 || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { 47 warn <<"EOM"; 48$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. 49EOM 50 } 51 return; 52 } 53 } 54} 55 561; 57 58__END__ 59 60=head1 NAME 61 62deprecate - Perl pragma for deprecating the core version of a module 63 64=head1 SYNOPSIS 65 66 use deprecate; # always deprecate the module in which this occurs 67 68 use if $] > 5.010, 'deprecate'; # conditionally deprecate the module 69 70 71=head1 DESCRIPTION 72 73This module is used using C<use deprecate;> (or something that calls 74C<< deprecate->import() >>, for example C<use if COND, deprecate;>). 75 76If the module that includes C<use deprecate> is located in a core library 77directory, a deprecation warning is issued, encouraging the user to use 78the version on CPAN. If that module is located in a site library, it is 79the CPAN version, and no warning is issued. 80 81=head2 EXPORT 82 83None by default. The only method is C<import>, called by C<use deprecate;>. 84 85 86=head1 SEE ALSO 87 88First example to C<use deprecate;> was L<Switch>. 89 90 91=head1 AUTHOR 92 93Original version by Nicholas Clark 94 95 96=head1 COPYRIGHT AND LICENSE 97 98Copyright (C) 2009 99 100This library is free software; you can redistribute it and/or modify 101it under the same terms as Perl itself, either Perl version 5.10.0 or, 102at your option, any later version of Perl 5 you may have available. 103 104 105=cut 106