Archive Ensembl HomeArchive Ensembl Home
Proxy.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 =head1 NAME
00022 
00023 Bio::EnsEMBL::Utils::Proxy
00024 
00025 =head1 SYNOPSIS
00026 
00027   #Simple arounds logging proxy
00028   package myproxy;
00029   use base qw/Bio::EnsEMBL::Utils::Proxy/;
00030   sub __resolver {
00031     my ($invoker, $package, $method) = @_;
00032     return sub {
00033       my ($self, @args);
00034       warn "Entering into ${package}::${method}";
00035       my @capture = $self->$method(@args);
00036       warn "Exiting from ${package}::${method}";
00037       return @capture;
00038     };
00039   }
00040   
00041   1;
00042 
00043 =head1 DESCRIPTION
00044 
00045 This class offers Proxy objects similar to those found in Java's 
00046 C<java.lang.reflect.Proxy> object. This class should be overriden and 
00047 then implement C<__resolver()>. The C<__resolver()> method returns a 
00048 subroutine to the intended action which the proxy object installs into
00049 the calling class' scope.
00050 
00051 All methods internal to the proxy are prefixed with a double underscore
00052 to avoid corruption/intrusion into the normal public and private scope of 
00053 most classes.
00054 
00055 =head1 METHODS
00056 
00057 =cut
00058 
00059 package Bio::EnsEMBL::Utils::Proxy;
00060 
00061 use Bio::EnsEMBL::Utils::Exception qw/throw/;
00062 
00063 use vars '$AUTOLOAD';
00064 
00065 =head2 new
00066 
00067   Arg [1]       : The object to proxy  
00068   Example           : my $newobj = Bio::EnsEMBL::Utils::Proxy->new($myobj);
00069   Description   : Provides a new instance of a proxy
00070   Returntype    : Bio::EnsEMBL::Utils::Proxy the new instance
00071   Exceptions    : None 
00072   Caller        : public
00073   Status        : -
00074 
00075 =cut
00076 
00077 sub new {
00078   my ($class, $proxy) = @_;
00079   my $self = bless({}, ref($class)||$class);
00080   $self->{__proxy} = $proxy;
00081   return $self;
00082 }
00083 
00084 =head2 __proxy
00085  
00086   Example           : -
00087   Description   : The proxy accessor
00088   Returntype    : Any the proxied object
00089   Exceptions    : None 
00090   Caller        : -
00091   Status        : -
00092 
00093 =cut
00094 
00095 sub __proxy {
00096   my ($self) = @_;
00097   return $_[0]->{__proxy};
00098 }
00099 
00100 =head2 isa
00101 
00102   Args        : Object type to test
00103   Example     : $obj->isa('Bio::EnsEMBL::Utils::Proxy');
00104   Description : Overriden to provide C<isa()> support for proxies. Will return
00105                 true if this object is assignable to the given type or the
00106                 proxied object is
00107   Returntype  : Boolean; performs same as a normal can
00108   Exceptions  : None
00109   Caller      : caller
00110   Status      : status
00111 
00112 =cut
00113 
00114 
00115 sub isa {
00116   my ($self, $class) = @_;
00117   return 1 if $self->SUPER::isa($class);
00118   return 1 if $self->__proxy()->isa($class);
00119   return 0;
00120 }
00121 
00122 =head2 can
00123 
00124   Args          : Method name to test
00125   Example           : $obj->can('__proxy');
00126   Description   : Overriden to provide C<can()> support for proxies. Will return
00127                 true if this object implements the given method or the
00128                 proxied object can
00129   Returntype    : Code; performs same as a normal can
00130   Exceptions    : None
00131   Caller        : caller
00132   Status        : status
00133 
00134 =cut
00135 
00136 sub can {
00137   my ($self, $method) = @_;
00138   return 1 if $self->SUPER::can($method);
00139   return 1 if $self->__proxy()->can($method);
00140   return 0;
00141 }
00142 
00143 =head2 DESTROY
00144 
00145   Example           : -
00146   Description   : Provided because of AutoLoad
00147   Returntype    : None 
00148   Exceptions    : None
00149   Caller        : -
00150   Status        : -
00151 
00152 =cut
00153 
00154 
00155 
00156 sub DESTROY {
00157   # left blank
00158 }
00159 
00160 =head2 AUTOLOAD
00161 
00162   Example     : -
00163   Description : Performs calls to C<__resolver()> and installs the subroutine
00164                 into the current package scope.
00165   Returntype  : None 
00166   Exceptions  : Thrown if C<__resolver()> could not return a subroutine
00167   Caller      : -
00168   Status      : -
00169 
00170 =cut
00171 
00172 sub AUTOLOAD {
00173   my ($self, @args) = @_;
00174   my ($package_name, $method_name) = $AUTOLOAD =~ m/ (.*) :: (.*) /xms;
00175   my $sub = $self->__resolver($package_name, $method_name, @args);
00176   if(! $sub) {
00177     my $type = ref $self ? 'object' : 'class';
00178     throw qq{Can't locate $type method "$method_name" via package "$package_name". No subroutine was generated};
00179   }
00180   *$AUTOLOAD = $sub;
00181   goto &$sub;
00182 }
00183 
00184 sub __resolver {
00185   my ($self, $package_name, $method, @args) = @_;
00186   #override to provide the subroutine to install
00187   throw "Unimplemented __resolver() in $package_name. Please implement";
00188 }
00189 
00190 1;
00191 
00192 __END__