File | /usr/local/lib/perl5/site_perl/5.10.1/LWP/ConnCache.pm |
Statements Executed | 66 |
Statement Execution Time | 1.76ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
3 | 2 | 1 | 52µs | 58µs | enforce_limits | LWP::ConnCache::
1 | 1 | 1 | 44µs | 53µs | BEGIN@3 | LWP::ConnCache::
2 | 1 | 1 | 40µs | 74µs | deposit | LWP::ConnCache::
3 | 1 | 1 | 30µs | 30µs | withdraw | LWP::ConnCache::
1 | 1 | 1 | 29µs | 66µs | new | LWP::ConnCache::
1 | 1 | 1 | 22µs | 103µs | BEGIN@4 | LWP::ConnCache::
1 | 1 | 1 | 13µs | 37µs | total_capacity | LWP::ConnCache::
1 | 1 | 1 | 7µs | 7µs | get_types | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | __ANON__[:103] | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | __ANON__[:109] | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | __ANON__[:114] | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | __ANON__[:138] | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | _looks_like_number | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | capacity | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | drop | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | dropping | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | get_connections | LWP::ConnCache::
0 | 0 | 0 | 0s | 0s | prune | LWP::ConnCache::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package LWP::ConnCache; | ||||
2 | |||||
3 | 3 | 75µs | 2 | 61µs | # spent 53µs (44+8) within LWP::ConnCache::BEGIN@3 which was called
# once (44µs+8µs) by LWP::UserAgent::conn_cache at line 3 # spent 53µs making 1 call to LWP::ConnCache::BEGIN@3
# spent 8µs making 1 call to strict::import |
4 | 3 | 1.50ms | 2 | 183µs | # spent 103µs (22+81) within LWP::ConnCache::BEGIN@4 which was called
# once (22µs+81µs) by LWP::UserAgent::conn_cache at line 4 # spent 103µs making 1 call to LWP::ConnCache::BEGIN@4
# spent 81µs making 1 call to vars::import |
5 | |||||
6 | 1 | 1µs | $VERSION = "5.810"; | ||
7 | |||||
8 | |||||
9 | # spent 66µs (29+37) within LWP::ConnCache::new which was called
# once (29µs+37µs) by LWP::UserAgent::conn_cache at line 687 of LWP/UserAgent.pm | ||||
10 | 1 | 3µs | my($class, %cnf) = @_; | ||
11 | 1 | 2µs | my $total_capacity = delete $cnf{total_capacity}; | ||
12 | 1 | 600ns | $total_capacity = 1 unless defined $total_capacity; | ||
13 | 1 | 600ns | if (%cnf && $^W) { | ||
14 | require Carp; | ||||
15 | Carp::carp("Unrecognised options: @{[sort keys %cnf]}") | ||||
16 | } | ||||
17 | 1 | 14µs | my $self = bless { cc_conns => [] }, $class; | ||
18 | 1 | 2µs | 1 | 37µs | $self->total_capacity($total_capacity); # spent 37µs making 1 call to LWP::ConnCache::total_capacity |
19 | 1 | 6µs | $self; | ||
20 | } | ||||
21 | |||||
22 | |||||
23 | # spent 74µs (40+34) within LWP::ConnCache::deposit which was called 2 times, avg 37µs/call:
# 2 times (40µs+34µs) by LWP::Protocol::http::request at line 408 of LWP/Protocol/http.pm, avg 37µs/call | ||||
24 | 2 | 5µs | my($self, $type, $key, $conn) = @_; | ||
25 | 2 | 11µs | push(@{$self->{cc_conns}}, [$conn, $type, $key, time]); | ||
26 | 2 | 9µs | 2 | 34µs | $self->enforce_limits($type); # spent 34µs making 2 calls to LWP::ConnCache::enforce_limits, avg 17µs/call |
27 | 2 | 11µs | return; | ||
28 | } | ||||
29 | |||||
30 | |||||
31 | # spent 30µs within LWP::ConnCache::withdraw which was called 3 times, avg 10µs/call:
# 3 times (30µs+0s) by LWP::Protocol::http::_new_socket at line 21 of LWP/Protocol/http.pm, avg 10µs/call | ||||
32 | 3 | 4µs | my($self, $type, $key) = @_; | ||
33 | 3 | 3µs | my $conns = $self->{cc_conns}; | ||
34 | 3 | 9µs | for my $i (0 .. @$conns - 1) { | ||
35 | 1 | 1µs | my $c = $conns->[$i]; | ||
36 | 1 | 1µs | next unless $c->[1] eq $type && $c->[2] eq $key; | ||
37 | 1 | 600ns | splice(@$conns, $i, 1); # remove it | ||
38 | 1 | 4µs | return $c->[0]; | ||
39 | } | ||||
40 | 2 | 10µs | return undef; | ||
41 | } | ||||
42 | |||||
43 | |||||
44 | # spent 37µs (13+25) within LWP::ConnCache::total_capacity which was called
# once (13µs+25µs) by LWP::ConnCache::new at line 18 | ||||
45 | 1 | 600ns | my $self = shift; | ||
46 | 1 | 800ns | my $old = $self->{cc_limit_total}; | ||
47 | 1 | 800ns | if (@_) { | ||
48 | 1 | 700ns | $self->{cc_limit_total} = shift; | ||
49 | 1 | 2µs | 1 | 25µs | $self->enforce_limits; # spent 25µs making 1 call to LWP::ConnCache::enforce_limits |
50 | } | ||||
51 | 1 | 5µs | $old; | ||
52 | } | ||||
53 | |||||
54 | |||||
55 | sub capacity { | ||||
56 | my $self = shift; | ||||
57 | my $type = shift; | ||||
58 | my $old = $self->{cc_limit}{$type}; | ||||
59 | if (@_) { | ||||
60 | $self->{cc_limit}{$type} = shift; | ||||
61 | $self->enforce_limits($type); | ||||
62 | } | ||||
63 | $old; | ||||
64 | } | ||||
65 | |||||
66 | |||||
67 | sub enforce_limits { | ||||
68 | 3 | 4µs | my($self, $type) = @_; | ||
69 | 3 | 3µs | my $conns = $self->{cc_conns}; | ||
70 | |||||
71 | 3 | 7µs | 1 | 7µs | my @types = $type ? ($type) : ($self->get_types); # spent 7µs making 1 call to LWP::ConnCache::get_types |
72 | 3 | 8µs | for $type (@types) { | ||
73 | 2 | 2µs | 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; | ||||
78 | if (--$limit < 0) { | ||||
79 | $self->dropping(splice(@$conns, $i, 1), "$type capacity exceeded"); | ||||
80 | } | ||||
81 | } | ||||
82 | } | ||||
83 | |||||
84 | 3 | 29µs | if (defined(my $total = $self->{cc_limit_total})) { | ||
85 | while (@$conns > $total) { | ||||
86 | $self->dropping(shift(@$conns), "Total capacity exceeded"); | ||||
87 | } | ||||
88 | } | ||||
89 | } | ||||
90 | |||||
91 | |||||
92 | sub dropping { | ||||
93 | my($self, $c, $reason) = @_; | ||||
94 | print "DROPPING @$c [$reason]\n" if $DEBUG; | ||||
95 | } | ||||
96 | |||||
97 | |||||
98 | sub drop { | ||||
99 | my($self, $checker, $reason) = @_; | ||||
100 | if (ref($checker) ne "CODE") { | ||||
101 | # make it so | ||||
102 | if (!defined $checker) { | ||||
103 | $checker = sub { 1 }; # drop all of them | ||||
104 | } | ||||
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 }; | ||||
110 | } | ||||
111 | else { | ||||
112 | my $type = $checker; | ||||
113 | $reason ||= "drop $type"; | ||||
114 | $checker = sub { $_[1] eq $type }; # match on type | ||||
115 | } | ||||
116 | } | ||||
117 | $reason ||= "drop"; | ||||
118 | |||||
119 | local $SIG{__DIE__}; # don't interfere with eval below | ||||
120 | local $@; | ||||
121 | my @c; | ||||
122 | for (@{$self->{cc_conns}}) { | ||||
123 | my $drop; | ||||
124 | eval { | ||||
125 | if (&$checker(@$_)) { | ||||
126 | $self->dropping($_, $reason); | ||||
127 | $drop++; | ||||
128 | } | ||||
129 | }; | ||||
130 | push(@c, $_) unless $drop; | ||||
131 | } | ||||
132 | @{$self->{cc_conns}} = @c; | ||||
133 | } | ||||
134 | |||||
135 | |||||
136 | sub prune { | ||||
137 | my $self = shift; | ||||
138 | $self->drop(sub { !shift->ping }, "ping"); | ||||
139 | } | ||||
140 | |||||
141 | |||||
142 | # spent 7µs within LWP::ConnCache::get_types which was called
# once (7µs+0s) by LWP::ConnCache::enforce_limits at line 71 | ||||
143 | 1 | 400ns | my $self = shift; | ||
144 | 1 | 200ns | my %t; | ||
145 | 2 | 2µs | $t{$_->[1]}++ for @{$self->{cc_conns}}; | ||
146 | 1 | 12µs | return keys %t; | ||
147 | } | ||||
148 | |||||
149 | |||||
150 | sub get_connections { | ||||
151 | my($self, $type) = @_; | ||||
152 | my @c; | ||||
153 | for (@{$self->{cc_conns}}) { | ||||
154 | push(@c, $_->[0]) if !$type || ($type && $type eq $_->[1]); | ||||
155 | } | ||||
156 | @c; | ||||
157 | } | ||||
158 | |||||
159 | |||||
160 | sub _looks_like_number { | ||||
161 | $_[0] =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; | ||||
162 | } | ||||
163 | |||||
164 | 1 | 7µs | 1; | ||
165 | |||||
166 | |||||
167 | __END__ | ||||
168 | |||||
169 | =head1 NAME | ||||
170 | |||||
171 | LWP::ConnCache - Connection cache manager | ||||
172 | |||||
173 | =head1 NOTE | ||||
174 | |||||
175 | This module is experimental. Details of its interface is likely to | ||||
176 | change in the future. | ||||
177 | |||||
178 | =head1 SYNOPSIS | ||||
179 | |||||
180 | use LWP::ConnCache; | ||||
181 | my $cache = LWP::ConnCache->new; | ||||
182 | $cache->deposit($type, $key, $sock); | ||||
183 | $sock = $cache->withdraw($type, $key); | ||||
184 | |||||
185 | =head1 DESCRIPTION | ||||
186 | |||||
187 | The C<LWP::ConnCache> class is the standard connection cache manager | ||||
188 | for LWP::UserAgent. | ||||
189 | |||||
190 | The following basic methods are provided: | ||||
191 | |||||
192 | =over | ||||
193 | |||||
194 | =item $cache = LWP::ConnCache->new( %options ) | ||||
195 | |||||
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. | ||||
199 | |||||
200 | =item $cache->total_capacity( [$num_connections] ) | ||||
201 | |||||
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. | ||||
206 | |||||
207 | =item $cache->capacity($type, [$num_connections] ) | ||||
208 | |||||
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 | ||||
211 | "http" or "ftp". | ||||
212 | |||||
213 | =item $cache->drop( [$checker, [$reason]] ) | ||||
214 | |||||
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. | ||||
219 | |||||
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 | ||||
224 | type are dropped. | ||||
225 | |||||
226 | The $reason argument is passed on to the dropped() method. | ||||
227 | |||||
228 | =item $cache->prune | ||||
229 | |||||
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 | ||||
233 | dropped. | ||||
234 | |||||
235 | =item $cache->get_types | ||||
236 | |||||
237 | This returns all the 'type' fields used for the currently cached | ||||
238 | connections. | ||||
239 | |||||
240 | =item $cache->get_connections( [$type] ) | ||||
241 | |||||
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. | ||||
245 | |||||
246 | =back | ||||
247 | |||||
248 | |||||
249 | The following methods are called by low-level protocol modules to | ||||
250 | try to save away connections and to get them back. | ||||
251 | |||||
252 | =over | ||||
253 | |||||
254 | =item $cache->deposit($type, $key, $conn) | ||||
255 | |||||
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. | ||||
259 | |||||
260 | =item $conn = $cache->withdraw($type, $key) | ||||
261 | |||||
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. | ||||
267 | |||||
268 | =back | ||||
269 | |||||
270 | The following methods are called internally. Subclasses might want to | ||||
271 | override them. | ||||
272 | |||||
273 | =over | ||||
274 | |||||
275 | =item $conn->enforce_limits([$type]) | ||||
276 | |||||
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 | ||||
280 | are not exceeded. | ||||
281 | |||||
282 | =item $conn->dropping($conn_record, $reason) | ||||
283 | |||||
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. | ||||
289 | |||||
290 | =back | ||||
291 | |||||
292 | =head1 SUBCLASSING | ||||
293 | |||||
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. | ||||
297 | |||||
298 | The object itself is a hash. Keys prefixed with C<cc_> are reserved | ||||
299 | for the base class. | ||||
300 | |||||
301 | =head1 SEE ALSO | ||||
302 | |||||
303 | L<LWP::UserAgent> | ||||
304 | |||||
305 | =head1 COPYRIGHT | ||||
306 | |||||
307 | Copyright 2001 Gisle Aas. | ||||
308 | |||||
309 | This library is free software; you can redistribute it and/or | ||||
310 | modify it under the same terms as Perl itself. |