"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/deprecate.pm" (7 Mar 2020, 4603 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package deprecate;
    2 use strict;
    3 use warnings;
    4 our $VERSION = 0.04;
    5 
    6 # our %Config can ignore %Config::Config, e.g. for testing
    7 our %Config;
    8 unless (%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.
   13 sub __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 
   33 sub 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");
   49 Can't find use/require $expect_leaf in caller stack
   50 EOM
   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.
   63 EOM
   64     }
   65     }
   66 }
   67 
   68 1;
   69 
   70 __END__
   71 
   72 =head1 NAME
   73 
   74 deprecate - 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 
   83 This pragma simplifies the maintenance of dual-life modules that will no longer
   84 be included in the Perl core in a future Perl release, but are still included
   85 currently.
   86 
   87 The purpose of the pragma is to alert users to the status of such a module by
   88 issuing a warning that encourages them to install the module from CPAN, so that
   89 a future upgrade to a perl which omits the module will not break their code.
   90 
   91 This warning will only be issued if the module was loaded from a core library
   92 directory, which allows the C<use deprecate> line to be included in the CPAN
   93 version of the module. Because the pragma remains silent when the module is run
   94 from a non-core library directory, the pragma call does not need to be patched
   95 into or out of either the core or CPAN version of the module. The exact same
   96 code can be shipped for either purpose.
   97 
   98 =head2 Important Caveat
   99 
  100 Note that when a module installs from CPAN to a core library directory rather
  101 than the site library directories, the user gains no protection from having
  102 installed it.
  103 
  104 At the same time, this pragma cannot detect when such a module has installed
  105 from CPAN to the core library, and so it would endlessly and uselessly exhort
  106 the user to upgrade.
  107 
  108 Therefore modules that can install from CPAN to the core library must make sure
  109 not to call this pragma when they have done so. Generally this means that the
  110 exact 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
  122 a Perl older than 5.12 (where the core library directories take precedence over
  123 the site library directories) and the module being installed was included in
  124 core in that Perl version. Under those circumstances, an upgrade of the module
  125 from CPAN is only possible by installing to the core library.)
  126 
  127 
  128 =head1 EXPORT
  129 
  130 None by default.  The only method is C<import>, called by C<use deprecate;>.
  131 
  132 
  133 =head1 SEE ALSO
  134 
  135 First example to C<use deprecate;> was L<Switch>.
  136 
  137 
  138 =head1 AUTHOR
  139 
  140 Original version by Nicholas Clark
  141 
  142 
  143 =head1 COPYRIGHT AND LICENSE
  144 
  145 Copyright (C) 2009, 2011
  146 
  147 This library is free software; you can redistribute it and/or modify
  148 it under the same terms as Perl itself, either Perl version 5.10.0 or,
  149 at your option, any later version of Perl 5 you may have available.
  150 
  151 
  152 =cut