oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add deprecation carp method

Browse source
This commit is contained in:
Doug Bell 2010-12-09 18:57:41 -06:00
parent 60cc89fb4f
commit 50c4910083
1 changed files with 17 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lib/WebGUI/Deprecate.pm
View file

@ -22,13 +22,25 @@ use warnings;
use Package::Stash; use Package::Stash;
use Sub::Exporter -setup => { use Sub::Exporter -setup => {
exports => [ 'deprecate' ], exports => [ 'deprecate', 'derp' ],
groups => { groups => {
default => [ 'deprecate' ], default => [ 'deprecate', 'derp' ],
} }
}; };
my %warned; my %derped;
sub derp ($) { # DEprecation caRP
my ( $message ) = @_;
# Add stack info to message
unless ( $message =~ /\n$/ ) {
$message .= " at " . join( "-", (caller(1))[0,2] );
}
return if ( $derped{ $message }++ ); # HERP
warn $message;
}
sub deprecate ($$) { sub deprecate ($$) {
my ($old_method, $new_method) = @_; my ($old_method, $new_method) = @_;
my $package = caller; my $package = caller;
@ -40,10 +52,7 @@ sub deprecate ($$) {
# call new method instead. if # call new method instead. if
$stash->add_package_symbol('&'.$old_method, sub { $stash->add_package_symbol('&'.$old_method, sub {
my $self = shift; my $self = shift;
my $message = "$package\::$old_method is deprecated and should be replaced with $new_method at " . join( "-", (caller(0))[0,2] ); derp "$package\::$old_method is deprecated and should be replaced with $new_method";
warn $message
unless $warned{$message}++;
local $deep{1} = 1; local $deep{1} = 1;
$self->$new_method(@_); $self->$new_method(@_);
}); });
@ -52,9 +61,7 @@ sub deprecate ($$) {
if (!$deep{1}) { if (!$deep{1}) {
my $old_sub = $self->can($old_method); my $old_sub = $self->can($old_method);
if ($old_sub ne \&{"$package\::$old_method"}) { if ($old_sub ne \&{"$package\::$old_method"}) {
my $message = "Subclass of $package uses deprecated method $old_method, which should be replaced with $new_method"; derp "Subclass of $package uses deprecated method $old_method, which should be replaced with $new_method";
carp $message
unless $warned{$message}++;
goto $old_sub; goto $old_sub;
} }
} }