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://redmine.open-bio.org/projects/bioperl/
  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 use vars qw($LAST_INVOCATION_TIME);
 100 use strict;
 101
 102 use base qw(LWP::UserAgent Bio::Root::Root);
 103
 104
 105 sub new {
 106         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         my $self = $class->SUPER::new(env_proxy => 1);
 113
 114         while( @_ ) {
 115                 my $key = shift;
 116                 $key =~ s/^-//;
 117                 my $value = shift;
 118                 $self->can($key) || next;
 119                 $self->$key($value);
 120         }
 121
 122         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    my ($self,$value) = @_;
 139    if( defined $value) {
 140                 $self->{'_url'} = $value;
 141    }
 142    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    my ($self, $value) = @_;
 162    if ($value) {
 163        $self->throw("Need a positive integer, not [$value]")
 164            unless $value >= 0;
 165        $self->{'_delay'} = int $value;
 166    }
 167    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    my $self = shift;
 186    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    my $self = shift;
 206    $LAST_INVOCATION_TIME ||=  0;
 207    if (time - $LAST_INVOCATION_TIME < $self->delay) {
 208       my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
 209       $self->debug("sleeping for $delay seconds\n");
 210       sleep $delay;
 211    }
 212    $LAST_INVOCATION_TIME = time;
 213 }
 214
 215 1;
 216
 217 __END__
 218