line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package LWP::ConnCache::MaxKeepAliveRequests; |
2
|
1
|
|
|
1
|
|
94756
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.33'; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
extends 'LWP::ConnCache'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub new { |
8
|
|
|
|
|
|
|
my ( $class, %args ) = @_; |
9
|
|
|
|
|
|
|
my $max_keep_alive_requests = $args{max_keep_alive_requests} || 100; |
10
|
|
|
|
|
|
|
delete $args{max_keep_alive_requests}; |
11
|
|
|
|
|
|
|
my $self = LWP::ConnCache->new(%args); |
12
|
|
|
|
|
|
|
$self->{max_keep_alive_requests} = $max_keep_alive_requests; |
13
|
|
|
|
|
|
|
bless $self, $class; |
14
|
|
|
|
|
|
|
return $self; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
around 'deposit' => sub { |
18
|
|
|
|
|
|
|
my ( $coderef, $self, $type, $key, $conn ) = @_; |
19
|
|
|
|
|
|
|
my $max_keep_alive_requests = $self->{max_keep_alive_requests}; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $keep_alive_requests = ${*$conn}{'myhttp_response_count'}; |
22
|
|
|
|
|
|
|
if ( $keep_alive_requests < $max_keep_alive_requests ) { |
23
|
|
|
|
|
|
|
$coderef->( $self, $type, $key, $conn ); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
}; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
1; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
__END__ |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 NAME |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
LWP::ConnCache::MaxKeepAliveRequests - A connection cache that enforces a max keep alive limit |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 SYNOPSIS |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
use LWP; |
38
|
|
|
|
|
|
|
use LWP::ConnCache::MaxKeepAliveRequests; |
39
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
40
|
|
|
|
|
|
|
$ua->conn_cache( |
41
|
|
|
|
|
|
|
LWP::ConnCache::MaxKeepAliveRequests->new( |
42
|
|
|
|
|
|
|
total_capacity => 10, |
43
|
|
|
|
|
|
|
max_keep_alive_requests => 100, |
44
|
|
|
|
|
|
|
) |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 DESCRIPTION |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
L<LWP::UserAgent> is the default module for issuing HTTP requests from |
50
|
|
|
|
|
|
|
Perl. It has a keep_alive setting which by default allows unlimited |
51
|
|
|
|
|
|
|
requests to the same server. Some servers will disconnect you after |
52
|
|
|
|
|
|
|
a limited number of requests (in Apache 2 this is achieved with the |
53
|
|
|
|
|
|
|
MaxKeepAliveRequests directive). This module allows you to limit |
54
|
|
|
|
|
|
|
the maximum number of keep alive requests to a server. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 AUTHOR |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Leon Brocard <acme@astray.com>. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 COPYRIGHT |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Copyright (C) 2008, Leon Brocard |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 LICENSE |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This module is free software; you can redistribute it or modify it |
67
|
|
|
|
|
|
|
under the same terms as Perl itself. |