1package deprecate; 2use strict; 3use warnings; 4our $VERSION = 0.04; 5 6# our %Config can ignore %Config::Config, e.g. for testing 7our %Config; 8unless (%Config) { require Config; *Config = \%Config::Config; } 9 10# This isn't a public API. It's internal to code maintained by the perl-porters 11# If you would like it to be a public API, please send a patch with 12# documentation and tests. Until then, it may change without warning. 13sub __loaded_from_core { 14 my ($package, $file, $expect_leaf) = @_; 15 16 foreach my $pair ([qw(sitearchexp archlibexp)], 17 [qw(sitelibexp privlibexp)]) { 18 my ($site, $priv) = @Config{@$pair}; 19 if ($^O eq 'VMS') { 20 for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; 21 } 22 # Just in case anyone managed to configure with trailing /s 23 s!/*$!!g foreach $site, $priv; 24 25 next if $site eq $priv; 26 if (uc("$priv/$expect_leaf") eq uc($file)) { 27 return 1; 28 } 29 } 30 return 0; 31} 32 33sub import { 34 my ($package, $file) = caller; 35 36 my $expect_leaf = "$package.pm"; 37 $expect_leaf =~ s!::!/!g; 38 39 if (__loaded_from_core($package, $file, $expect_leaf)) { 40 my $call_depth=1; 41 my @caller; 42 while (@caller = caller $call_depth++) { 43 last if $caller[7] # use/require 44 and $caller[6] eq $expect_leaf; # the package file 45 } 46 unless (@caller) { 47 require Carp; 48 Carp::cluck(<<"EOM"); 49Can't find use/require $expect_leaf in caller stack 50EOM 51 return; 52 } 53 54 # This is fragile, because it 55 # is directly poking in the internals of warnings.pm 56 my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; 57 58 if (defined $callers_bitmask 59 && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) 60 || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { 61 warn <<"EOM"; 62$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. 63EOM 64 } 65 } 66} 67 681; 69 70__END__ 71 72=head1 NAME 73 74deprecate - Perl pragma for deprecating the inclusion of a module in core 75 76=head1 SYNOPSIS 77 78 use deprecate; # warn about future absence if loaded from core 79 80 81=head1 DESCRIPTION 82 83This pragma simplifies the maintenance of dual-life modules that will no longer 84be included in the Perl core in a future Perl release, but are still included 85currently. 86 87The purpose of the pragma is to alert users to the status of such a module by 88issuing a warning that encourages them to install the module from CPAN, so that 89a future upgrade to a perl which omits the module will not break their code. 90 91This warning will only be issued if the module was loaded from a core library 92directory, which allows the C<use deprecate> line to be included in the CPAN 93version of the module. Because the pragma remains silent when the module is run 94from a non-core library directory, the pragma call does not need to be patched 95into or out of either the core or CPAN version of the module. The exact same 96code can be shipped for either purpose. 97 98=head2 Important Caveat 99 100Note that when a module installs from CPAN to a core library directory rather 101than the site library directories, the user gains no protection from having 102installed it. 103 104At the same time, this pragma cannot detect when such a module has installed 105from CPAN to the core library, and so it would endlessly and uselessly exhort 106the user to upgrade. 107 108Therefore modules that can install from CPAN to the core library must make sure 109not to call this pragma when they have done so. Generally this means that the 110exact logic from the installer must be mirrored inside the module. E.g.: 111 112 # Makefile.PL 113 WriteMakefile( 114 # ... 115 INSTALLDIRS => ( "$]" >= 5.011 ? 'site' : 'perl' ), 116 ); 117 118 # lib/Foo/Bar.pm 119 use if "$]" >= 5.011, 'deprecate'; 120 121(The above example shows the most important case of this: when the target is 122a Perl older than 5.12 (where the core library directories take precedence over 123the site library directories) and the module being installed was included in 124core in that Perl version. Under those circumstances, an upgrade of the module 125from CPAN is only possible by installing to the core library.) 126 127 128=head1 EXPORT 129 130None by default. The only method is C<import>, called by C<use deprecate;>. 131 132 133=head1 SEE ALSO 134 135First example to C<use deprecate;> was L<Switch>. 136 137 138=head1 AUTHOR 139 140Original version by Nicholas Clark 141 142 143=head1 COPYRIGHT AND LICENSE 144 145Copyright (C) 2009, 2011 146 147This library is free software; you can redistribute it and/or modify 148it under the same terms as Perl itself, either Perl version 5.10.0 or, 149at your option, any later version of Perl 5 you may have available. 150 151 152=cut 153