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