← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:07 2013

Filename/usr/lib/perl/5.10/IO/Select.pm
StatementsExecuted 13 statements in 1.94ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11139µs50µsIO::Select::::BEGIN@9IO::Select::BEGIN@9
11122µs127µsIO::Select::::BEGIN@10IO::Select::BEGIN@10
11116µs119µ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
9361µs260µs
# spent 50µs (39+11) within IO::Select::BEGIN@9 which was called: # once (39µs+11µs) by Net::LDAP::BEGIN@9 at line 9
use strict;
# spent 50µs making 1 call to IO::Select::BEGIN@9 # spent 11µs making 1 call to strict::import
10351µs2233µs
# spent 127µs (22+106) within IO::Select::BEGIN@10 which was called: # once (22µs+106µs) by Net::LDAP::BEGIN@9 at line 10
use warnings::register;
# spent 127µs making 1 call to IO::Select::BEGIN@10 # spent 106µs making 1 call to warnings::register::import
1131.79ms2222µs
# spent 119µs (16+103) within IO::Select::BEGIN@11 which was called: # once (16µs+103µs) by Net::LDAP::BEGIN@9 at line 11
use vars qw($VERSION @ISA);
# spent 119µs making 1 call to IO::Select::BEGIN@11 # spent 103µs making 1 call to vars::import
1213µsrequire Exporter;
13
1412µs$VERSION = "1.17";
15
16119µ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
40sub remove
41{
42 shift->_update('remove', @_);
43}
44
45sub exists
46{
47 my $vec = shift;
48 my $fno = $vec->_fileno(shift);
49 return undef unless defined $fno;
50 $vec->[$fno + FIRST_FD];
51}
52
53sub _fileno
54{
55 my($self, $f) = @_;
56 return unless defined $f;
57 $f = $f->[0] if ref($f) eq 'ARRAY';
58 ($f =~ /^\d+$/) ? $f : fileno($f);
59}
60
61sub _update
62{
63 my $vec = shift;
64 my $add = shift eq 'add';
65
66 my $bits = $vec->[VEC_BITS];
67 $bits = '' unless defined $bits;
68
69 my $count = 0;
70 my $f;
71 foreach $f (@_)
72 {
73 my $fn = $vec->_fileno($f);
74 next unless defined $fn;
75 my $i = $fn + FIRST_FD;
76 if ($add) {
77 if (defined $vec->[$i]) {
78 $vec->[$i] = $f; # if array rest might be different, so we update
79 next;
80 }
81 $vec->[FD_COUNT]++;
82 vec($bits, $fn, 1) = 1;
83 $vec->[$i] = $f;
84 } else { # remove
85 next unless defined $vec->[$i];
86 $vec->[FD_COUNT]--;
87 vec($bits, $fn, 1) = 0;
88 $vec->[$i] = undef;
89 }
90 $count++;
91 }
92 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
93 $count;
94}
95
96sub can_read
97{
98 my $vec = shift;
99 my $timeout = shift;
100 my $r = $vec->[VEC_BITS];
101
102 defined($r) && (select($r,undef,undef,$timeout) > 0)
103 ? handles($vec, $r)
104 : ();
105}
106
107sub can_write
108{
109 my $vec = shift;
110 my $timeout = shift;
111 my $w = $vec->[VEC_BITS];
112
113 defined($w) && (select(undef,$w,undef,$timeout) > 0)
114 ? handles($vec, $w)
115 : ();
116}
117
118sub has_exception
119{
120 my $vec = shift;
121 my $timeout = shift;
122 my $e = $vec->[VEC_BITS];
123
124 defined($e) && (select(undef,undef,$e,$timeout) > 0)
125 ? handles($vec, $e)
126 : ();
127}
128
129sub has_error
130{
131 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
132 if warnings::enabled();
133 goto &has_exception;
134}
135
136sub count
137{
138 my $vec = shift;
139 $vec->[FD_COUNT];
140}
141
142sub bits
143{
144 my $vec = shift;
145 $vec->[VEC_BITS];
146}
147
148sub as_string # for debugging
149{
150 my $vec = shift;
151 my $str = ref($vec) . ": ";
152 my $bits = $vec->bits;
153 my $count = $vec->count;
154 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
155 $str .= " $count";
156 my @handles = @$vec;
157 splice(@handles, 0, FIRST_FD);
158 for (@handles) {
159 $str .= " " . (defined($_) ? "$_" : "-");
160 }
161 $str;
162}
163
164sub _max
165{
166 my($a,$b,$c) = @_;
167 $a > $b
168 ? $a > $c
169 ? $a
170 : $c
171 : $b > $c
172 ? $b
173 : $c;
174}
175
176sub select
177{
178 shift
179 if defined $_[0] && !ref($_[0]);
180
181 my($r,$w,$e,$t) = @_;
182 my @result = ();
183
184 my $rb = defined $r ? $r->[VEC_BITS] : undef;
185 my $wb = defined $w ? $w->[VEC_BITS] : undef;
186 my $eb = defined $e ? $e->[VEC_BITS] : undef;
187
188 if(select($rb,$wb,$eb,$t) > 0)
189 {
190 my @r = ();
191 my @w = ();
192 my @e = ();
193 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
194 defined $w ? scalar(@$w)-1 : 0,
195 defined $e ? scalar(@$e)-1 : 0);
196
197 for( ; $i >= FIRST_FD ; $i--)
198 {
199 my $j = $i - FIRST_FD;
200 push(@r, $r->[$i])
201 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
202 push(@w, $w->[$i])
203 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
204 push(@e, $e->[$i])
205 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
206 }
207
208 @result = (\@r, \@w, \@e);
209 }
210 @result;
211}
212
213sub handles
214{
215 my $vec = shift;
216 my $bits = shift;
217 my @h = ();
218 my $i;
219 my $max = scalar(@$vec) - 1;
220
221 for ($i = FIRST_FD; $i <= $max; $i++)
222 {
223 next unless defined $vec->[$i];
224 push(@h, $vec->[$i])
225 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
226 }
227
228 @h;
229}
230
23119µs1;
232__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.