← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:36 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/IO/Select.pm
StatementsExecuted 13 statements in 874µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11113µs17µsIO::Select::::BEGIN@9IO::Select::BEGIN@9
1119µs79µsIO::Select::::BEGIN@10IO::Select::BEGIN@10
1118µs45µsIO::Select::::BEGIN@11IO::Select::BEGIN@11
0000s0sIO::Select::::_filenoIO::Select::_fileno
0000s0sIO::Select::::_maxIO::Select::_max
0000s0sIO::Select::::_updateIO::Select::_update
0000s0sIO::Select::::addIO::Select::add
0000s0sIO::Select::::as_stringIO::Select::as_string
0000s0sIO::Select::::bitsIO::Select::bits
0000s0sIO::Select::::can_readIO::Select::can_read
0000s0sIO::Select::::can_writeIO::Select::can_write
0000s0sIO::Select::::countIO::Select::count
0000s0sIO::Select::::existsIO::Select::exists
0000s0sIO::Select::::handlesIO::Select::handles
0000s0sIO::Select::::has_errorIO::Select::has_error
0000s0sIO::Select::::has_exceptionIO::Select::has_exception
0000s0sIO::Select::::newIO::Select::new
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
9319µs221µs
# spent 17µs (13+4) within IO::Select::BEGIN@9 which was called: # once (13µs+4µs) by Net::SSH::BEGIN@8 at line 9
use strict;
# spent 17µs making 1 call to IO::Select::BEGIN@9 # spent 4µs making 1 call to strict::import
10322µs2149µs
# spent 79µs (9+70) within IO::Select::BEGIN@10 which was called: # once (9µs+70µs) by Net::SSH::BEGIN@8 at line 10
use warnings::register;
# spent 79µs making 1 call to IO::Select::BEGIN@10 # spent 70µs making 1 call to warnings::register::import
113823µs283µs
# spent 45µs (8+38) within IO::Select::BEGIN@11 which was called: # once (8µs+38µs) by Net::SSH::BEGIN@8 at line 11
use vars qw($VERSION @ISA);
# spent 45µs making 1 call to IO::Select::BEGIN@11 # spent 38µs making 1 call to vars::import
121500nsrequire Exporter;
13
141400ns$VERSION = "1.17";
15
1616µ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{
24 my $self = shift;
25 my $type = ref($self) || $self;
26
27 my $vec = bless [undef,0], $type;
28
29 $vec->add(@_)
30 if @_;
31
32 $vec;
33}
34
35sub add
36{
37 shift->_update('add', @_);
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{
58 my($self, $f) = @_;
59 return unless defined $f;
60 $f = $f->[0] if ref($f) eq 'ARRAY';
61 ($f =~ /^\d+$/) ? $f : fileno($f);
62}
63
64sub _update
65{
66 my $vec = shift;
67 my $add = shift eq 'add';
68
69 my $bits = $vec->[VEC_BITS];
70 $bits = '' unless defined $bits;
71
72 my $count = 0;
73 my $f;
74 foreach $f (@_)
75 {
76 my $fn = $vec->_fileno($f);
77 next unless defined $fn;
78 my $i = $fn + FIRST_FD;
79 if ($add) {
80 if (defined $vec->[$i]) {
81 $vec->[$i] = $f; # if array rest might be different, so we update
82 next;
83 }
84 $vec->[FD_COUNT]++;
85 vec($bits, $fn, 1) = 1;
86 $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 }
93 $count++;
94 }
95 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
96 $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{
112 my $vec = shift;
113 my $timeout = shift;
114 my $w = $vec->[VEC_BITS];
115
116 defined($w) && (select(undef,$w,undef,$timeout) > 0)
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{
219 my $vec = shift;
220 my $bits = shift;
221 my @h = ();
222 my $i;
223 my $max = scalar(@$vec) - 1;
224
225 for ($i = FIRST_FD; $i <= $max; $i++)
226 {
227 next unless defined $vec->[$i];
228 push(@h, $vec->[$i])
229 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
230 }
231
232 @h;
233}
234
23513µs1;
236__END__