1105464Sphkpackage deprecate; 2105464Sphkuse strict; 3105464Sphkuse warnings; 4105464Sphkour $VERSION = 0.04; 5105464Sphk 6105464Sphk# our %Config can ignore %Config::Config, e.g. for testing 7105464Sphkour %Config; 8105464Sphkunless (%Config) { require Config; *Config = \%Config::Config; } 9105464Sphk 10105464Sphk# This isn't a public API. It's internal to code maintained by the perl-porters 11105464Sphk# If you would like it to be a public API, please send a patch with 12105464Sphk# documentation and tests. Until then, it may change without warning. 13105464Sphksub __loaded_from_core { 14105464Sphk my ($package, $file, $expect_leaf) = @_; 15105464Sphk 16105464Sphk foreach my $pair ([qw(sitearchexp archlibexp)], 17105464Sphk [qw(sitelibexp privlibexp)]) { 18105464Sphk my ($site, $priv) = @Config{@$pair}; 19105464Sphk if ($^O eq 'VMS') { 20105464Sphk for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) }; 21105464Sphk } 22105464Sphk # Just in case anyone managed to configure with trailing /s 23105464Sphk s!/*$!!g foreach $site, $priv; 24105464Sphk 25105464Sphk next if $site eq $priv; 26105464Sphk if (uc("$priv/$expect_leaf") eq uc($file)) { 27105464Sphk return 1; 28105464Sphk } 29105464Sphk } 30105464Sphk return 0; 31105464Sphk} 32105464Sphk 33105464Sphksub import { 34105464Sphk my ($package, $file) = caller; 35105464Sphk 36105464Sphk my $expect_leaf = "$package.pm"; 37105464Sphk $expect_leaf =~ s!::!/!g; 38105464Sphk 39105464Sphk if (__loaded_from_core($package, $file, $expect_leaf)) { 40105464Sphk my $call_depth=1; 41105464Sphk my @caller; 42105464Sphk while (@caller = caller $call_depth++) { 43105464Sphk last if $caller[7] # use/require 44219029Snetchild and $caller[6] eq $expect_leaf; # the package file 45105464Sphk } 46143418Sume unless (@caller) { 47106407Sphk require Carp; 48106407Sphk Carp::cluck(<<"EOM"); 49106407SphkCan't find use/require $expect_leaf in caller stack 50105464SphkEOM 51105464Sphk return; 52219029Snetchild } 53219029Snetchild 54105464Sphk # This is fragile, because it 55105464Sphk # is directly poking in the internals of warnings.pm 56105464Sphk my ($call_file, $call_line, $callers_bitmask) = @caller[1,2,9]; 57105464Sphk 58105464Sphk if (defined $callers_bitmask 59105464Sphk && (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1) 60105464Sphk || vec($callers_bitmask, $warnings::Offsets{all}, 1))) { 61105464Sphk warn <<"EOM"; 62105464Sphk$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. 63105464SphkEOM 64105464Sphk } 65105464Sphk } 66105464Sphk} 67105464Sphk 68105464Sphk1; 69105464Sphk 70105464Sphk__END__ 71105464Sphk 72105464Sphk=head1 NAME 73105464Sphk 74105464Sphkdeprecate - Perl pragma for deprecating the inclusion of a module in core 75105464Sphk 76105464Sphk=head1 SYNOPSIS 77105464Sphk 78105464Sphk use deprecate; # warn about future absence if loaded from core 79105464Sphk 80105464Sphk 81105464Sphk=head1 DESCRIPTION 82105464Sphk 83105464SphkThis pragma simplifies the maintenance of dual-life modules that will no longer 84105464Sphkbe included in the Perl core in a future Perl release, but are still included 85105464Sphkcurrently. 86105464Sphk 87105464SphkThe purpose of the pragma is to alert users to the status of such a module by 88238198Straszissuing a warning that encourages them to install the module from CPAN, so that 89105464Sphka future upgrade to a perl which omits the module will not break their code. 90105464Sphk 91105464SphkThis warning will only be issued if the module was loaded from a core library 92105464Sphkdirectory, which allows the C<use deprecate> line to be included in the CPAN 93105464Sphkversion of the module. Because the pragma remains silent when the module is run 94105464Sphkfrom a non-core library directory, the pragma call does not need to be patched 95105464Sphkinto or out of either the core or CPAN version of the module. The exact same 96105464Sphkcode can be shipped for either purpose. 97105464Sphk 98105464Sphk=head2 Important Caveat 99105464Sphk 100105464SphkNote that when a module installs from CPAN to a core library directory rather 101105464Sphkthan the site library directories, the user gains no protection from having 102105464Sphkinstalled it. 103105464Sphk 104105464SphkAt the same time, this pragma cannot detect when such a module has installed 105105464Sphkfrom CPAN to the core library, and so it would endlessly and uselessly exhort 106105464Sphkthe user to upgrade. 107105464Sphk 108105464SphkTherefore modules that can install from CPAN to the core library must make sure 109105464Sphknot to call this pragma when they have done so. Generally this means that the 110125755Sphkexact logic from the installer must be mirrored inside the module. E.g.: 111105464Sphk 112105464Sphk # Makefile.PL 113115624Sphk WriteMakefile( 114112828Sphk # ... 115112828Sphk INSTALLDIRS => ( "$]" >= 5.011 ? 'site' : 'perl' ), 116112828Sphk ); 117112828Sphk 118112828Sphk # lib/Foo/Bar.pm 119112828Sphk use if "$]" >= 5.011, 'deprecate'; 120112828Sphk 121112828Sphk(The above example shows the most important case of this: when the target is 122112828Sphka Perl older than 5.12 (where the core library directories take precedence over 123112828Sphkthe site library directories) and the module being installed was included in 124112828Sphkcore in that Perl version. Under those circumstances, an upgrade of the module 125112828Sphkfrom CPAN is only possible by installing to the core library.) 126112828Sphk 127112828Sphk 128112828Sphk=head1 EXPORT 129112828Sphk 130112828SphkNone by default. The only method is C<import>, called by C<use deprecate;>. 131112828Sphk 132112828Sphk 133112828Sphk=head1 SEE ALSO 134125755Sphk 135112828SphkFirst example to C<use deprecate;> was L<Switch>. 136112828Sphk 137112828Sphk 138112828Sphk=head1 AUTHOR 139115624Sphk 140125590SphkOriginal version by Nicholas Clark 141112828Sphk 142114720Sphk 143114720Sphk=head1 COPYRIGHT AND LICENSE 144114720Sphk 145114720SphkCopyright (C) 2009, 2011 146114720Sphk 147115624SphkThis library is free software; you can redistribute it and/or modify 148114720Sphkit under the same terms as Perl itself, either Perl version 5.10.0 or, 149114720Sphkat your option, any later version of Perl 5 you may have available. 150114720Sphk 151114720Sphk 152115624Sphk=cut 153114720Sphk