1: # deprecated - pragmatic module to mark a package or a sub as unsupported
2:
3: package deprecated;
4:
5: =head1 NAME
6:
7: deprecated - pragmatic module to mark a package or a sub as unsupported
8:
9: =head1 SYNOPSIS
10:
11: package OldeCrufte;
12: use deprecated qw(do_hack); # calling OldeCrufte::do_hack() will carp
13:
14: package OldeCrufte;
15: use deprecated; # using the OldeCrufte module will carp
16:
17: =head1 DESCRIPTION
18:
19: The word 'deprecated' is used to describe something that has lost support
20: or is otherwise not recommended. In programming, this usually means that
21: a newer, faster, safer or more supportable method has replaced an earlier
22: routine.
23:
24: When added to a package, this pragma will mark the package, or select
25: subs within it, as being deprecated. It does not change the behavior of
26: the subs within the package, except that on the first call of the sub, a
27: helpful message is printed to the C<STDERR> stream before running.
28:
29: The runtime messages are suppressed if the PERLLIB environment variable
30: does not contain the words 'home', 'devel', or 'test'.
31: This way, only developers see these messages when working with
32: the programs, but normal end-users do not see them. This
33: test is easy to customize for other company library
34: situations.
35:
36: =cut
37:
38: use strict;
39:
40: sub debug
41: {
42: return (defined $ENV{PERLLIB} and
43: $ENV{PERLLIB} =~ /home|devel|test/i);
44: }
45:
46: use constant EVAL_CODE => <<'END_CODE';
47: sub %s::INIT
48: {
49: my $overridden = \&%s;
50: *%s =
51: sub
52: {
53: if (deprecated::debug())
54: {
55: require Carp;
56: Carp::carp('%s() is deprecated; ' .
57: 'see the documentation for an alternative;');
58: }
59: *%s = $overridden;
60: goto &$overridden;
61: };
62: }
63: END_CODE
64:
65: sub import {
66: my $class = shift;
67: my $pkg = caller;
68: if (not @_ and debug())
69: {
70: require Carp;
71: Carp::carp("Module $pkg is deprecated; " .
72: 'see the documentation for an alternative;');
73: }
74: eval join('', map { sprintf(EVAL_CODE, $pkg, ("$pkg\::$_") x 4) } @_);
75: }
76:
77: 1;
78:
79: __END__
80:
81: =head1 AUTHORS
82:
83: Proposed and tested by Ed Halley <F<ed@halley.cc>>, and draft
84: implementation by 'Aristotle', as posted on F<http://www.perlmonks.org/>
85: in 2003.
86:
87: =cut