view release on metacpan or  search on metacpan

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

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

=head2 authentication

 Title   : authentication
 Usage   : $db->authentication($user,$pass)
 Function: Get/Set authentication credentials
 Returns : Array of user/pass
 Args    : Array or user/pass

=cut

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;