Mercurial > repos > mahtabm > ensembl
view variant_effect_predictor/Bio/EnsEMBL/Utils/Proxy.pm @ 3:d30fa12e4cc5 default tip
Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author | devteam <devteam@galaxyproject.org> |
---|---|
date | Mon, 13 Jan 2014 10:38:30 -0500 |
parents | 1f6dce3d34e0 |
children |
line wrap: on
line source
=head1 LICENSE Copyright (c) 1999-2012 The European Bioinformatics Institute and Genome Research Limited. All rights reserved. This software is distributed under a modified Apache license. For license details, please see http://www.ensembl.org/info/about/code_licence.html =head1 CONTACT Please email comments or questions to the public Ensembl developers list at <dev@ensembl.org>. Questions may also be sent to the Ensembl help desk at <helpdesk@ensembl.org>. =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 package Bio::EnsEMBL::Utils::Proxy; use Bio::EnsEMBL::Utils::Exception qw/throw/; 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) = @_; return 1 if $self->SUPER::can($method); return 1 if $self->__proxy()->can($method); return 0; } =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}; } *$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__