File Coverage

blib/lib/LWP/UserAgent/Throttled.pm
Criterion Covered Total %
statement 30 30 100.0
branch 10 12 83.3
condition 2 3 66.6
subroutine 5 5 100.0
pod 2 2 100.0
total 49 52 94.2


line stmt bran cond sub pod time code
1             package LWP::UserAgent::Throttled;
2              
3 3     3   304579 use LWP;
  3         77971  
  3         87  
4 3     3   25 use Time::HiRes;
  3         7  
  3         27  
5 3     3   338 use LWP::UserAgent;
  3         8  
  3         1004  
6              
7             our @ISA = ('LWP::UserAgent');
8              
9             =head1 NAME
10              
11             LWP::UserAgent::Throttled - Throttle requests to a site
12              
13             =head1 VERSION
14              
15             Version 0.06
16              
17             =cut
18              
19             our $VERSION = '0.06';
20              
21             =head1 SYNOPSIS
22              
23             Some sites with REST APIs, such as openstreetmap.org, will blacklist you if you do too many requests.
24             LWP::UserAgent::Throttled is a sub-class of LWP::UserAgent.
25              
26             use LWP::UserAgent::Throttled;
27             my $ua = LWP::UserAgent::Throttled->new();
28             $ua->throttle({ 'www.example.com' => 5 });
29             print $ua->get('http://www.example.com');
30             sleep (2);
31             print $ua->get('http://www.example.com'); # Will wait at least 3 seconds before the GET is sent
32              
33             =cut
34              
35             =head1 SUBROUTINES/METHODS
36              
37             =head2 send_request
38              
39             See L.
40              
41             =cut
42              
43             sub send_request {
44 4     4 1 8016969 my $self = shift;
45             # my ($request, $arg, $size) = @_;
46 4         11 my $request = $_[0];
47 4         17 my $host = $request->uri()->host();
48              
49 4 100 66     252 if((defined($self->{'throttle'})) && $self->{'throttle'}{$host}) {
50 3 100       16 if($self->{'lastcallended'}{$host}) {
51 2         16 my $waittime = $self->{'throttle'}{$host} - (Time::HiRes::time() - $self->{'lastcallended'}{$host});
52              
53 2 50       12 if($waittime > 0) {
54 2         11916056 Time::HiRes::usleep($waittime * 1e6);
55             }
56             }
57             }
58 4         78 my $rc = $self->SUPER::send_request(@_);
59 4         887593 $self->{'lastcallended'}{$host} = Time::HiRes::time();
60 4         24 return $rc;
61             }
62              
63             =head2 throttle
64              
65             Get/set the number of seconds between each request for sites.
66              
67             my $ua = LWP::UserAgent::Throttled->new();
68             $ua->throttle({ 'search.cpan.org' => 0.1, 'www.example.com' => 1 });
69             print $ua->throttle('search.cpan.org'), "\n"; # prints 0.1
70             print $ua->throttle('perl.org'), "\n"; # prints 0
71              
72             =cut
73              
74             sub throttle {
75 4     4 1 14773 my $self = shift;
76              
77 4 50       13 return if(!defined($_[0]));
78              
79 4 100       14 if(ref($_[0]) eq 'HASH') {
80 1         2 my %throttles = %{$_[0]};
  1         5  
81              
82 1         4 foreach my $host(keys %throttles) {
83 1         4 $self->{'throttle'}{$host} = $throttles{$host};
84             }
85 1         3 return;
86             }
87              
88 3         7 my $host = shift;
89 3 100       21 return $self->{'throttle'}{$host} ? $self->{'throttle'}{$host} : 0;
90             }
91              
92             =head1 AUTHOR
93              
94             Nigel Horne, C<< >>
95              
96             =head1 BUGS
97              
98             There is one global throttle level, so you can't have different levels for different sites.
99              
100             =head1 SEE ALSO
101              
102             L
103              
104             =head1 SUPPORT
105              
106             You can find documentation for this module with the perldoc command.
107              
108             perldoc LWP::UserAgent::Throttled
109              
110             You can also look for information at:
111              
112             =over 4
113              
114             =item * RT: CPAN's request tracker
115              
116             L
117              
118             =item * AnnoCPAN: Annotated CPAN documentation
119              
120             L
121              
122             =item * CPAN Ratings
123              
124             L
125              
126             =item * Search CPAN
127              
128             L
129              
130             =back
131              
132             =head1 LICENSE AND COPYRIGHT
133              
134             Copyright 2017 Nigel Horne.
135              
136             This program is released under the following licence: GPL2
137              
138             =cut
139              
140             1; # End of LWP::Throttle