Bio::DB::GenericWebAgent - helper base class for parameter-based remote server

BioPerl documentation Contained in the BioPerl distribution.

Index

Code Index:

NAME

Top

Bio::DB::GenericWebAgent - helper base class for parameter-based remote server access and response retrieval.

SYNOPSIS

Top

  # DO NOT USE DIRECTLY

  See Bio::DB::EUtilities for an example implementation

DESCRIPTION

Top

WARNING: Please do NOT spam the web servers with multiple requests.

Bio::DB::GenericWebAgent is a generic wrapper around a web agent (LWP::UserAgent), an object which can retain, format, and build parameters for the user agent (Bio::ParameterBaseI), and a BioPerl class parser that processes response content received by the user agent. The Bio::ParameterBaseI object should be state-aware, e.g. know when changes occur to parameters, so that identical requests are not repeatedly sent to the server (this base class takes this into consideration).

FEEDBACK

Top

Mailing Lists

User feedback is an integral part of the evolution of this and other Bioperl modules. Send your comments and suggestions preferably to one of the Bioperl mailing lists. Your participation is much appreciated.

  bioperl-l@lists.open-bio.org               - General discussion
  http://www.bioperl.org/wiki/Mailing_lists  - About the mailing lists

Support

Please direct usage questions or support issues to the mailing list:

bioperl-l@bioperl.org

rather than to the module maintainer directly. Many experienced and reponsive experts will be able look at the problem and quickly address it. Please include a thorough description of the problem with code and data examples if at all possible.

Reporting Bugs

Report bugs to the Bioperl bug tracking system to help us keep track the bugs and their resolution. Bug reports can be submitted via the web.

  https://redmine.open-bio.org/projects/bioperl/

AUTHOR

Top

Email cjfields at bioperl dot org

APPENDIX

Top

The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _

new

 Title   : new
 Usage   : Bio::DB::GenericWebAgent->new(@args);
 Function: Create new Bio::DB::GenericWebAgent instance.
 Returns : 
 Args    : None specific to this base class.  Inheriting classes will
           likely set specific parameters in their constructor;
           Bio::DB::GenericWebAgent is primarily a test bed.

GenericWebAgent methods

Top

parameter_base

 Title   : parameter_base
 Usage   : $dbi->parameter_base($pobj);
 Function: Get/Set Bio::ParameterBaseI.
 Returns : Bio::ParameterBaseI object
 Args    : Bio::ParameterBaseI object

ua

 Title   : ua
 Usage   : $dbi->ua;
 Function: Get/Set LWP::UserAgent.
 Returns : LWP::UserAgent
 Args    : LWP::UserAgent

get_Response

 Title   : get_Response
 Usage   : $agent->get_Response;
 Function: Get the HTTP::Response object by passing it an HTTP::Request (generated from
           Bio::ParameterBaseI implementation).
 Returns : HTTP::Response object or data if callback is used
 Args    : (optional)

           -cache_response - flag to cache HTTP::Response object; 
                             Default is 1 (TRUE, caching ON)

           These are passed on to LWP::UserAgent::request() if stipulated

           -cb     - use a LWP::UserAgent-compliant callback
           -file   - dumps the response to a file (handy for large responses)
                     Note: can't use file and callback at the same time
           -read_size_hint - bytes of content to read in at a time to pass to callback
 Note    : Caching and parameter checking are set

get_Parser

 Title   : get_Parser
 Usage   : $agent->get_Parser;
 Function: Return HTTP::Response content (file, fh, object) attached to defined parser
 Returns : None
 Args    : None
 Note    : Abstract method; defined by implementation

delay

 Title   : delay
 Usage   : $secs = $self->delay($secs)
 Function: get/set number of seconds to delay between fetches
 Returns : number of seconds to delay
 Args    : new value

NOTE: the default is to use the value specified by delay_policy(). This can be overridden by calling this method.

delay_policy

 Title   : delay_policy
 Usage   : $secs = $self->delay_policy
 Function: return number of seconds to delay between calls to remote db
 Returns : number of seconds to delay
 Args    : none

NOTE: The default delay policy is 3s. Override in subclasses to implement delays. The timer has only second resolution, so the delay will actually be +/- 1s.

_sleep

 Title   : _sleep
 Usage   : $self->_sleep
 Function: sleep for a number of seconds indicated by the delay policy
 Returns : none
 Args    : none

NOTE: This method keeps track of the last time it was called and only imposes a sleep if it was called more recently than the delay_policy() allows.

LWP::UserAgent related methods

Top

proxy

 Title   : proxy
 Usage   : $httpproxy = $db->proxy('http')  or
           $db->proxy(['http','ftp'], 'http://myproxy' )
 Function: Get/Set a proxy for use of proxy
 Returns : a string indicating the proxy
 Args    : $protocol : an array ref of the protocol(s) to set/get
           $proxyurl : url of the proxy to use for the specified protocol
           $username : username (if proxy requires authentication)
           $password : password (if proxy requires authentication)

authentication

 Title   : authentication
 Usage   : $db->authentication($user,$pass)
 Function: Get/Set authentication credentials
 Returns : Array of user/pass
 Args    : Array or user/pass
BioPerl documentation Contained in the BioPerl distribution. 
#
# BioPerl module for Bio::DB::GenericWebAgent
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Chris Fields <cjfields at bioperl dot org>
#
# Copyright Chris Fields
#
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code
#
# Interfaces with new GenericWebAgent interface


# Let the code begin...

package Bio::DB::GenericWebAgent;
use strict;
use warnings;
use base qw(Bio::Root::Root);
use LWP::UserAgent;

my $LAST_INVOCATION_TIME = 0;

my $TIME_HIRES = 0;

BEGIN {
    eval {
        use Time::HiRes;
    };
    unless ($@) {
        $TIME_HIRES = 1;
    }
}


sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    $self->ua(LWP::UserAgent->new(env_proxy => 1,
            agent => ref($self)));
    $self->delay($self->delay_policy);
    return $self;
}


# this will likely be overridden in subclasses

sub parameter_base {
    my ($self, $pobj) = @_;
    if ($pobj) {
        $self->throw('Not a Bio::ParameterBaseI')
            if !$pobj->isa('Bio::ParameterBaseI');
        $self->{'_parameter_base'} = $pobj;
    }
    return $self->{'_parameter_base'};
}


sub ua {
	my ($self, $ua) = @_;
	if( defined $ua && $ua->isa("LWP::UserAgent") ) {
		$self->{'_ua'} = $ua;
	}
	return $self->{'_ua'};
}


# TODO deal with small state-related bug with file

sub get_Response {
    my ($self, @args) = @_;
    my ($cache, $file, $cb, $size) = $self->_rearrange([qw(CACHE_RESPONSE FILE CB READ_SIZE_HINT)],@args);
    $self->throw("Can't have both callback and file") if $file && $cb;
    # make -file accept more perl-like write-append type data.
    $file =~ s{^>}{} if $file; 
    my @opts = grep {defined $_} ($file || $cb, $size);
    $cache = (defined $cache && $cache == 0) ? 0 : 1;
    my $pobj = $self->parameter_base;
    if ($pobj->parameters_changed ||
        !$cache  ||
        !$self->{_response_cache} ||
        !$self->{_response_cache}->content) {
        my $ua = $self->ua;
        $self->_sleep; # institute delay policy
        $self->throw('No parameter object set; cannot form a suitable remote request') unless $pobj;
        my $request = $pobj->to_request;
        if ($self->authentication) {
            $request->proxy_authorization_basic($self->authentication)
        }
        $self->debug("Request is: \n",$request->as_string);
        # I'm relying on the useragent to throw the proper errors here
        my $response = $ua->request($request, @opts);
        if ($response->is_error) {
            $self->throw("Response Error\n".$response->message);
        }
        return $self->{_response_cache} = $response;
    } else {
        $self->debug("Returning cached HTTP::Response object\n");
        if ($file) {
            $self->_dump_request_content($file);
            # size isn't passed here, as the content is completely retrieved above
        } elsif ($cb) {
            $cb && ref($cb) eq 'CODE' && $cb->($self->{_response_cache}->content);
        }
        return $self->{_response_cache};
    }    
}


sub get_Parser {
    shift->throw_not_implemented;
}


sub delay {
   my $self = shift;
   return $self->{'_delay'} = shift if @_;
   return $self->{'_delay'};
}


sub delay_policy {
   my $self = shift;
   return 3;
}


sub _sleep {
    my $self = shift;
    my $last_invocation = $LAST_INVOCATION_TIME;
    if (time - $LAST_INVOCATION_TIME < $self->delay) {
        my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
        $self->debug("sleeping for $delay seconds\n");
        if ($TIME_HIRES) {
            # allows precise sleep timeout (builtin only allows integer seconds)
            Time::HiRes::sleep($delay);
        } else {
            # allows precise sleep timeout (builtin only allows integer seconds)

            # I hate this hack , but needed if we support 5.6.1 and
            # don't want additional Time::HiRes prereq
            select undef, undef, undef, $delay;
        }
    }
    $LAST_INVOCATION_TIME = time;
}


sub proxy {
    my ($self,$protocol,$proxy,$username,$password) = @_;
    return if ( !defined $protocol || !defined $proxy );
    $self->authentication($username, $password)
    if ($username && $password);
    return $self->ua->proxy($protocol,$proxy);
}


sub authentication{
   my ($self,$u,$p) = @_;
   if( defined $u && defined $p ) {
       $self->{'_authentication'} = [ $u,$p];
   }
   $self->{'_authentication'} && return @{$self->{'_authentication'}};
}

# private method to dump any cached request data content into a passed filename

sub _dump_request_content {
    my ($self, $file) = @_;
    return unless defined $self->{_response_cache};
    $self->throw("Must pass file name") unless $file;
    require Bio::Root::IO;
    my $out = Bio::Root::IO->new(-file => ">$file");
    $out->_print($self->{_response_cache}->content);
    $out->flush();
    $out->close;
}

1;