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

use Package::Stash for deprecation

Browse source
This commit is contained in:
Graham Knop 2010-11-17 18:42:51 -06:00
parent dcff137cfa
commit b6abeb0fbf
1 changed files with 7 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lib/WebGUI/Deprecate.pm
View file

@ -19,6 +19,7 @@ Deprecate a subroutine, spitting out a warning whenever it is used.
use strict; use strict;
use warnings; use warnings;
use Package::Stash;
use Sub::Exporter -setup => { use Sub::Exporter -setup => {
exports => [ 'deprecate' ], exports => [ 'deprecate' ],
@ -31,14 +32,13 @@ my %warned;
sub deprecate ($$) { sub deprecate ($$) {
my ($old_method, $new_method) = @_; my ($old_method, $new_method) = @_;
my $package = caller; my $package = caller;
no strict 'refs'; my $stash = Package::Stash->new($package);
no warnings 'redefine';
my %deep; my %deep;
# keep a copy since it will be replaced # keep a copy since it will be replaced
my $new_sub = \&{"$package\::$new_method"}; my $new_sub = $stash->get_package_symbol('&'.$new_method);
# call new method instead. if # call new method instead. if
*{"$package\::$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] ); my $message = "$package\::$old_method is deprecated and should be replaced with $new_method at " . join( "-", (caller(0))[0,2] );
warn $message warn $message
@ -46,8 +46,8 @@ sub deprecate ($$) {
local $deep{1} = 1; local $deep{1} = 1;
$self->$new_method(@_); $self->$new_method(@_);
}; });
*{"$package\::$new_method"} = sub { $stash->add_package_symbol('&'.$new_method, sub {
my $self = $_[0]; my $self = $_[0];
if (!$deep{1}) { if (!$deep{1}) {
my $old_sub = $self->can($old_method); my $old_sub = $self->can($old_method);
@ -59,7 +59,7 @@ sub deprecate ($$) {
} }
} }
goto $new_sub; goto $new_sub;
}; });
} }
1; 1;