File Coverage

blib/lib/LWP/ConnCache/MaxKeepAliveRequests.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


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.