← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:59 2010

File /usr/local/lib/perl5/5.8.8/i686-linux/IO/Select.pm
Statements Executed 20758
Statement Execution Time 48.0s
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4611247.8s47.8sIO::Select::::CORE:sselectIO::Select::CORE:sselect (opcode)
4611169.3ms97.2msIO::Select::::_updateIO::Select::_update
4611155.1ms55.1msIO::Select::::handlesIO::Select::handles
4611129.0ms47.8sIO::Select::::can_writeIO::Select::can_write
4611124.0ms133msIO::Select::::newIO::Select::new
4611119.2ms27.9msIO::Select::::_filenoIO::Select::_fileno
4611111.8ms109msIO::Select::::addIO::Select::add
461128.70ms8.70msIO::Select::::CORE:matchIO::Select::CORE:match (opcode)
0000s0sIO::Select::::BEGINIO::Select::BEGIN
0000s0sIO::Select::::_maxIO::Select::_max
0000s0sIO::Select::::as_stringIO::Select::as_string
0000s0sIO::Select::::bitsIO::Select::bits
0000s0sIO::Select::::can_readIO::Select::can_read
0000s0sIO::Select::::countIO::Select::count
0000s0sIO::Select::::existsIO::Select::exists
0000s0sIO::Select::::has_errorIO::Select::has_error
0000s0sIO::Select::::has_exceptionIO::Select::has_exception
0000s0sIO::Select::::removeIO::Select::remove
0000s0sIO::Select::::selectIO::Select::select
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# IO::Select.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6
7package IO::Select;
8
9390µs125µsuse strict;
# spent 25µs making 1 call to strict::import
103105µs1704µsuse warnings::register;
# spent 704µs making 1 call to warnings::register::import
1132.16ms1214µsuse vars qw($VERSION @ISA);
# spent 214µs making 1 call to vars::import
1217µsrequire Exporter;
13
1416µs$VERSION = "1.17";
15
16111µs@ISA = qw(Exporter); # This is only so we can do version checking
17
18sub VEC_BITS () {0}
19sub FD_COUNT () {1}
20sub FIRST_FD () {2}
21
22sub new
23
# spent 133ms (24.0+109) within IO::Select::new which was called 461 times, avg 289µs/call: # 461 times (24.0ms+109ms) by IO::Socket::connect at line 118 of IO/Socket.pm, avg 289µs/call
{
244612.91ms my $self = shift;
254612.43ms my $type = ref($self) || $self;
26
274614.90ms my $vec = bless [undef,0], $type;
28
294617.81ms461109ms $vec->add(@_)
# spent 109ms making 461 calls to IO::Select::add, avg 236µs/call
30 if @_;
31
324615.55ms $vec;
33}
34
35sub add
36
# spent 109ms (11.8+97.2) within IO::Select::add which was called 461 times, avg 236µs/call: # 461 times (11.8ms+97.2ms) by IO::Select::new at line 29, avg 236µs/call
{
3746110.7ms46197.2ms shift->_update('add', @_);
# spent 97.2ms making 461 calls to IO::Select::_update, avg 211µs/call
38}
39
40
41sub remove
42{
43 shift->_update('remove', @_);
44}
45
46
47sub exists
48{
49 my $vec = shift;
50 my $fno = $vec->_fileno(shift);
51 return undef unless defined $fno;
52 $vec->[$fno + FIRST_FD];
53}
54
55
56sub _fileno
57
# spent 27.9ms (19.2+8.70) within IO::Select::_fileno which was called 461 times, avg 60µs/call: # 461 times (19.2ms+8.70ms) by IO::Select::_update at line 76, avg 60µs/call
{
584612.48ms my($self, $f) = @_;
594612.03ms return unless defined $f;
604612.45ms $f = $f->[0] if ref($f) eq 'ARRAY';
6146121.4ms4618.70ms ($f =~ /^\d+$/) ? $f : fileno($f);
# spent 8.70ms making 461 calls to IO::Select::CORE:match, avg 19µs/call
62}
63
64sub _update
65
# spent 97.2ms (69.3+27.9) within IO::Select::_update which was called 461 times, avg 211µs/call: # 461 times (69.3ms+27.9ms) by IO::Select::add at line 37, avg 211µs/call
{
664612.22ms my $vec = shift;
674612.51ms my $add = shift eq 'add';
68
694612.59ms my $bits = $vec->[VEC_BITS];
704612.57ms $bits = '' unless defined $bits;
71
724611.98ms my $count = 0;
734612.00ms my $f;
744614.93ms foreach $f (@_)
75 {
764617.86ms46127.9ms my $fn = $vec->_fileno($f);
# spent 27.9ms making 461 calls to IO::Select::_fileno, avg 60µs/call
774612.04ms next unless defined $fn;
784612.58ms my $i = $fn + FIRST_FD;
794614.21ms if ($add) {
804612.35ms if (defined $vec->[$i]) {
81 $vec->[$i] = $f; # if array rest might be different, so we update
82 next;
83 }
844612.20ms $vec->[FD_COUNT]++;
854613.53ms vec($bits, $fn, 1) = 1;
864613.22ms $vec->[$i] = $f;
87 } else { # remove
88 next unless defined $vec->[$i];
89 $vec->[FD_COUNT]--;
90 vec($bits, $fn, 1) = 0;
91 $vec->[$i] = undef;
92 }
934615.15ms $count++;
94 }
954612.52ms $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
9646115.6ms $count;
97}
98
99sub can_read
100{
101 my $vec = shift;
102 my $timeout = shift;
103 my $r = $vec->[VEC_BITS];
104
105 defined($r) && (select($r,undef,undef,$timeout) > 0)
106 ? handles($vec, $r)
107 : ();
108}
109
110sub can_write
111
# spent 47.8s (29.0ms+47.8) within IO::Select::can_write which was called 461 times, avg 104ms/call: # 461 times (29.0ms+47.8s) by IO::Socket::connect at line 120 of IO/Socket.pm, avg 104ms/call
{
1124612.22ms my $vec = shift;
1134612.04ms my $timeout = shift;
1144612.34ms my $w = $vec->[VEC_BITS];
115
11646147.8s92247.8s defined($w) && (select(undef,$w,undef,$timeout) > 0)
# spent 47.8s making 461 calls to IO::Select::CORE:sselect, avg 104ms/call # spent 55.1ms making 461 calls to IO::Select::handles, avg 120µs/call
117 ? handles($vec, $w)
118 : ();
119}
120
121sub has_exception
122{
123 my $vec = shift;
124 my $timeout = shift;
125 my $e = $vec->[VEC_BITS];
126
127 defined($e) && (select(undef,undef,$e,$timeout) > 0)
128 ? handles($vec, $e)
129 : ();
130}
131
132sub has_error
133{
134 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
135 if warnings::enabled();
136 goto &has_exception;
137}
138
139sub count
140{
141 my $vec = shift;
142 $vec->[FD_COUNT];
143}
144
145sub bits
146{
147 my $vec = shift;
148 $vec->[VEC_BITS];
149}
150
151sub as_string # for debugging
152{
153 my $vec = shift;
154 my $str = ref($vec) . ": ";
155 my $bits = $vec->bits;
156 my $count = $vec->count;
157 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
158 $str .= " $count";
159 my @handles = @$vec;
160 splice(@handles, 0, FIRST_FD);
161 for (@handles) {
162 $str .= " " . (defined($_) ? "$_" : "-");
163 }
164 $str;
165}
166
167sub _max
168{
169 my($a,$b,$c) = @_;
170 $a > $b
171 ? $a > $c
172 ? $a
173 : $c
174 : $b > $c
175 ? $b
176 : $c;
177}
178
179sub select
180{
181 shift
182 if defined $_[0] && !ref($_[0]);
183
184 my($r,$w,$e,$t) = @_;
185 my @result = ();
186
187 my $rb = defined $r ? $r->[VEC_BITS] : undef;
188 my $wb = defined $w ? $w->[VEC_BITS] : undef;
189 my $eb = defined $e ? $e->[VEC_BITS] : undef;
190
191 if(select($rb,$wb,$eb,$t) > 0)
192 {
193 my @r = ();
194 my @w = ();
195 my @e = ();
196 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
197 defined $w ? scalar(@$w)-1 : 0,
198 defined $e ? scalar(@$e)-1 : 0);
199
200 for( ; $i >= FIRST_FD ; $i--)
201 {
202 my $j = $i - FIRST_FD;
203 push(@r, $r->[$i])
204 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
205 push(@w, $w->[$i])
206 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
207 push(@e, $e->[$i])
208 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
209 }
210
211 @result = (\@r, \@w, \@e);
212 }
213 @result;
214}
215
216
217sub handles
218
# spent 55.1ms within IO::Select::handles which was called 461 times, avg 120µs/call: # 461 times (55.1ms+0s) by IO::Select::can_write at line 116, avg 120µs/call
{
2194612.95ms my $vec = shift;
2204612.33ms my $bits = shift;
2214612.78ms my @h = ();
2224611.98ms my $i;
2234612.81ms my $max = scalar(@$vec) - 1;
224
22546116.4ms for ($i = FIRST_FD; $i <= $max; $i++)
226 {
227184410.1ms next unless defined $vec->[$i];
2284614.26ms push(@h, $vec->[$i])
229 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
2304612.03ms }
231
2324618.17ms @h;
233}
234
235115µs1;
236__END__
237
238=head1 NAME
239
240IO::Select - OO interface to the select system call
241
242=head1 SYNOPSIS
243
244 use IO::Select;
245
246 $s = IO::Select->new();
247
248 $s->add(\*STDIN);
249 $s->add($some_handle);
250
251 @ready = $s->can_read($timeout);
252
253 @ready = IO::Select->new(@handles)->can_read(0);
254
255=head1 DESCRIPTION
256
257The C<IO::Select> package implements an object approach to the system C<select>
258function call. It allows the user to see what IO handles, see L<IO::Handle>,
259are ready for reading, writing or have an exception pending.
260
261=head1 CONSTRUCTOR
262
263=over 4
264
265=item new ( [ HANDLES ] )
266
267The constructor creates a new object and optionally initialises it with a set
268of handles.
269
270=back
271
272=head1 METHODS
273
274=over 4
275
276=item add ( HANDLES )
277
278Add the list of handles to the C<IO::Select> object. It is these values that
279will be returned when an event occurs. C<IO::Select> keeps these values in a
280cache which is indexed by the C<fileno> of the handle, so if more than one
281handle with the same C<fileno> is specified then only the last one is cached.
282
283Each handle can be an C<IO::Handle> object, an integer or an array
284reference where the first element is an C<IO::Handle> or an integer.
285
286=item remove ( HANDLES )
287
288Remove all the given handles from the object. This method also works
289by the C<fileno> of the handles. So the exact handles that were added
290need not be passed, just handles that have an equivalent C<fileno>
291
292=item exists ( HANDLE )
293
294Returns a true value (actually the handle itself) if it is present.
295Returns undef otherwise.
296
297=item handles
298
299Return an array of all registered handles.
300
301=item can_read ( [ TIMEOUT ] )
302
303Return an array of handles that are ready for reading. C<TIMEOUT> is
304the maximum amount of time to wait before returning an empty list, in
305seconds, possibly fractional. If C<TIMEOUT> is not given and any
306handles are registered then the call will block.
307
308=item can_write ( [ TIMEOUT ] )
309
310Same as C<can_read> except check for handles that can be written to.
311
312=item has_exception ( [ TIMEOUT ] )
313
314Same as C<can_read> except check for handles that have an exception
315condition, for example pending out-of-band data.
316
317=item count ()
318
319Returns the number of handles that the object will check for when
320one of the C<can_> methods is called or the object is passed to
321the C<select> static method.
322
323=item bits()
324
325Return the bit string suitable as argument to the core select() call.
326
327=item select ( READ, WRITE, EXCEPTION [, TIMEOUT ] )
328
329C<select> is a static method, that is you call it with the package name
330like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
331C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
332for the core select call.
333
334The result will be an array of 3 elements, each a reference to an array
335which will hold the handles that are ready for reading, writing and have
336exceptions respectively. Upon error an empty list is returned.
337
338=back
339
340=head1 EXAMPLE
341
342Here is a short example which shows how C<IO::Select> could be used
343to write a server which communicates with several sockets while also
344listening for more connections on a listen socket
345
346 use IO::Select;
347 use IO::Socket;
348
349 $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
350 $sel = new IO::Select( $lsn );
351
352 while(@ready = $sel->can_read) {
353 foreach $fh (@ready) {
354 if($fh == $lsn) {
355 # Create a new socket
356 $new = $lsn->accept;
357 $sel->add($new);
358 }
359 else {
360 # Process socket
361
362 # Maybe we have finished with the socket
363 $sel->remove($fh);
364 $fh->close;
365 }
366 }
367 }
368
369=head1 AUTHOR
370
371Graham Barr. Currently maintained by the Perl Porters. Please report all
372bugs to <perl5-porters@perl.org>.
373
374=head1 COPYRIGHT
375
376Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
377This program is free software; you can redistribute it and/or
378modify it under the same terms as Perl itself.
379
380=cut
381
# spent 8.70ms within IO::Select::CORE:match which was called 461 times, avg 19µs/call: # 461 times (8.70ms+0s) by IO::Select::_fileno at line 61 of IO/Select.pm, avg 19µs/call
sub IO::Select::CORE:match; # xsub
# spent 47.8s within IO::Select::CORE:sselect which was called 461 times, avg 104ms/call: # 461 times (47.8s+0s) by IO::Select::can_write at line 116 of IO/Select.pm, avg 104ms/call
sub IO::Select::CORE:sselect; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.