← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:19 2017

Filename/usr/local/lib/perl5/5.24/mach/IO/Select.pm
StatementsExecuted 10 statements in 2.75ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11155µs785µsIO::Select::::BEGIN@10IO::Select::BEGIN@10
11147µs54µsIO::Select::::BEGIN@9IO::Select::BEGIN@9
11119µs135µ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
92104µs261µs
# spent 54µs (47+7) within IO::Select::BEGIN@9 which was called: # once (47µs+7µs) by Net::DNS::Resolver::Base::BEGIN@53 at line 9
use strict;
# spent 54µs making 1 call to IO::Select::BEGIN@9 # spent 7µs making 1 call to strict::import
10286µs21.52ms
# spent 785µs (55+730) within IO::Select::BEGIN@10 which was called: # once (55µs+730µs) by Net::DNS::Resolver::Base::BEGIN@53 at line 10
use warnings::register;
# spent 785µs making 1 call to IO::Select::BEGIN@10 # spent 730µs making 1 call to warnings::register::import
1122.53ms2251µs
# spent 135µs (19+116) within IO::Select::BEGIN@11 which was called: # once (19µs+116µs) by Net::DNS::Resolver::Base::BEGIN@53 at line 11
use vars qw($VERSION @ISA);
# spent 135µs making 1 call to IO::Select::BEGIN@11 # spent 116µs making 1 call to vars::import
1213µsrequire Exporter;
13
1412µs$VERSION = "1.22";
15
16115µ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 if ($add) {
78 next unless defined $fn;
79 my $i = $fn + FIRST_FD;
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 if ( ! defined $fn ) { # remove if fileno undef'd
89 $fn = 0;
90 for my $fe (@{$vec}[FIRST_FD .. $#$vec]) {
91 if (defined($fe) && $fe == $f) {
92 $vec->[FD_COUNT]--;
93 $fe = undef;
94 vec($bits, $fn, 1) = 0;
95 last;
96 }
97 ++$fn;
98 }
99 }
100 else {
101 my $i = $fn + FIRST_FD;
102 next unless defined $vec->[$i];
103 $vec->[FD_COUNT]--;
104 vec($bits, $fn, 1) = 0;
105 $vec->[$i] = undef;
106 }
107 }
108 $count++;
109 }
110 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
111 $count;
112}
113
114sub can_read
115{
116 my $vec = shift;
117 my $timeout = shift;
118 my $r = $vec->[VEC_BITS];
119
120 defined($r) && (select($r,undef,undef,$timeout) > 0)
121 ? handles($vec, $r)
122 : ();
123}
124
125sub can_write
126{
127 my $vec = shift;
128 my $timeout = shift;
129 my $w = $vec->[VEC_BITS];
130
131 defined($w) && (select(undef,$w,undef,$timeout) > 0)
132 ? handles($vec, $w)
133 : ();
134}
135
136sub has_exception
137{
138 my $vec = shift;
139 my $timeout = shift;
140 my $e = $vec->[VEC_BITS];
141
142 defined($e) && (select(undef,undef,$e,$timeout) > 0)
143 ? handles($vec, $e)
144 : ();
145}
146
147sub has_error
148{
149 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
150 if warnings::enabled();
151 goto &has_exception;
152}
153
154sub count
155{
156 my $vec = shift;
157 $vec->[FD_COUNT];
158}
159
160sub bits
161{
162 my $vec = shift;
163 $vec->[VEC_BITS];
164}
165
166sub as_string # for debugging
167{
168 my $vec = shift;
169 my $str = ref($vec) . ": ";
170 my $bits = $vec->bits;
171 my $count = $vec->count;
172 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
173 $str .= " $count";
174 my @handles = @$vec;
175 splice(@handles, 0, FIRST_FD);
176 for (@handles) {
177 $str .= " " . (defined($_) ? "$_" : "-");
178 }
179 $str;
180}
181
182sub _max
183{
184 my($a,$b,$c) = @_;
185 $a > $b
186 ? $a > $c
187 ? $a
188 : $c
189 : $b > $c
190 ? $b
191 : $c;
192}
193
194sub select
195{
196 shift
197 if defined $_[0] && !ref($_[0]);
198
199 my($r,$w,$e,$t) = @_;
200 my @result = ();
201
202 my $rb = defined $r ? $r->[VEC_BITS] : undef;
203 my $wb = defined $w ? $w->[VEC_BITS] : undef;
204 my $eb = defined $e ? $e->[VEC_BITS] : undef;
205
206 if(select($rb,$wb,$eb,$t) > 0)
207 {
208 my @r = ();
209 my @w = ();
210 my @e = ();
211 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
212 defined $w ? scalar(@$w)-1 : 0,
213 defined $e ? scalar(@$e)-1 : 0);
214
215 for( ; $i >= FIRST_FD ; $i--)
216 {
217 my $j = $i - FIRST_FD;
218 push(@r, $r->[$i])
219 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
220 push(@w, $w->[$i])
221 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
222 push(@e, $e->[$i])
223 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
224 }
225
226 @result = (\@r, \@w, \@e);
227 }
228 @result;
229}
230
231
232sub handles
233{
234 my $vec = shift;
235 my $bits = shift;
236 my @h = ();
237 my $i;
238 my $max = scalar(@$vec) - 1;
239
240 for ($i = FIRST_FD; $i <= $max; $i++)
241 {
242 next unless defined $vec->[$i];
243 push(@h, $vec->[$i])
244 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
245 }
246
247 @h;
248}
249
250110µs1;
251__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.