Devel::Deprecate - Create deprecation schedules in your code

Devel-Deprecate documentation Contained in the Devel-Deprecate distribution.

Index

Code Index:

NAME

Top

Devel::Deprecate - Create deprecation schedules in your code

VERSION

Top

Version 0.01

SYNOPSIS

Top

    use Devel::Deprecate 'deprecate';

    sub name {
        my ( $self ) = @_;

        deprecate(
            reason => 'Please use the set_name() method for setting names',
            warn   => '2008-11-01',    # also accepts DateTime objects
            die    => '2009-01-01',    # two month deprecation period
            if     => sub { return @_ > 1 },
        );
        if ( @_ > 1 ) {
            $self->{name} = $_[1];
            return $self;
        }
        return $self->{name};
    }

DESCRIPTION

Top

Many times we find ourselves needing to deprecate code or have a deadline and just don't have time to refactor. Instead of trying to remember about this, posting it to a wiki or sending an email, it's better to have an automatic way to deprecate something. This module allows you to do that and embeds the deprecation directly in the code you wish to deprecate.

As we don't want to break production code, deprecations are only triggered when running tests.

EXPORT

Top

FUNCTIONS

Top

deprecate

 deprecate( reason => 'The foo() method does not appear to be used' );

 deprecate(
     reason => 'Please use the set_name() method for setting names',
     warn   => '2008-11-01',    # also accepts DateTime objects
     die    => '2009-01-01',    # two month deprecation period
     if     => sub { return @_ > 1 },
 );

This function is exported on demand. It takes an even-sized list of key/value pairs. Its function is to spit out a warning (or croak) when deprecation criteria are hit.

Deprecation warnings or failures only occur when running tests (but see PRODUCTION ENVIRONMENTS below) and are designed to be extremely noisy (and with a strack trace):

 # DEPRECATION WARNING
 #
 #     Package:     Our::Customer
 #     File:        lib/Our/Customer.pm
 #     Line:        58
 #     Subroutine:  Our::Customer::name
 #
 #     Reason:      Please use the set_name() method for setting names
 #
 #     This warning becomes FATAL on (2009-01-01)

And after the due date:

 # DEPRECATION FAILURE
 #
 #     Package:     Our::Customer
 #     File:        lib/Our/Customer.pm
 #     Line:        58
 #     Subroutine:  Our::Customer::name
 #
 #     Reason:      Please use the set_name() method for setting names
 #
 #     This deprecation became fatal on (2009-01-01)

Allowed key/value pairs:

* reason

This is the only required key.

This should be a human readable string explaining why the deprecation is needed.

 reason => 'This module should be replaced by the Our::Improved::Module'

If deprecate() is called with only a reason, it begins issuing deprecation warnings immediately.

* warn

Optional. If not present, deprecation warnings start immediately.

This should be a string in 'YYYY-MM-DD' format or a DateTime object indicating when the deprecation warnings should start.

 warn => '2008-06-06'
 # or ...
 warn => DateTime->new( year => 2008, month => 06, day => 06 )
* die

Optional. If not present, deprecation warnings never become fatal.

This should be a string in 'YYYY-MM-DD' format or a DateTime object indicating when the deprecation warnings should become fatal.

 die => '2009-06-06'
 # or ...
 die => DateTime->new( year => 2009, month => 06, day => 06 )
* if

Optional. May be a boolean value or a code reference.

 if => ( @_ > 1 )
 # or
 if => sub { @_ > 1 }

If the 'if' condition evaluates to false, no deprecation action action is taken.

If the 'if' argument is a code reference, it will receive the deprecate() argument list has a hash reference in $_[0], minus the 'if' key/value pair.

PRODUCTION ENVIRONMENTS

Top

Don't break them. Just don't. People get mad at you and scratch you off their Christmas card list. To ensure that Devel::Deprecate doesn't break production environments, deprecate() returns immediately if $ENV{HARNESS_ACTIVE} evaluates as false, thus ensuring that deprecations are generally only triggered by tests.

However, sometimes you might find this variable set in production code, so you can still disable this module by setting the $ENV{PERL_DEVEL_DEPRECATE_OFF} variable to a true value.

Failing that, simply omit the die key. Then, at most you'll get lots of warnings and never a fatal error.

SCHEDULING DEPRECATIONS

Top

Typically you'll just want something like the following in your code:

 deprecate( reason => 'Use CGI.pm instead of cgi-lib.pl' );

That issues noisy warnings about a deprecation, but at times you'll want to schedule a deprecation period. Perhaps the deprecation won't even start until a new software package is installed in three months and it's agreed that the "old" interface is to be supported for six months. Assuming today is the first day of 2008, you might write a deprecation like this:

 use Devel::Deprecate 'deprecate';

 sub report : Path('/report/sales') {
     deprecate(
         reason => 'Pointy-haired bosses bought a reporting package',
         warn   => '2008-04-01',
         die    => '2008-10-01',
     );
     ...

That subroutine should only run while testing (see PRODUCTION ENVIRONMENTS) and will likely annoy the heck our of developers with verbose error messages. Of course, that's the point. The deprecation period, however, should be carefully thought you. In fact, you may wish to omit it entirely to ensure that the deprecation is never a fatal error.

Alternately, you might write it like this:

 sub report : Path('/report/sales') {
     deprecate(
         reason => 'Pointy-haired bosses bought a reporting package',
         die    => '2008-10-01',
         if     => \&other_software_is_installed,
     );
     ...

With this, the deprecation warnings begin if and only if the other_software_is_installed subroutine returns true. Further, even the die will be be triggered unless this condition holds.

AUTHOR

Top

Curtis "Ovid" Poe, <ovid at cpan.org>

BUGS

Top

Please report any bugs or feature requests to bug-devel-deprecate at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-Deprecate. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Devel::Deprecate

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Deprecate

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Devel-Deprecate

* CPAN Ratings

http://cpanratings.perl.org/d/Devel-Deprecate

* Search CPAN

http://search.cpan.org/dist/Devel-Deprecate

ACKNOWLEDGEMENTS

Top

* http://databaserefactoring.com/.

The "Refactoring Databases" book explained the rationale as to why we want automated deprecation periods.

* http://www.perlmonks.org/?node_id=682407

Several helpful comments on the Perl Monks discussion, particularly comments by Jenda about not breaking production code.

COPYRIGHT & LICENSE

Top

Copyright 2008 Curtis "Ovid" Poe, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Devel-Deprecate documentation Contained in the Devel-Deprecate distribution. 
package Devel::Deprecate;

use warnings;
use strict;


use base 'Exporter';
use Carp ();
use DateTime;
use Scalar::Util qw(reftype blessed);
use vars qw($VERSION @EXPORT_OK);
$VERSION   = '0.01';
@EXPORT_OK = qw(deprecate);


sub deprecate {
    return if !$ENV{HARNESS_ACTIVE};             # only in testing
    return if $ENV{PERL_DEVEL_DEPRECATE_OFF};    # or let 'em force it
    if ( @_ % 2 ) {
        Carp::croak("deprecate() called with odd number of elements in hash assignment");
    }
    my %arg_for = @_;
    unless ( exists $arg_for{reason} ) {
        Carp::croak("deprecate() called without a 'reason' argument");
    }

    if (exists $arg_for{if}) {
        my $should_deprecate = delete $arg_for{if};

        if ('CODE' eq ( reftype $should_deprecate || '' )) {
            return unless $should_deprecate->(\%arg_for);
        }
        return unless $should_deprecate;
    }

    my $reason          = delete $arg_for{reason};

    _check_dates(\%arg_for);
    my $warn = _date(delete $arg_for{warn});
    my $die = _date(delete $arg_for{die});

    my $should_warn = _should_warn($warn);
    my $should_die  = _should_die($die);

    # parting is such sweet sorrow -- and the default
    $should_warn    = 0 if $should_die;

    _warn($reason, $die) if $should_warn;
    _die($reason, $die) if $should_die;
}

sub _check_dates {
    my $args = shift;
    return unless my $warn = _date($args->{warn});
    return unless my $die  = _date($args->{die});
    if ( $die <= $warn ) {
        Carp::croak("deprecate() die date ($args->{die}) must be after warn date ($args->{warn})");
    }
}

sub _should_warn {
    my $date = _date(shift);
    return 1 unless defined $date;   # warn by default
    return $date <= DateTime->today;
}

sub _should_die {
    my $date = _date(shift);
    return unless defined $date;     # do not die by default
    return $date <= DateTime->today;
}

sub _date {
    my $date = shift;
    return unless defined $date;   # it's OK if they haven't passed on
    return $date if blessed $date and $date->isa('DateTime');
    if ( $date =~ /\A(\d\d\d\d)-(\d\d)-(\d\d)\z/ ) {
        return DateTime->new(
            year  => $1,
            month => $2,
            day   => $3,
        );
    }
    Carp::croak("Cannot parse unknown date format ($date)");
}

sub _warn {
    my ( $reason, $die ) = @_;

    my ( $package, $filename, $line ) = caller(1);

    # need to get past deprecate()
    my ( undef, undef, undef, $subroutine ) = caller(2);
    $subroutine ||= 'n/a';
    my $padding = ' ' x 18;
    $reason =~ s/\n/\n#$padding/g;

    $reason = <<"    END";
# DEPRECATION WARNING
# 
#     Package:     $package
#     File:        $filename
#     Line:        $line
#     Subroutine:  $subroutine
#     
#     Reason:      $reason
    END

    if ( $die ) {
        $die = $die->ymd;
        $reason = <<"        END";
$reason#
#     This warning becomes FATAL on ($die)
        END
    }
    Carp::cluck($reason);
}

sub _die {
    my ( $reason, $die ) = @_;

    my ( $package, $filename, $line ) = caller(1);

    # need to get past deprecate()
    my ( undef, undef, undef, $subroutine ) = caller(2);
    $subroutine ||= 'n/a';
    my $padding = ' ' x 18;
    $reason =~ s/\n/\n#$padding/g;

    $reason = <<"    END";
# DEPRECATION FAILURE
# 
#     Package:     $package
#     File:        $filename
#     Line:        $line
#     Subroutine:  $subroutine
#     
#     Reason:      $reason
    END

    if ( $die ) {
        $die = $die->ymd;
        $reason = <<"        END";
$reason#
#     This deprecation became fatal on ($die)
        END
    }
    Carp::confess($reason);
}


1;