~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/WebAgent.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: WebAgent.pm,v 1.4 2003/06/04 08:36:35 heikki Exp $
 
1
# $Id: WebAgent.pm,v 1.12.4.3 2006/11/08 17:25:54 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::WebAgent
4
4
#
5
 
# Cared for by Heikki Lehvaslaiho, heikki@ebi.ac.uk
 
5
# Cared for by Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
6
6
# For copyright and disclaimer see below.
7
7
#
8
8
 
20
20
 
21
21
=head1 DESCRIPTION
22
22
 
23
 
This abstact superclass is a subclass of L<LWP::UserAgent> which
24
 
allows protocol independent access of accessing remote locations over
 
23
This abstract superclass is a subclass of L<LWP::UserAgent> which
 
24
allows protocol independent access of remote locations over
25
25
the Net.
26
26
 
27
27
It takes care of error handling, proxies and various net protocols.
28
 
BioPerl classes accessing net should inherit from it.  For details,
 
28
BioPerl classes accessing the net should inherit from it.  For details,
29
29
see L<LWP::UserAgent>.
30
30
 
31
 
The interface is still eveolving. For now, I've copied over two public
32
 
methods from Bio::DB::WebDBSeqI: delay() and delay_policy. These are
 
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
33
used to prevent overwhelming the server by rapidly repeated . Ideally
34
34
there should be a common abstract superclass with these. See L<delay>.
35
35
 
46
46
Bioperl modules. Send your comments and suggestions preferably to
47
47
the Bioperl mailing list.  Your participation is much appreciated.
48
48
 
49
 
  bioperl-l@bioperl.org              - General discussion
50
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
49
  bioperl-l@bioperl.org                  - General discussion
 
50
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
51
51
 
52
52
=head2 Reporting Bugs
53
53
 
54
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
56
 
email or the web:
 
55
of the bugs and their resolution. Bug reports can be submitted via the
 
56
web:
57
57
 
58
 
  bioperl-bugs@bioperl.org
59
 
  http://bioperl.org/bioperl-bugs/
 
58
  http://bugzilla.open-bio.org/
60
59
 
61
60
=head1 AUTHOR
62
61
 
63
 
Heikki Lehvaslaiho, heikki@ebi.ac.uk
 
62
Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
64
63
 
65
64
=head1 COPYRIGHT
66
65
 
76
75
 
77
76
=head1 APPENDIX
78
77
 
79
 
This is actually the main documentation...
 
78
The rest of the documentation details each of the object
 
79
methods. Internal methods are usually preceded with a _
80
80
 
81
81
=cut
82
82
 
84
84
# Let the code begin...
85
85
 
86
86
package Bio::WebAgent;
87
 
use vars qw(@ISA  $Revision $LAST_INVOCATION_TIME);
 
87
use vars qw($LAST_INVOCATION_TIME);
88
88
use strict;
89
 
use LWP::UserAgent;
90
 
use Bio::Root::Root;
91
 
 
92
 
@ISA = qw(LWP::UserAgent Bio::Root::Root);
93
 
 
94
 
BEGIN {
95
 
    $Revision = q$Id: WebAgent.pm,v 1.4 2003/06/04 08:36:35 heikki Exp $;
96
 
}
 
89
 
 
90
use base qw(LWP::UserAgent Bio::Root::Root);
97
91
 
98
92
 
99
93
sub new {
100
 
    my $class = shift;
101
 
 
102
 
    my $self = $class->SUPER::new();
103
 
    while( @_ ) {
104
 
        my $key = shift;
105
 
        $key =~ s/^-//;
106
 
        $self->$key(shift);
107
 
    }
108
 
 
109
 
    return $self; # success - we hope!
 
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!
110
111
 
111
112
}
112
113
 
124
125
sub url { 
125
126
   my ($self,$value) = @_;
126
127
   if( defined $value) {
127
 
       $self->{'_url'} = $value;
 
128
                $self->{'_url'} = $value;
128
129
   }
129
130
   return $self->{'_url'};
130
131
}
193
194
   $LAST_INVOCATION_TIME ||=  0;
194
195
   if (time - $LAST_INVOCATION_TIME < $self->delay) {
195
196
      my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
196
 
      warn "sleeping for $delay seconds\n" if $self->verbose > 0;
 
197
      $self->debug("sleeping for $delay seconds\n");
197
198
      sleep $delay;
198
199
   }
199
200
   $LAST_INVOCATION_TIME = time;