Time::Local in blead has diverged from CPAN. Update the version number to a dev release
[perl.git] / lib / deprecate.pm
1 package deprecate;
2 use strict;
3 use warnings;
4 our $VERSION = 0.01;
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 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         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");
35 Can't find use/require $expect_leaf in caller stack
36 EOM
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.
49 EOM
50             }
51             return;
52         }
53     }
54 }
55
56 1;
57
58 __END__
59
60 =head1 NAME
61
62 deprecate - 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
73 This module is used using C<use deprecate;> (or something that calls
74 C<< deprecate->import() >>, for example C<use if COND, deprecate;>).
75
76 If the module that includes C<use deprecate> is located in a core library
77 directory, a deprecation warning is issued, encouraging the user to use
78 the version on CPAN.  If that module is located in a site library, it is
79 the CPAN version, and no warning is issued.
80
81 =head2 EXPORT
82
83 None by default.  The only method is C<import>, called by C<use deprecate;>.
84
85
86 =head1 SEE ALSO
87
88 First example to C<use deprecate;> was L<Switch>.
89
90
91 =head1 AUTHOR
92
93 Original version by Nicholas Clark
94
95
96 =head1 COPYRIGHT AND LICENSE
97
98 Copyright (C) 2009 
99
100 This library is free software; you can redistribute it and/or modify
101 it under the same terms as Perl itself, either Perl version 5.10.0 or,
102 at your option, any later version of Perl 5 you may have available.
103
104
105 =cut