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

fix tests for www_auth. fix deprecate for callers

Browse source
This commit is contained in:
Doug Bell 2010-11-03 19:42:20 -05:00
parent 5a2d4d8d03
commit f515d85b2d
5 changed files with 32 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

38
lib/WebGUI/Deprecate.pm
View file

@ -33,19 +33,33 @@ sub deprecate ($$) {
my $package = caller;
no strict 'refs';
no warnings 'redefine';
*{"$package\::$old_method"} = \&{"$package\::$new_method"};
my $proxy_method = sub {
my $self = $_[0];
my $sub = $self->can($old_method);
my $class = ref $self || $self;
if ($sub ne \&{"$package\::$old_method"}) {
my $message = "$class contains the method $old_method. This has been deprecated and replaced with $new_method.";
warn $message unless $warned{$message}++;
$self->$new_method( @_ );
}
goto $sub;
my %deep;
# keep a copy since it will be replaced
my $new_sub = \&{"$package\::$new_method"};
# call new method instead. if
*{"$package\::$old_method"} = sub {
my $self = shift;
my $message = "$package\::$old_method is deprecated and should be replaced with $new_method at " . join( "-", (caller(0))[0,2] );
warn $message
unless $warned{$message}++;
local $deep{1} = 1;
$self->$new_method(@_);
};
*{"$package\::$new_method"} = sub {
my $self = $_[0];
if (!$deep{1}) {
my $old_sub = $self->can($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";
carp $message
unless $warned{$message}++;
goto $old_sub;
}
}
goto $new_sub;
};
*{"$package\::$new_method"} = $proxy_method;
}
1;