File Coverage

blib/lib/LWP/UserAgent/Throttled.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	13	16	81.2
condition	3	3	100.0
subroutine	8	8	100.0
pod	3	3	100.0
total	70	73	95.8

package LWP::UserAgent::Throttled;

use warnings;
use strict;
use LWP;
use Time::HiRes;
use LWP::UserAgent;

our @ISA = ('LWP::UserAgent');

=head1 NAME

LWP::UserAgent::Throttled - Throttle requests to a site

=head1 VERSION

Version 0.09

=cut

our $VERSION = '0.09';

=head1 SYNOPSIS

Some sites with REST APIs, such as openstreetmap.org, will blacklist you if you do too many requests.
LWP::UserAgent::Throttled is a sub-class of LWP::UserAgent.

    use LWP::UserAgent::Throttled;
    my $ua = LWP::UserAgent::Throttled->new();
    $ua->throttle({ 'www.example.com' => 5 });
    print $ua->get('http://www.example.com/page1.html');
    sleep (2);
    print $ua->get('http://www.example.com/page2.html');	# Will wait at least 3 seconds before the GET is sent

=cut

=head1 SUBROUTINES/METHODS

=head2 send_request

See L.

=cut

sub send_request {
	# my ($request, $arg, $size) = @_;

	my $self = shift;
	my $request = $_[0];
	my $host = $request->uri()->host();

	if((defined($self->{'throttle'})) && $self->{'throttle'}{$host}) {
		if($self->{'lastcallended'}{$host}) {
			my $waittime = $self->{'throttle'}{$host} - (Time::HiRes::time() - $self->{'lastcallended'}{$host});

			if($waittime > 0) {
				Time::HiRes::usleep($waittime * 1e6);
			}
		}
	}
	my $rc;
	if(defined($self->{'_ua'})) {
		$rc = $self->{'_ua'}->send_request(@_);
	} else {
		$rc = $self->SUPER::send_request(@_);
	}
	$self->{'lastcallended'}{$host} = Time::HiRes::time();
	return $rc;
}

=head2 throttle

Get/set the number of seconds between each request for sites.

    my $ua = LWP::UserAgent::Throttled->new();
    $ua->throttle({ 'search.cpan.org' => 0.1, 'www.example.com' => 1 });
    print $ua->throttle('search.cpan.org'), "\n";    # prints 0.1
    print $ua->throttle('perl.org'), "\n";    # prints 0

When setting a throttle it returns itself,
so you can daisy chain messages.

=cut

sub throttle {
	my $self = shift;

	return if(!defined($_[0]));

	if(ref($_[0]) eq 'HASH') {
		my %throttles = %{$_[0]};

		foreach my $host(keys %throttles) {
			$self->{'throttle'}{$host} = $throttles{$host};
		}
		return $self;
	}

	my $host = shift;
	return $self->{'throttle'}{$host} ? $self->{'throttle'}{$host} : 0;
}

=head2 ua

Get/set the user agent if you wish to use that rather than itself

    use LWP::UserAgent::Cached;

    $ua->ua(LWP::UserAgent::Cached->new(cache_dir => '/home/home/.cache/lwp-cache'));
    my $resp = $ua->get('https://www.nigelhorne.com');	# Throttles, then checks cache, then gets

=cut

sub ua {
	my($self, $ua) = @_;

	if($ua) {
		$self->{_ua} = $ua;
	}

	return $self->{_ua};
}

=head1 AUTHOR

Nigel Horne, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C,
or through the web interface at
L.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

Redirects to other domains can confuse it, so you need to program those manually.

=head1 SEE ALSO

L

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc LWP::UserAgent::Throttled

You can also look for information at:

=over 4

=item * MetaCPAN

L

=item * RT: CPAN's request tracker

L

=item * CPANTS

L

=item * CPAN Testers' Matrix

L

=item * CPAN Ratings

L

=item * CPAN Testers Dependencies

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2017-2022 Nigel Horne.

This program is released under the following licence: GPL2

=cut

1; # End of LWP::Throttle