Bio/WebAgent.pm

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