1
# $Id: GenericWebDBI.pm,v 1.3.4.1 2006/10/02 23:10:15 sendu Exp $
3
# BioPerl module for Bio::DB::EUtilities
5
# Cared for by Chris Fields <cjfields at uiuc dot edu>
7
# Copyright Chris Fields
9
# You may distribute this module under the same terms as perl itself
11
# POD documentation - main docs before the code
13
# Interfaces with new GenericWebDBI interface
17
Bio::DB::GenericWebDBI - abstract interface for parameter-based remote
23
# grab data from HTTP::Response object using concrete class
26
$data = $db->get_response->content;
29
# $data is the raw data output from the HTTP::Response object;
30
# this data may be preparsed using the private method _parse_response
34
WARNING: Please do B<NOT> spam the web servers with multiple requests.
36
This class acts as a user agent interface for any generic web database, but
37
is specifically geared towards CGI-based databases which accept parameters.
41
File and filehandle support to be added
43
Any feedback is welcome.
49
User feedback is an integral part of the
50
evolution of this and other Bioperl modules. Send
51
your comments and suggestions preferably to one
52
of the Bioperl mailing lists. Your participation
55
bioperl-l@lists.open-bio.org - General discussion
56
http://www.bioperl.org/wiki/Mailing_lists - About the mailing lists
60
Report bugs to the Bioperl bug tracking system to
61
help us keep track the bugs and their resolution.
62
Bug reports can be submitted via the web.
64
http://bugzilla.open-bio.org/
68
Email cjfields at uiuc dot edu
72
The rest of the documentation details each of the
73
object methods. Internal methods are usually
78
# Let the code begin...
80
package Bio::DB::GenericWebDBI;
83
use vars qw($MODVERSION %RETRIEVAL_TYPES $DEFAULT_RETRIEVAL_TYPE
84
$DEFAULT_RETURN_FORMAT $LAST_INVOCATION_TIME);
86
use base qw(Bio::Root::Root LWP::UserAgent);
90
%RETRIEVAL_TYPES = ('io_string' => 1,
94
$DEFAULT_RETRIEVAL_TYPE = 'pipeline';
95
$DEFAULT_RETURN_FORMAT = 'text';
96
$LAST_INVOCATION_TIME = 0;
100
my ($class, @args) = @_;
101
my $self = $class->SUPER::new(@args);
102
my ($url_base, $retmode, $delay, $db) =
103
$self->_rearrange([qw(URL_BASE RETMODE DELAY DB)],
105
# from LWP::UserAgent; set agent and env proxy
106
$self->agent(ref($self)."/$Bio::Root::Root::VERSION");
108
$db && $self->db($db);
109
# these will likely be overridden in base classes
110
$retmode && $self->retmode($retmode);
111
$url_base && $self->url_base_address($url_base);
112
# delay policy needs to be worked out; not set up correctly
113
$delay = defined($delay) ? $delay: $self->delay_policy;
114
$self->delay($delay);
118
=head2 url_base_address
120
Title : url_base_address
121
Usage : my $address = $self->url_base_address or
122
$self->url_base_address($address)
123
Function: Get/Set the base URL for the Web Database
124
Returns : Base URL for the Web Database
125
Args : $address - URL for the WebDatabase
129
sub url_base_address {
131
return $self->{'_baseaddress'} = shift if @_;
132
return $self->{'_baseaddress'};
138
Usage : $httpproxy = $db->proxy('http') or
139
$db->proxy(['http','ftp'], 'http://myproxy' )
140
Function: Get/Set a proxy for use of proxy
141
Returns : a string indicating the proxy
142
Args : $protocol : an array ref of the protocol(s) to set/get
143
$proxyurl : url of the proxy to use for the specified protocol
144
$username : username (if proxy requires authentication)
145
$password : password (if proxy requires authentication)
150
my ($self,$protocol,$proxy,$username,$password) = @_;
151
return undef if ( !defined $protocol || !defined $proxy );
152
$self->authentication($username, $password)
153
if ($username && $password);
154
return $self->SUPER::proxy($protocol,$proxy);
157
=head2 authentication
159
Title : authentication
160
Usage : $db->authentication($user,$pass)
161
Function: Get/Set authentication credentials
162
Returns : Array of user/pass
163
Args : Array or user/pass
168
my ($self,$u,$p) = @_;
169
if( defined $u && defined $p ) {
170
$self->{'_authentication'} = [ $u,$p];
172
return @{$self->{'_authentication'}};
179
Function: Get/Set database parameter
181
Args : optional string
187
return $self->{'_db'} = shift if @_;
188
return $self->{'_db'};
194
Usage : $agent->id($id)
196
Function: Get/Set id(s)
197
Returns : reference to id(s)
198
Args : a single id or reference to array of id(s)
206
if (ref($id) !~ /ARRAY/) { # single ID
207
$self->{'_ids'} = [$id];
210
$self->{'_ids'} = $id;
213
return $self->{'_ids'};
219
Usage : $agent->retmode($mode)
220
Function: Get/Set return mode for query (text, xml, html, asn.1, etc)
221
Returns : string for return mode
222
Args : optional string
228
return $self->{'_retmode'} = shift if @_;
229
return $self->{'_retmode'};
235
Usage : $agent->get_response;
236
Function: get the request based on set object parameters, retrieved using
237
the private method _get_params
238
Returns : HTTP::Response object
241
This is implemented by the derived class
247
my $msg = "Implementing class must define method get_response in class GenericWebDBI";
254
Usage : $secs = $self->delay([$secs])
255
Function: get/set number of seconds to delay between fetches
256
Returns : number of seconds to delay
259
NOTE: the default is to use the value specified by delay_policy().
260
This can be overridden by calling this method, or by passing the
261
-delay argument to new().
267
return $self->{'_delay'} = shift if @_;
268
return $self->{'_delay'};
274
Usage : $secs = $self->delay_policy
275
Function: return number of seconds to delay between calls to remote db
276
Returns : number of seconds to delay
279
NOTE: The default delay policy is 0s. Override in subclasses to
280
implement delays. The timer has only second resolution, so the delay
281
will actually be +/- 1s.
290
=head2 _submit_request
292
Title : _submit_request
293
Usage : my $url = $self->get_request
294
Function: builds request object based on set parameters
295
Returns : HTTP::Request
296
Args : optional : Bio::DB::EUtilities cookie
300
sub _submit_request {
302
my $msg = "Implementing class must define method _submit_request in class GenericWebDBI";
309
Usage : my $url = $self->_get_params
310
Function: builds parameter list for web request
311
Returns : hash of parameter-value paris
312
Args : optional : Bio::DB::EUtilities cookie
316
# these get sorted out in a hash originally but end up in an array to
317
# deal with multiple id parameters (hash values would kill that)
321
my $msg = "Implementing class must define method _get_params in class GenericWebDBI";
328
Usage : $self->_sleep
329
Function: sleep for a number of seconds indicated by the delay policy
333
NOTE: This method keeps track of the last time it was called and only
334
imposes a sleep if it was called more recently than the delay_policy()
341
my $last_invocation = $LAST_INVOCATION_TIME;
342
if (time - $LAST_INVOCATION_TIME < $self->delay) {
343
my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
344
$self->debug("sleeping for $delay seconds\n");
347
$LAST_INVOCATION_TIME = time;