File Coverage

blib/lib/LWP/UserAgent/Throttled.pm

Criterion	Covered	Total	%
statement	31	44	70.4
branch	3	16	18.7
condition	1	8	12.5
subroutine	8	9	88.8
pod	3	3	100.0
total	46	80	57.5

package LWP::UserAgent::Throttled;

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

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

=head1 NAME

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

=head1 VERSION

Version 0.14

=cut

our $VERSION = '0.14';

=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 = lc(URI->new($request->uri)->host());	# Normalize the URL

	if((defined($self->{'throttle'})) && $self->{'throttle'}{$host} && $self->{'lastcallended'}{$host}) {
		# Can't set a negative throttle
		die "Throttle for $host must be >= 0" unless $self->{'throttle'}{$host} >= 0;

		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, $args) = @_;

	return unless(defined($args));

	if(ref($args) eq 'HASH') {
		# Merge the new throttles in with the previous throttles
		$self->{throttle} = { %{$self->{throttle} || {}}, %{$args} };
		return $self;
	}

	return $self->{throttle}{$args} || 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

This module is provided as-is without any warranty.

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 Testers Dependencies

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2017-2025 Nigel Horne.

This program is released under the following licence: GPL2

=cut

1; # End of LWP::Throttle