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
Back to
Craft