Profile of /usr/local/lib/perl5/site_perl/5.10.1/LWP/ConnCache.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:22 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/LWP/ConnCache.pm
Statements Executed | 66
Statement Execution Time | 1.76ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
3 | 2 | 1 | 52µs | 58µs | LWP::ConnCache::::enforce_limitsLWP::ConnCache::enforce_limits
1 | 1 | 1 | 44µs | 53µs | LWP::ConnCache::::BEGIN@3LWP::ConnCache::BEGIN@3
2 | 1 | 1 | 40µs | 74µs | LWP::ConnCache::::depositLWP::ConnCache::deposit
3 | 1 | 1 | 30µs | 30µs | LWP::ConnCache::::withdrawLWP::ConnCache::withdraw
1 | 1 | 1 | 29µs | 66µs | LWP::ConnCache::::newLWP::ConnCache::new
1 | 1 | 1 | 22µs | 103µs | LWP::ConnCache::::BEGIN@4LWP::ConnCache::BEGIN@4
1 | 1 | 1 | 13µs | 37µs | LWP::ConnCache::::total_capacityLWP::ConnCache::total_capacity
1 | 1 | 1 | 7µs | 7µs | LWP::ConnCache::::get_typesLWP::ConnCache::get_types
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::__ANON__[:103]LWP::ConnCache::__ANON__[:103]
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::__ANON__[:109]LWP::ConnCache::__ANON__[:109]
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::__ANON__[:114]LWP::ConnCache::__ANON__[:114]
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::__ANON__[:138]LWP::ConnCache::__ANON__[:138]
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::_looks_like_numberLWP::ConnCache::_looks_like_number
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::capacityLWP::ConnCache::capacity
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::dropLWP::ConnCache::drop
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::droppingLWP::ConnCache::dropping
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::get_connectionsLWP::ConnCache::get_connections
0 | 0 | 0 | 0s | 0s | LWP::ConnCache::::pruneLWP::ConnCache::prune

Call graph for these subroutines as a Graphviz dot language file.

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 use strict; # 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 use vars qw($VERSION $DEBUG); # 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 sub new {
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 sub deposit {
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 sub withdraw {
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 sub total_capacity {
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 |  |  |  |  | # spent 58µs (52+7) within LWP::ConnCache::enforce_limits which was called 3 times, avg 20µs/call: # 2 times (34µs+0s) by LWP::ConnCache::deposit at line 26, avg 17µs/call # once (18µs+7µs) by LWP::ConnCache::total_capacity at line 49 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 sub get_types {
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.