|
0
|
1 =head1 LICENSE
|
|
|
2
|
|
|
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
|
|
|
4 Genome Research Limited. All rights reserved.
|
|
|
5
|
|
|
6 This software is distributed under a modified Apache license.
|
|
|
7 For license details, please see
|
|
|
8
|
|
|
9 http://www.ensembl.org/info/about/code_licence.html
|
|
|
10
|
|
|
11 =head1 CONTACT
|
|
|
12
|
|
|
13 Please email comments or questions to the public Ensembl
|
|
|
14 developers list at <dev@ensembl.org>.
|
|
|
15
|
|
|
16 Questions may also be sent to the Ensembl help desk at
|
|
|
17 <helpdesk@ensembl.org>.
|
|
|
18
|
|
|
19 =cut
|
|
|
20
|
|
|
21 =head1 NAME
|
|
|
22
|
|
|
23 Bio::EnsEMBL::Utils::Proxy
|
|
|
24
|
|
|
25 =head1 SYNOPSIS
|
|
|
26
|
|
|
27 #Simple arounds logging proxy
|
|
|
28 package myproxy;
|
|
|
29 use base qw/Bio::EnsEMBL::Utils::Proxy/;
|
|
|
30 sub __resolver {
|
|
|
31 my ($invoker, $package, $method) = @_;
|
|
|
32 return sub {
|
|
|
33 my ($self, @args);
|
|
|
34 warn "Entering into ${package}::${method}";
|
|
|
35 my @capture = $self->$method(@args);
|
|
|
36 warn "Exiting from ${package}::${method}";
|
|
|
37 return @capture;
|
|
|
38 };
|
|
|
39 }
|
|
|
40
|
|
|
41 1;
|
|
|
42
|
|
|
43 =head1 DESCRIPTION
|
|
|
44
|
|
|
45 This class offers Proxy objects similar to those found in Java's
|
|
|
46 C<java.lang.reflect.Proxy> object. This class should be overriden and
|
|
|
47 then implement C<__resolver()>. The C<__resolver()> method returns a
|
|
|
48 subroutine to the intended action which the proxy object installs into
|
|
|
49 the calling class' scope.
|
|
|
50
|
|
|
51 All methods internal to the proxy are prefixed with a double underscore
|
|
|
52 to avoid corruption/intrusion into the normal public and private scope of
|
|
|
53 most classes.
|
|
|
54
|
|
|
55 =head1 METHODS
|
|
|
56
|
|
|
57 =cut
|
|
|
58
|
|
|
59 package Bio::EnsEMBL::Utils::Proxy;
|
|
|
60
|
|
|
61 use Bio::EnsEMBL::Utils::Exception qw/throw/;
|
|
|
62
|
|
|
63 use vars '$AUTOLOAD';
|
|
|
64
|
|
|
65 =head2 new
|
|
|
66
|
|
|
67 Arg [1] : The object to proxy
|
|
|
68 Example : my $newobj = Bio::EnsEMBL::Utils::Proxy->new($myobj);
|
|
|
69 Description : Provides a new instance of a proxy
|
|
|
70 Returntype : Bio::EnsEMBL::Utils::Proxy the new instance
|
|
|
71 Exceptions : None
|
|
|
72 Caller : public
|
|
|
73 Status : -
|
|
|
74
|
|
|
75 =cut
|
|
|
76
|
|
|
77 sub new {
|
|
|
78 my ($class, $proxy) = @_;
|
|
|
79 my $self = bless({}, ref($class)||$class);
|
|
|
80 $self->{__proxy} = $proxy;
|
|
|
81 return $self;
|
|
|
82 }
|
|
|
83
|
|
|
84 =head2 __proxy
|
|
|
85
|
|
|
86 Example : -
|
|
|
87 Description : The proxy accessor
|
|
|
88 Returntype : Any the proxied object
|
|
|
89 Exceptions : None
|
|
|
90 Caller : -
|
|
|
91 Status : -
|
|
|
92
|
|
|
93 =cut
|
|
|
94
|
|
|
95 sub __proxy {
|
|
|
96 my ($self) = @_;
|
|
|
97 return $_[0]->{__proxy};
|
|
|
98 }
|
|
|
99
|
|
|
100 =head2 isa
|
|
|
101
|
|
|
102 Args : Object type to test
|
|
|
103 Example : $obj->isa('Bio::EnsEMBL::Utils::Proxy');
|
|
|
104 Description : Overriden to provide C<isa()> support for proxies. Will return
|
|
|
105 true if this object is assignable to the given type or the
|
|
|
106 proxied object is
|
|
|
107 Returntype : Boolean; performs same as a normal can
|
|
|
108 Exceptions : None
|
|
|
109 Caller : caller
|
|
|
110 Status : status
|
|
|
111
|
|
|
112 =cut
|
|
|
113
|
|
|
114
|
|
|
115 sub isa {
|
|
|
116 my ($self, $class) = @_;
|
|
|
117 return 1 if $self->SUPER::isa($class);
|
|
|
118 return 1 if $self->__proxy()->isa($class);
|
|
|
119 return 0;
|
|
|
120 }
|
|
|
121
|
|
|
122 =head2 can
|
|
|
123
|
|
|
124 Args : Method name to test
|
|
|
125 Example : $obj->can('__proxy');
|
|
|
126 Description : Overriden to provide C<can()> support for proxies. Will return
|
|
|
127 true if this object implements the given method or the
|
|
|
128 proxied object can
|
|
|
129 Returntype : Code; performs same as a normal can
|
|
|
130 Exceptions : None
|
|
|
131 Caller : caller
|
|
|
132 Status : status
|
|
|
133
|
|
|
134 =cut
|
|
|
135
|
|
|
136 sub can {
|
|
|
137 my ($self, $method) = @_;
|
|
|
138 return 1 if $self->SUPER::can($method);
|
|
|
139 return 1 if $self->__proxy()->can($method);
|
|
|
140 return 0;
|
|
|
141 }
|
|
|
142
|
|
|
143 =head2 DESTROY
|
|
|
144
|
|
|
145 Example : -
|
|
|
146 Description : Provided because of AutoLoad
|
|
|
147 Returntype : None
|
|
|
148 Exceptions : None
|
|
|
149 Caller : -
|
|
|
150 Status : -
|
|
|
151
|
|
|
152 =cut
|
|
|
153
|
|
|
154
|
|
|
155
|
|
|
156 sub DESTROY {
|
|
|
157 # left blank
|
|
|
158 }
|
|
|
159
|
|
|
160 =head2 AUTOLOAD
|
|
|
161
|
|
|
162 Example : -
|
|
|
163 Description : Performs calls to C<__resolver()> and installs the subroutine
|
|
|
164 into the current package scope.
|
|
|
165 Returntype : None
|
|
|
166 Exceptions : Thrown if C<__resolver()> could not return a subroutine
|
|
|
167 Caller : -
|
|
|
168 Status : -
|
|
|
169
|
|
|
170 =cut
|
|
|
171
|
|
|
172 sub AUTOLOAD {
|
|
|
173 my ($self, @args) = @_;
|
|
|
174 my ($package_name, $method_name) = $AUTOLOAD =~ m/ (.*) :: (.*) /xms;
|
|
|
175 my $sub = $self->__resolver($package_name, $method_name, @args);
|
|
|
176 if(! $sub) {
|
|
|
177 my $type = ref $self ? 'object' : 'class';
|
|
|
178 throw qq{Can't locate $type method "$method_name" via package "$package_name". No subroutine was generated};
|
|
|
179 }
|
|
|
180 *$AUTOLOAD = $sub;
|
|
|
181 goto &$sub;
|
|
|
182 }
|
|
|
183
|
|
|
184 sub __resolver {
|
|
|
185 my ($self, $package_name, $method, @args) = @_;
|
|
|
186 #override to provide the subroutine to install
|
|
|
187 throw "Unimplemented __resolver() in $package_name. Please implement";
|
|
|
188 }
|
|
|
189
|
|
|
190 1;
|
|
|
191
|
|
|
192 __END__
|
