← 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 17:10:45 2013
Reported on Tue Oct 15 17:12:47 2013

Filename/usr/share/perl5/Convert/ASN1/IO.pm
StatementsExecuted 10 statements in 1.24ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11131µs41µsConvert::ASN1::::BEGIN@7.12Convert::ASN1::BEGIN@7.12
11128µs898µsConvert::ASN1::::BEGIN@8Convert::ASN1::BEGIN@8
11123µs27µsConvert::ASN1::::BEGIN@10.13Convert::ASN1::BEGIN@10.13
0000s0sConvert::ASN1::::asn_getConvert::ASN1::asn_get
0000s0sConvert::ASN1::::asn_readConvert::ASN1::asn_read
0000s0sConvert::ASN1::::asn_readyConvert::ASN1::asn_ready
0000s0sConvert::ASN1::::asn_recvConvert::ASN1::asn_recv
0000s0sConvert::ASN1::::asn_sendConvert::ASN1::asn_send
0000s0sConvert::ASN1::::asn_writeConvert::ASN1::asn_write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Copyright (c) 2000-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package Convert::ASN1;
6
7337µs250µs
# spent 41µs (31+10) within Convert::ASN1::BEGIN@7.12 which was called: # once (31µs+10µs) by Convert::ASN1::BEGIN@415 at line 7
use strict;
# spent 41µs making 1 call to Convert::ASN1::BEGIN@7.12 # spent 10µs making 1 call to strict::import
8368µs21.77ms
# spent 898µs (28+870) within Convert::ASN1::BEGIN@8 which was called: # once (28µs+870µs) by Convert::ASN1::BEGIN@415 at line 8
use Socket;
# spent 898µs making 1 call to Convert::ASN1::BEGIN@8 # spent 870µs making 1 call to Exporter::import
9
10
# spent 27µs (23+5) within Convert::ASN1::BEGIN@10.13 which was called: # once (23µs+5µs) by Convert::ASN1::BEGIN@415 at line 13
BEGIN {
1116µs local $SIG{__DIE__};
12210µs15µs eval { require bytes } and 'bytes'->import
# spent 5µs making 1 call to bytes::import
1311.11ms127µs}
# spent 27µs making 1 call to Convert::ASN1::BEGIN@10.13
14
15sub asn_recv { # $socket, $buffer, $flags
16
17 my $peer;
18 my $buf;
19 my $n = 128;
20 my $pos = 0;
21 my $depth = 0;
22 my $len = 0;
23 my($tmp,$tb,$lb);
24
25 MORE:
26 for(
27 $peer = recv($_[0],$buf,$n,MSG_PEEK);
28 defined $peer;
29 $peer = recv($_[0],$buf,$n<<=1,MSG_PEEK)
30 ) {
31
32 if ($depth) { # Are we searching of "\0\0"
33
34 unless (2+$pos <= length $buf) {
35 next MORE if $n == length $buf;
36 last MORE;
37 }
38
39 if(substr($buf,$pos,2) eq "\0\0") {
40 unless (--$depth) {
41 $len = $pos + 2;
42 last MORE;
43 }
44 }
45 }
46
47 # If we can decode a tag and length we can detemine the length
48 ($tb,$tmp) = asn_decode_tag(substr($buf,$pos));
49 unless ($tb || $pos+$tb < length $buf) {
50 next MORE if $n == length $buf;
51 last MORE;
52 }
53
54 if (ord(substr($buf,$pos+$tb,1)) == 0x80) {
55 # indefinite length, grrr!
56 $depth++;
57 $pos += $tb + 1;
58 redo MORE;
59 }
60
61 ($lb,$len) = asn_decode_length(substr($buf,$pos+$tb));
62
63 if ($lb) {
64 if ($depth) {
65 $pos += $tb + $lb + $len;
66 redo MORE;
67 }
68 else {
69 $len += $tb + $lb + $pos;
70 last MORE;
71 }
72 }
73 }
74
75 if (defined $peer) {
76 if ($len > length $buf) {
77 # Check we can read the whole element
78 goto error
79 unless defined($peer = recv($_[0],$buf,$len,MSG_PEEK));
80
81 if ($len > length $buf) {
82 # Cannot get whole element
83 $_[1]='';
84 return $peer;
85 }
86 }
87 elsif ($len == 0) {
88 $_[1] = '';
89 return $peer;
90 }
91
92 if ($_[2] & MSG_PEEK) {
93 $_[1] = substr($buf,0,$len);
94 }
95 elsif (!defined($peer = recv($_[0],$_[1],$len,0))) {
96 goto error;
97 }
98
99 return $peer;
100 }
101
102error:
103 $_[1] = undef;
104}
105
106sub asn_read { # $fh, $buffer, $offset
107
108 # We need to read one packet, and exactly only one packet.
109 # So we have to read the first few bytes one at a time, until
110 # we have enough to decode a tag and a length. We then know
111 # how many more bytes to read
112
113 if ($_[2]) {
114 if ($_[2] > length $_[1]) {
115 require Carp;
116 Carp::carp("Offset beyond end of buffer");
117 return;
118 }
119 substr($_[1],$_[2]) = '';
120 }
121 else {
122 $_[1] = '';
123 }
124
125 my $pos = 0;
126 my $need = 0;
127 my $depth = 0;
128 my $ch;
129 my $n;
130 my $e;
131
132
133 while(1) {
134 $need = ($pos + ($depth * 2)) || 2;
135
136 while(($n = $need - length $_[1]) > 0) {
137 $e = sysread($_[0],$_[1],$n,length $_[1]) or
138 goto READ_ERR;
139 }
140
141 my $tch = ord(substr($_[1],$pos++,1));
142 # Tag may be multi-byte
143 if(($tch & 0x1f) == 0x1f) {
144 my $ch;
145 do {
146 $need++;
147 while(($n = $need - length $_[1]) > 0) {
148 $e = sysread($_[0],$_[1],$n,length $_[1]) or
149 goto READ_ERR;
150 }
151 $ch = ord(substr($_[1],$pos++,1));
152 } while($ch & 0x80);
153 }
154
155 $need = $pos + 1;
156
157 while(($n = $need - length $_[1]) > 0) {
158 $e = sysread($_[0],$_[1],$n,length $_[1]) or
159 goto READ_ERR;
160 }
161
162 my $len = ord(substr($_[1],$pos++,1));
163
164 if($len & 0x80) {
165 unless ($len &= 0x7f) {
166 $depth++;
167 next;
168 }
169 $need = $pos + $len;
170
171 while(($n = $need - length $_[1]) > 0) {
172 $e = sysread($_[0],$_[1],$n,length $_[1]) or
173 goto READ_ERR;
174 }
175
176 $pos += $len + unpack("N", "\0" x (4 - $len) . substr($_[1],$pos,$len));
177 }
178 elsif (!$len && !$tch) {
179 die "Bad ASN PDU" unless $depth;
180 unless (--$depth) {
181 last;
182 }
183 }
184 else {
185 $pos += $len;
186 }
187
188 last unless $depth;
189 }
190
191 while(($n = $pos - length $_[1]) > 0) {
192 $e = sysread($_[0],$_[1],$n,length $_[1]) or
193 goto READ_ERR;
194 }
195
196 return length $_[1];
197
198READ_ERR:
199 $@ = defined($e) ? "Unexpected EOF" : "I/O Error $!"; # . CORE::unpack("H*",$_[1]);
200 return undef;
201}
202
203sub asn_send { # $sock, $buffer, $flags, $to
204
205 @_ == 4
206 ? send($_[0],$_[1],$_[2],$_[3])
207 : send($_[0],$_[1],$_[2]);
208}
209
210sub asn_write { # $sock, $buffer
211
212 syswrite($_[0],$_[1], length $_[1]);
213}
214
215sub asn_get { # $fh
216
217 my $fh = ref($_[0]) ? $_[0] : \($_[0]);
218 my $href = \%{*$fh};
219
220 $href->{'asn_buffer'} = '' unless exists $href->{'asn_buffer'};
221
222 my $need = delete $href->{'asn_need'} || 0;
223 while(1) {
224 next if $need;
225 my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or next;
226 my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or next;
227 $need = $tb + $lb + $len;
228 }
229 continue {
230 if ($need && $need <= length $href->{'asn_buffer'}) {
231 my $ret = substr($href->{'asn_buffer'},0,$need);
232 substr($href->{'asn_buffer'},0,$need) = '';
233 return $ret;
234 }
235
236 my $get = $need > 1024 ? $need : 1024;
237
238 sysread($_[0], $href->{'asn_buffer'}, $get, length $href->{'asn_buffer'})
239 or return undef;
240 }
241}
242
243sub asn_ready { # $fh
244
245 my $fh = ref($_[0]) ? $_[0] : \($_[0]);
246 my $href = \%{*$fh};
247
248 return 0 unless exists $href->{'asn_buffer'};
249
250 return $href->{'asn_need'} <= length $href->{'asn_buffer'}
251 if exists $href->{'asn_need'};
252
253 my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or return 0;
254 my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or return 0;
255
256 $href->{'asn_need'} = $tb + $lb + $len;
257
258 $href->{'asn_need'} <= length $href->{'asn_buffer'};
259}
260
26113µs1;
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.