=head1 LICENSE
Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Copyright [2016-2024] EMBL-European Bioinformatics Institute
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
=cut
=head1 CONTACT
Please email comments or questions to the public Ensembl
Questions may also be sent to the Ensembl help desk at
=cut
=head1 NAME
Bio::EnsEMBL::Utils::Proxy
=head1 SYNOPSIS
#Simple arounds logging proxy
package myproxy;
use base qw/Bio::EnsEMBL::Utils::Proxy/;
sub __resolver {
my ($invoker, $package, $method) = @_;
return sub {
my ($self, @args);
warn "Entering into ${package}::${method}";
my @capture = $self->$method(@args);
warn "Exiting from ${package}::${method}";
return @capture;
};
}
1;
=head1 DESCRIPTION
This class offers Proxy objects similar to those found in Java's
C<java.lang.reflect.Proxy> object. This class should be overriden and
then implement C<__resolver()>. The C<__resolver()> method returns a
subroutine to the intended action which the proxy object installs into
the calling class' scope.
All methods internal to the proxy are prefixed with a double underscore
to avoid corruption/intrusion into the normal public and private scope of
most classes.
=head1 METHODS
=cut
$Bio::EnsEMBL::Utils::Proxy::VERSION = '112.0.0';
use strict;
use vars '$AUTOLOAD';
=head2 new
Arg [1] : The object to proxy
Example : my $newobj = Bio::EnsEMBL::Utils::Proxy->new($myobj);
Description : Provides a new instance of a proxy
Returntype : Bio::EnsEMBL::Utils::Proxy the new instance
Exceptions : None
Caller : public
Status : -
=cut
sub new {
my ($class, $proxy) = @_;
my $self = bless({}, ref($class)||$class);
$self->{__proxy} = $proxy;
return $self;
}
=head2 __proxy
Example : -
Description : The proxy accessor
Returntype : Any the proxied object
Exceptions : None
Caller : -
Status : -
=cut
sub __proxy {
my ($self) = @_;
return $_[0]->{__proxy};
}
=head2 isa
Args : Object type to test
Example : $obj->isa('Bio::EnsEMBL::Utils::Proxy');
Description : Overriden to provide C<isa()> support for proxies. Will return
true if this object is assignable to the given type or the
proxied object is
Returntype : Boolean; performs same as a normal can
Exceptions : None
Caller : caller
Status : status
=cut
sub isa {
my ($self, $class) = @_;
return 1 if $self->SUPER::isa($class);
return 1 if $self->__proxy()->isa($class);
return 0;
}
=head2 can
Args : Method name to test
Example : $obj->can('__proxy');
Description : Overriden to provide C<can()> support for proxies. Will return
true if this object implements the given method or the
proxied object can
Returntype : Code; performs same as a normal can
Exceptions : None
Caller : caller
Status : status
=cut
sub can {
my ($self, $method) = @_;
my $super_can = $self->SUPER::can($method);
return $super_can if $super_can;
my $proxy_can = $self->__proxy()->can($method);
return $proxy_can if $proxy_can;
return;
}
=head2 DESTROY
Example : -
Description : Provided because of AutoLoad
Returntype : None
Exceptions : None
Caller : -
Status : -
=cut
sub DESTROY {
# left blank
}
=head2 AUTOLOAD
Example : -
Description : Performs calls to C<__resolver()> and installs the subroutine
into the current package scope.
Returntype : None
Exceptions : Thrown if C<__resolver()> could not return a subroutine
Caller : -
Status : -
=cut
sub AUTOLOAD {
my ($self, @args) = @_;
my ($package_name, $method_name) = $AUTOLOAD =~ m/ (.*) :: (.*) /xms;
my $sub = $self->__resolver($package_name, $method_name, @args);
if(! $sub) {
my $type = ref $self ? 'object' : 'class';
throw qq{Can't locate $type method "$method_name" via package "$package_name". No subroutine was generated};
}
{
no strict 'refs'; ## no critic ProhibitNoStrict
*{$AUTOLOAD} = $sub;
}
goto &$sub;
}
sub __resolver {
my ($self, $package_name, $method, @args) = @_;
#override to provide the subroutine to install
throw "Unimplemented __resolver() in $package_name. Please implement";
}
1;
__END__