1 package LWP::ConnCache;
4 use vars qw($VERSION $DEBUG);
10 my($class, %cnf) = @_;
11 my $total_capacity = delete $cnf{total_capacity};
12 $total_capacity = 1 unless defined $total_capacity;
15 Carp::carp("Unrecognised options: @{[sort keys %cnf]}")
17 my $self = bless { cc_conns => [] }, $class;
18 $self->total_capacity($total_capacity);
24 my($self, $type, $key, $conn) = @_;
25 push(@{$self->{cc_conns}}, [$conn, $type, $key, time]);
26 $self->enforce_limits($type);
32 my($self, $type, $key) = @_;
33 my $conns = $self->{cc_conns};
34 for my $i (0 .. @$conns - 1) {
36 next unless $c->[1] eq $type && $c->[2] eq $key;
37 splice(@$conns, $i, 1); # remove it
46 my $old = $self->{cc_limit_total};
48 $self->{cc_limit_total} = shift;
49 $self->enforce_limits;
58 my $old = $self->{cc_limit}{$type};
60 $self->{cc_limit}{$type} = shift;
61 $self->enforce_limits($type);
68 my($self, $type) = @_;
69 my $conns = $self->{cc_conns};
71 my @types = $type ? ($type) : ($self->get_types);
73 next unless $self->{cc_limit};
74 my $limit = $self->{cc_limit}{$type};
75 next unless defined $limit;
76 for my $i (reverse 0 .. @$conns - 1) {
77 next unless $conns->[$i][1] eq $type;
79 $self->dropping(splice(@$conns, $i, 1), "$type capacity exceeded");
84 if (defined(my $total = $self->{cc_limit_total})) {
85 while (@$conns > $total) {
86 $self->dropping(shift(@$conns), "Total capacity exceeded");
93 my($self, $c, $reason) = @_;
94 print "DROPPING @$c [$reason]\n" if $DEBUG;
99 my($self, $checker, $reason) = @_;
100 if (ref($checker) ne "CODE") {
102 if (!defined $checker) {
103 $checker = sub { 1 }; # drop all of them
105 elsif (_looks_like_number($checker)) {
106 my $age_limit = $checker;
107 my $time_limit = time - $age_limit;
108 $reason ||= "older than $age_limit";
109 $checker = sub { $_[3] < $time_limit };
113 $reason ||= "drop $type";
114 $checker = sub { $_[1] eq $type }; # match on type
119 local $SIG{__DIE__}; # don't interfere with eval below
122 for (@{$self->{cc_conns}}) {
125 if (&$checker(@$_)) {
126 $self->dropping($_, $reason);
130 push(@c, $_) unless $drop;
132 @{$self->{cc_conns}} = @c;
138 $self->drop(sub { !shift->ping }, "ping");
145 $t{$_->[1]}++ for @{$self->{cc_conns}};
150 sub get_connections {
151 my($self, $type) = @_;
153 for (@{$self->{cc_conns}}) {
154 push(@c, $_->[0]) if !$type || ($type && $type eq $_->[1]);
160 sub _looks_like_number {
161 $_[0] =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
171 LWP::ConnCache - Connection cache manager
175 This module is experimental. Details of its interface is likely to
176 change in the future.
181 my $cache = LWP::ConnCache->new;
182 $cache->deposit($type, $key, $sock);
183 $sock = $cache->withdraw($type, $key);
187 The C<LWP::ConnCache> class is the standard connection cache manager
190 The following basic methods are provided:
194 =item $cache = LWP::ConnCache->new( %options )
196 This method constructs a new C<LWP::ConnCache> object. The only
197 option currently accepted is 'total_capacity'. If specified it
198 initialize the total_capacity option. It defaults to the value 1.
200 =item $cache->total_capacity( [$num_connections] )
202 Get/sets the number of connection that will be cached. Connections
203 will start to be dropped when this limit is reached. If set to C<0>,
204 then all connections are immediately dropped. If set to C<undef>,
205 then there is no limit.
207 =item $cache->capacity($type, [$num_connections] )
209 Get/set a limit for the number of connections of the specified type
210 that can be cached. The $type will typically be a short string like
213 =item $cache->drop( [$checker, [$reason]] )
215 Drop connections by some criteria. The $checker argument is a
216 subroutine that is called for each connection. If the routine returns
217 a TRUE value then the connection is dropped. The routine is called
218 with ($conn, $type, $key, $deposit_time) as arguments.
220 Shortcuts: If the $checker argument is absent (or C<undef>) all cached
221 connections are dropped. If the $checker is a number then all
222 connections untouched that the given number of seconds or more are
223 dropped. If $checker is a string then all connections of the given
226 The $reason argument is passed on to the dropped() method.
230 Calling this method will drop all connections that are dead. This is
231 tested by calling the ping() method on the connections. If the ping()
232 method exists and returns a FALSE value, then the connection is
235 =item $cache->get_types
237 This returns all the 'type' fields used for the currently cached
240 =item $cache->get_connections( [$type] )
242 This returns all connection objects of the specified type. If no type
243 is specified then all connections are returned. In scalar context the
244 number of cached connections of the specified type is returned.
249 The following methods are called by low-level protocol modules to
250 try to save away connections and to get them back.
254 =item $cache->deposit($type, $key, $conn)
256 This method adds a new connection to the cache. As a result other
257 already cached connections might be dropped. Multiple connections with
258 the same $type/$key might added.
260 =item $conn = $cache->withdraw($type, $key)
262 This method tries to fetch back a connection that was previously
263 deposited. If no cached connection with the specified $type/$key is
264 found, then C<undef> is returned. There is not guarantee that a
265 deposited connection can be withdrawn, as the cache manger is free to
266 drop connections at any time.
270 The following methods are called internally. Subclasses might want to
275 =item $conn->enforce_limits([$type])
277 This method is called with after a new connection is added (deposited)
278 in the cache or capacity limits are adjusted. The default
279 implementation drops connections until the specified capacity limits
282 =item $conn->dropping($conn_record, $reason)
284 This method is called when a connection is dropped. The record
285 belonging to the dropped connection is passed as the first argument
286 and a string describing the reason for the drop is passed as the
287 second argument. The default implementation makes some noise if the
288 $LWP::ConnCache::DEBUG variable is set and nothing more.
294 For specialized cache policy it makes sense to subclass
295 C<LWP::ConnCache> and perhaps override the deposit(), enforce_limits()
296 and dropping() methods.
298 The object itself is a hash. Keys prefixed with C<cc_> are reserved
307 Copyright 2001 Gisle Aas.
309 This library is free software; you can redistribute it and/or
310 modify it under the same terms as Perl itself.