lib/Bio/WebAgent.pm

   1 #
   2 # BioPerl module for Bio::WebAgent
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   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<LWP::UserAgent> 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<LWP::UserAgent>.
  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<delay>.
  36
  37 =head1 SEE ALSO
  38
  39 L<LWP::UserAgent>,
  40 L<Bio::DB::WebDBSeqI>,
  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<bioperl-l@bioperl.org>
  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
 100 use vars qw($LAST_INVOCATION_TIME);
 101 use strict;
 102
 103 use base qw(LWP::UserAgent Bio::Root::Root);
 104
 105
 106 sub new {
 107         my $class = shift;
 108
 109         # We make env_proxy the default here, but it can be
 110         # over-ridden by $self->env_proxy later,
 111         # or by new(env_proxy=>0) at constructor time
 112
 113         my $self = $class->SUPER::new(env_proxy => 1);
 114
 115         while( @_ ) {
 116                 my $key = shift;
 117                 $key =~ s/^-//;
 118                 my $value = shift;
 119                 $self->can($key) || next;
 120                 $self->$key($value);
 121         }
 122
 123         return $self; # success - we hope!
 124
 125 }
 126
 127
 128 # -----------------------------------------------------------------------------
 129
 130 =head2 url
 131
 132  Usage   : $agent->url
 133  Returns : URL to reach out to Net
 134  Args    : string
 135
 136 =cut
 137
 138 sub url {
 139    my ($self,$value) = @_;
 140    if( defined $value) {
 141                 $self->{'_url'} = $value;
 142    }
 143    return $self->{'_url'};
 144 }
 145
 146
 147 =head2 delay
 148
 149  Title   : delay
 150  Usage   : $secs = $self->delay([$secs])
 151  Function: get/set number of seconds to delay between fetches
 152  Returns : number of seconds to delay
 153  Args    : new value
 154
 155 NOTE: the default is to use the value specified by delay_policy().
 156 This can be overridden by calling this method, or by passing the
 157 -delay argument to new().
 158
 159 =cut
 160
 161 sub delay {
 162    my ($self, $value) = @_;
 163    if ($value) {
 164        $self->throw("Need a positive integer, not [$value]")
 165            unless $value >= 0;
 166        $self->{'_delay'} = int $value;
 167    }
 168    return $self->{'_delay'} || $self->delay_policy;
 169 }
 170
 171 =head2 delay_policy
 172
 173  Title   : delay_policy
 174  Usage   : $secs = $self->delay_policy
 175  Function: return number of seconds to delay between calls to remote db
 176  Returns : number of seconds to delay
 177  Args    : none
 178
 179 NOTE: The default delay policy is 3s.  Override in subclasses to
 180 implement other delays.  The timer has only second resolution, so the delay
 181 will actually be +/- 1s.
 182
 183 =cut
 184
 185 sub delay_policy {
 186    my $self = shift;
 187    return 3;
 188 }
 189
 190
 191 =head2 sleep
 192
 193  Title   : sleep
 194  Usage   : $self->sleep
 195  Function: sleep for a number of seconds indicated by the delay policy
 196  Returns : none
 197  Args    : none
 198
 199 NOTE: This method keeps track of the last time it was called and only
 200 imposes a sleep if it was called more recently than the delay_policy()
 201 allows.
 202
 203 =cut
 204
 205 sub sleep {
 206    my $self = shift;
 207    $LAST_INVOCATION_TIME ||=  0;
 208    if (time - $LAST_INVOCATION_TIME < $self->delay) {
 209       my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
 210       $self->debug("sleeping for $delay seconds\n");
 211       sleep $delay;
 212    }
 213    $LAST_INVOCATION_TIME = time;
 214 }
 215
 216 1;
 217
 218 __END__
 219