perlcraft
halley
# deprecated - pragmatic module to mark a package or a sub as unsupported
package deprecated;
=head1 NAME
deprecated - pragmatic module to mark a package or a sub as unsupported
=head1 SYNOPSIS
package OldeCrufte;
use deprecated qw(do_hack); # calling OldeCrufte::do_hack() will carp
package OldeCrufte;
use deprecated; # using the OldeCrufte module will carp
=head1 DESCRIPTION
The word 'deprecated' is used to describe something that has lost support
or is otherwise not recommended. In programming, this usually means that
a newer, faster, safer or more supportable method has replaced an earlier
routine.
When added to a package, this pragma will mark the package, or select
subs within it, as being deprecated. It does not change the behavior of
the subs within the package, except that on the first call of the sub, a
helpful message is printed to the C<STDERR> stream before running.
The runtime messages are suppressed if the PERLLIB environment variable
does not contain the words 'home', 'devel', or 'test'.
This way, only developers see these messages when working with
the programs, but normal end-users do not see them. This
test is easy to customize for other company library
situations.
=cut
use strict;
sub debug
{
return (defined $ENV{PERLLIB} and
$ENV{PERLLIB} =~ /home|devel|test/i);
}
use constant EVAL_CODE => <<'END_CODE';
sub %s::INIT
{
my $overridden = \&%s;
*%s =
sub
{
if (deprecated::debug())
{
require Carp;
Carp::carp('%s() is deprecated; ' .
'see the documentation for an alternative;');
}
*%s = $overridden;
goto &$overridden;
};
}
END_CODE
sub import {
my $class = shift;
my $pkg = caller;
if (not @_ and debug())
{
require Carp;
Carp::carp("Module $pkg is deprecated; " .
'see the documentation for an alternative;');
}
eval join('', map { sprintf(EVAL_CODE, $pkg, ("$pkg\::$_") x 4) } @_);
}
1;
__END__
=head1 AUTHORS
Proposed and tested by Ed Halley <F<ed@halley.cc>>, and draft
implementation by 'Aristotle', as posted on F<http://www.perlmonks.org/>
in 2003.
=cut