File Coverage

blib/lib/Sub/Deprecated.pm

Criterion	Covered	Total	%
statement	34	37	91.8
branch	4	6	66.6
condition	3	6	50.0
subroutine	8	9	88.8
pod	0	1	0.0
total	49	59	83.0

package Sub::Deprecated;

use 5.008005;
use strict;
use warnings;

our $VERSION = "0.04";

use Attribute::Handlers;

sub Deprecated : ATTR(CODE,BEGIN) {
    my ($package, $symbol, $referent, $attr, $data, $phase, $file, $line) = @_;

    my $die = sub {
        die sprintf('%s at %s line %d.', $_[0], $file, $line);
    };

    if (! defined $data || scalar(@$data) > 2) {
        $die->('ERROR: Invalid use of Deprecated(version, [message]) attribute.');
    }

    if ($symbol eq 'ANON') {
        $die->('ERROR: Deprecated attribute does not work on anonymous subroutines.');
    }

    my $name = *{$symbol}{NAME};
    my ($deprecated_version, $message) = @{$data};

    no warnings 'redefine';
    *{$symbol} = sub {
        my $warning = sprintf(
            'WARNING: %s::%s deprecated as of %s.',
            $package, $name, $deprecated_version,
        );
        if (defined $message && $message) {
            chomp $message;
            $warning .= '  ' . $message;
        }
        warn $warning, "\n";
        goto &$referent;
    };
}

1;

__END__