File Coverage

Bio/WebAgent.pm
Criterion Covered Total %
statement 22 36 61.1
branch 2 10 20.0
condition 0 5 0.0
subroutine 5 8 62.5
pod 5 5 100.0
total 34 64 53.1


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::WebAgent
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
7             # For copyright and disclaimer see below.
8             #
9              
10             # POD documentation - main docs before the code
11              
12             =head1 NAME
13              
14             Bio::WebAgent - A base class for Web (any protocol) access
15              
16             =head1 SYNOPSIS
17              
18             # This is a abstract superclass for bioperl modules accessing web
19             # resources - normally you do not instantiate it but one of its
20             # subclasess.
21              
22             =head1 DESCRIPTION
23              
24             This abstract superclass is a subclass of L which
25             allows protocol independent access of remote locations over
26             the Net.
27              
28             It takes care of error handling, proxies and various net protocols.
29             BioPerl classes accessing the net should inherit from it. For details,
30             see L.
31              
32             The interface is still evolving. For now, two public methods have been
33             copied from Bio::DB::WebDBSeqI: delay() and delay_policy. These are
34             used to prevent overwhelming the server by rapidly repeated . Ideally
35             there should be a common abstract superclass with these. See L.
36              
37             =head1 SEE ALSO
38              
39             L,
40             L,
41              
42             =head1 FEEDBACK
43              
44             =head2 Mailing Lists
45              
46             User feedback is an integral part of the evolution of this and other
47             Bioperl modules. Send your comments and suggestions preferably to
48             the Bioperl mailing list. Your participation is much appreciated.
49              
50             bioperl-l@bioperl.org - General discussion
51             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
52              
53             =head2 Support
54              
55             Please direct usage questions or support issues to the mailing list:
56              
57             I
58              
59             rather than to the module maintainer directly. Many experienced and
60             reponsive experts will be able look at the problem and quickly
61             address it. Please include a thorough description of the problem
62             with code and data examples if at all possible.
63              
64             =head2 Reporting Bugs
65              
66             Report bugs to the Bioperl bug tracking system to help us keep track
67             of the bugs and their resolution. Bug reports can be submitted via the
68             web:
69              
70             https://github.com/bioperl/bioperl-live/issues
71              
72             =head1 AUTHOR
73              
74             Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
75              
76             =head1 COPYRIGHT
77              
78             Copyright (c) 2003, Heikki Lehvaslaiho and EMBL-EBI.
79             All Rights Reserved.
80              
81             This module is free software; you can redistribute it and/or modify
82             it under the same terms as Perl itself.
83              
84             =head1 DISCLAIMER
85              
86             This software is provided "as is" without warranty of any kind.
87              
88             =head1 APPENDIX
89              
90             The rest of the documentation details each of the object
91             methods. Internal methods are usually preceded with a _
92              
93             =cut
94              
95              
96             # Let the code begin...
97              
98             package Bio::WebAgent;
99 6     6   713 use vars qw($LAST_INVOCATION_TIME);
  6         17  
  6         201  
100 6     6   21 use strict;
  6         6  
  6         107  
101              
102 6     6   17 use base qw(LWP::UserAgent Bio::Root::Root);
  6         6  
  6         2301  
103              
104              
105             sub new {
106 3     3 1 13 my $class = shift;
107              
108             # We make env_proxy the default here, but it can be
109             # over-ridden by $self->env_proxy later,
110             # or by new(env_proxy=>0) at constructor time
111            
112 3         20 my $self = $class->SUPER::new(env_proxy => 1);
113              
114 3         15873 while( @_ ) {
115 1         2 my $key = shift;
116 1         4 $key =~ s/^-//;
117 1         2 my $value = shift;
118 1 50       14 $self->can($key) || next;
119 1         5 $self->$key($value);
120             }
121              
122 3         11 return $self; # success - we hope!
123              
124             }
125              
126              
127             # -----------------------------------------------------------------------------
128              
129             =head2 url
130              
131             Usage : $agent->url
132             Returns : URL to reach out to Net
133             Args : string
134              
135             =cut
136              
137             sub url {
138 1     1 1 1 my ($self,$value) = @_;
139 1 50       7 if( defined $value) {
140 1         1 $self->{'_url'} = $value;
141             }
142 1         2 return $self->{'_url'};
143             }
144              
145              
146             =head2 delay
147              
148             Title : delay
149             Usage : $secs = $self->delay([$secs])
150             Function: get/set number of seconds to delay between fetches
151             Returns : number of seconds to delay
152             Args : new value
153              
154             NOTE: the default is to use the value specified by delay_policy().
155             This can be overridden by calling this method, or by passing the
156             -delay argument to new().
157              
158             =cut
159              
160             sub delay {
161 0     0 1   my ($self, $value) = @_;
162 0 0         if ($value) {
163 0 0         $self->throw("Need a positive integer, not [$value]")
164             unless $value >= 0;
165 0           $self->{'_delay'} = int $value;
166             }
167 0   0       return $self->{'_delay'} || $self->delay_policy;
168             }
169              
170             =head2 delay_policy
171              
172             Title : delay_policy
173             Usage : $secs = $self->delay_policy
174             Function: return number of seconds to delay between calls to remote db
175             Returns : number of seconds to delay
176             Args : none
177              
178             NOTE: The default delay policy is 3s. Override in subclasses to
179             implement other delays. The timer has only second resolution, so the delay
180             will actually be +/- 1s.
181              
182             =cut
183              
184             sub delay_policy {
185 0     0 1   my $self = shift;
186 0           return 3;
187             }
188              
189              
190             =head2 sleep
191              
192             Title : sleep
193             Usage : $self->sleep
194             Function: sleep for a number of seconds indicated by the delay policy
195             Returns : none
196             Args : none
197              
198             NOTE: This method keeps track of the last time it was called and only
199             imposes a sleep if it was called more recently than the delay_policy()
200             allows.
201              
202             =cut
203              
204             sub sleep {
205 0     0 1   my $self = shift;
206 0   0       $LAST_INVOCATION_TIME ||= 0;
207 0 0         if (time - $LAST_INVOCATION_TIME < $self->delay) {
208 0           my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
209 0           $self->debug("sleeping for $delay seconds\n");
210 0           sleep $delay;
211             }
212 0           $LAST_INVOCATION_TIME = time;
213             }
214              
215             1;
216              
217             __END__