view release on metacpan or  search on metacpan

Bio/DB/GenericWebAgent.pm  view on Meta::CPAN

        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};
    }
}

=head2 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

=cut

sub get_Parser {
    shift->throw_not_implemented;
}

=head2 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.

=cut

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

=head2 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.

=cut

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

=head2 _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.

=cut

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;
}

=head1 LWP::UserAgent related methods

=head2 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)

=cut

sub proxy {