← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/home/hejohns/perl5/lib/perl5/x86_64-linux-gnu-thread-multi/IO/Select.pm
StatementsExecuted 8 statements in 779µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118µs10µsIO::Select::::BEGIN@9IO::Select::BEGIN@9
1115µs24µsIO::Select::::BEGIN@10IO::Select::BEGIN@10
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
9218µs211µs
# spent 10µs (8+1) within IO::Select::BEGIN@9 which was called: # once (8µs+1µs) by IPC::Cmd::BEGIN@5 at line 9
use strict;
# spent 10µs making 1 call to IO::Select::BEGIN@9 # spent 1µs making 1 call to strict::import
102750µs243µs
# spent 24µs (5+19) within IO::Select::BEGIN@10 which was called: # once (5µs+19µs) by IPC::Cmd::BEGIN@5 at line 10
use warnings::register;
# spent 24µs making 1 call to IO::Select::BEGIN@10 # spent 19µs making 1 call to warnings::register::import
111300nsrequire Exporter;
12
131200nsour $VERSION = "1.49";
14
1517µsour @ISA = qw(Exporter); # This is only so we can do version checking
16
17sub VEC_BITS () {0}
18sub FD_COUNT () {1}
19sub FIRST_FD () {2}
20
21sub new
22{
23 my $self = shift;
24 my $type = ref($self) || $self;
25
26 my $vec = bless [undef,0], $type;
27
28 $vec->add(@_)
29 if @_;
30
31 $vec;
32}
33
34sub add
35{
36 shift->_update('add', @_);
37}
38
39
40sub remove
41{
42 shift->_update('remove', @_);
43}
44
45
46sub exists
47{
48 my $vec = shift;
49 my $fno = $vec->_fileno(shift);
50 return undef unless defined $fno;
51 $vec->[$fno + FIRST_FD];
52}
53
54
55sub _fileno
56{
57 my($self, $f) = @_;
58 return unless defined $f;
59 $f = $f->[0] if ref($f) eq 'ARRAY';
60 if($f =~ /^[0-9]+$/) { # plain file number
61 return $f;
62 }
63 elsif(defined(my $fd = fileno($f))) {
64 return $fd;
65 }
66 else {
67 # Neither a plain file number nor an opened filehandle; but maybe it was
68 # previously registered and has since been closed. ->remove still wants to
69 # know what fileno it had
70 foreach my $i ( FIRST_FD .. $#$self ) {
71 return $i - FIRST_FD if defined $self->[$i] && $self->[$i] == $f;
72 }
73 return undef;
74 }
75}
76
77sub _update
78{
79 my $vec = shift;
80 my $add = shift eq 'add';
81
82 my $bits = $vec->[VEC_BITS];
83 $bits = '' unless defined $bits;
84
85 my $count = 0;
86 my $f;
87 foreach $f (@_)
88 {
89 my $fn = $vec->_fileno($f);
90 if ($add) {
91 next unless defined $fn;
92 my $i = $fn + FIRST_FD;
93 if (defined $vec->[$i]) {
94 $vec->[$i] = $f; # if array rest might be different, so we update
95 next;
96 }
97 $vec->[FD_COUNT]++;
98 vec($bits, $fn, 1) = 1;
99 $vec->[$i] = $f;
100 } else { # remove
101 if ( ! defined $fn ) { # remove if fileno undef'd
102 $fn = 0;
103 for my $fe (@{$vec}[FIRST_FD .. $#$vec]) {
104 if (defined($fe) && $fe == $f) {
105 $vec->[FD_COUNT]--;
106 $fe = undef;
107 vec($bits, $fn, 1) = 0;
108 last;
109 }
110 ++$fn;
111 }
112 }
113 else {
114 my $i = $fn + FIRST_FD;
115 next unless defined $vec->[$i];
116 $vec->[FD_COUNT]--;
117 vec($bits, $fn, 1) = 0;
118 $vec->[$i] = undef;
119 }
120 }
121 $count++;
122 }
123 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
124 $count;
125}
126
127sub can_read
128{
129 my $vec = shift;
130 my $timeout = shift;
131 my $r = $vec->[VEC_BITS];
132
133 defined($r) && (select($r,undef,undef,$timeout) > 0)
134 ? handles($vec, $r)
135 : ();
136}
137
138sub can_write
139{
140 my $vec = shift;
141 my $timeout = shift;
142 my $w = $vec->[VEC_BITS];
143
144 defined($w) && (select(undef,$w,undef,$timeout) > 0)
145 ? handles($vec, $w)
146 : ();
147}
148
149sub has_exception
150{
151 my $vec = shift;
152 my $timeout = shift;
153 my $e = $vec->[VEC_BITS];
154
155 defined($e) && (select(undef,undef,$e,$timeout) > 0)
156 ? handles($vec, $e)
157 : ();
158}
159
160sub has_error
161{
162 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
163 if warnings::enabled();
164 goto &has_exception;
165}
166
167sub count
168{
169 my $vec = shift;
170 $vec->[FD_COUNT];
171}
172
173sub bits
174{
175 my $vec = shift;
176 $vec->[VEC_BITS];
177}
178
179sub as_string # for debugging
180{
181 my $vec = shift;
182 my $str = ref($vec) . ": ";
183 my $bits = $vec->bits;
184 my $count = $vec->count;
185 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
186 $str .= " $count";
187 my @handles = @$vec;
188 splice(@handles, 0, FIRST_FD);
189 for (@handles) {
190 $str .= " " . (defined($_) ? "$_" : "-");
191 }
192 $str;
193}
194
195sub _max
196{
197 my($a,$b,$c) = @_;
198 $a > $b
199 ? $a > $c
200 ? $a
201 : $c
202 : $b > $c
203 ? $b
204 : $c;
205}
206
207sub select
208{
209 shift
210 if defined $_[0] && !ref($_[0]);
211
212 my($r,$w,$e,$t) = @_;
213 my @result = ();
214
215 my $rb = defined $r ? $r->[VEC_BITS] : undef;
216 my $wb = defined $w ? $w->[VEC_BITS] : undef;
217 my $eb = defined $e ? $e->[VEC_BITS] : undef;
218
219 if(select($rb,$wb,$eb,$t) > 0)
220 {
221 my @r = ();
222 my @w = ();
223 my @e = ();
224 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
225 defined $w ? scalar(@$w)-1 : 0,
226 defined $e ? scalar(@$e)-1 : 0);
227
228 for( ; $i >= FIRST_FD ; $i--)
229 {
230 my $j = $i - FIRST_FD;
231 push(@r, $r->[$i])
232 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
233 push(@w, $w->[$i])
234 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
235 push(@e, $e->[$i])
236 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
237 }
238
239 @result = (\@r, \@w, \@e);
240 }
241 @result;
242}
243
244
245sub handles
246{
247 my $vec = shift;
248 my $bits = shift;
249 my @h = ();
250 my $i;
251 my $max = scalar(@$vec) - 1;
252
253 for ($i = FIRST_FD; $i <= $max; $i++)
254 {
255 next unless defined $vec->[$i];
256 push(@h, $vec->[$i])
257 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
258 }
259
260 @h;
261}
262
26313µs1;
264__END__
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.