← 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.pm
StatementsExecuted 481 statements in 4.35ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11112.0ms14.0msConvert::ASN1::::BEGIN@415Convert::ASN1::BEGIN@415
7411374µs374µsConvert::ASN1::::asn_tagConvert::ASN1::asn_tag
111268µs272µsConvert::ASN1::::BEGIN@16Convert::ASN1::BEGIN@16
10531252µs252µsConvert::ASN1::::asn_encode_tagConvert::ASN1::asn_encode_tag
11194µs94µsConvert::ASN1::::_internal_symsConvert::ASN1::_internal_syms
11143µs43µsConvert::ASN1::::BEGIN@9Convert::ASN1::BEGIN@9
11138µs71.1msConvert::ASN1::::prepareConvert::ASN1::prepare
11125µs31µsConvert::ASN1::::configureConvert::ASN1::configure
21125µs25µsConvert::ASN1::::findConvert::ASN1::find
11120µs51µsConvert::ASN1::::newConvert::ASN1::new
11115µs74µsConvert::ASN1::::BEGIN@14Convert::ASN1::BEGIN@14
11114µs44µsConvert::ASN1::::BEGIN@12Convert::ASN1::BEGIN@12
11113µs107µsConvert::ASN1::::BEGIN@11Convert::ASN1::BEGIN@11
11112µs33µsConvert::ASN1::::BEGIN@59Convert::ASN1::BEGIN@59
11111µs16µsConvert::ASN1::::BEGIN@10Convert::ASN1::BEGIN@10
11111µs24µsConvert::ASN1::::BEGIN@67Convert::ASN1::BEGIN@67
1115µs5µsConvert::ASN1::::CORE:matchConvert::ASN1::CORE:match (opcode)
1113µs3µsConvert::ASN1::::_pack_structConvert::ASN1::_pack_struct
0000s0sConvert::ASN1::::AUTOLOADConvert::ASN1::AUTOLOAD
0000s0sConvert::ASN1::::DESTROYConvert::ASN1::DESTROY
0000s0sConvert::ASN1::::__ANON__[:60]Convert::ASN1::__ANON__[:60]
0000s0sConvert::ASN1::::_unpack_structConvert::ASN1::_unpack_struct
0000s0sConvert::ASN1::::asn_decode_lengthConvert::ASN1::asn_decode_length
0000s0sConvert::ASN1::::asn_decode_tagConvert::ASN1::asn_decode_tag
0000s0sConvert::ASN1::::asn_decode_tag2Convert::ASN1::asn_decode_tag2
0000s0sConvert::ASN1::::asn_encode_lengthConvert::ASN1::asn_encode_length
0000s0sConvert::ASN1::::decodeConvert::ASN1::decode
0000s0sConvert::ASN1::::encodeConvert::ASN1::encode
0000s0sConvert::ASN1::::errorConvert::ASN1::error
0000s0sConvert::ASN1::::i2ospConvert::ASN1::i2osp
0000s0sConvert::ASN1::::num_lengthConvert::ASN1::num_length
0000s0sConvert::ASN1::::os2ipConvert::ASN1::os2ip
0000s0sConvert::ASN1::::prepare_fileConvert::ASN1::prepare_file
0000s0sConvert::ASN1::::registeroidConvert::ASN1::registeroid
0000s0sConvert::ASN1::::registertypeConvert::ASN1::registertype
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-2002 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
7# $Id: ASN1.pm,v 1.29 2003/10/08 14:29:17 gbarr Exp $
8
9358µs143µs
# spent 43µs within Convert::ASN1::BEGIN@9 which was called: # once (43µs+0s) by Net::LDAP::BEGIN@12 at line 9
use 5.004;
# spent 43µs making 1 call to Convert::ASN1::BEGIN@9
10332µs222µs
# spent 16µs (11+5) within Convert::ASN1::BEGIN@10 which was called: # once (11µs+5µs) by Net::LDAP::BEGIN@12 at line 10
use strict;
# spent 16µs making 1 call to Convert::ASN1::BEGIN@10 # spent 5µs making 1 call to strict::import
11331µs2201µs
# spent 107µs (13+94) within Convert::ASN1::BEGIN@11 which was called: # once (13µs+94µs) by Net::LDAP::BEGIN@12 at line 11
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @opParts @opName $AUTOLOAD);
# spent 107µs making 1 call to Convert::ASN1::BEGIN@11 # spent 94µs making 1 call to vars::import
12342µs273µs
# spent 44µs (14+30) within Convert::ASN1::BEGIN@12 which was called: # once (14µs+30µs) by Net::LDAP::BEGIN@12 at line 12
use Exporter;
# spent 44µs making 1 call to Convert::ASN1::BEGIN@12 # spent 30µs making 1 call to Exporter::import
13
143252µs2134µs
# spent 74µs (15+59) within Convert::ASN1::BEGIN@14 which was called: # once (15µs+59µs) by Net::LDAP::BEGIN@12 at line 14
use constant CHECK_UTF8 => $] > 5.007;
# spent 74µs making 1 call to Convert::ASN1::BEGIN@14 # spent 59µs making 1 call to constant::import
15
16
# spent 272µs (268+4) within Convert::ASN1::BEGIN@16 which was called: # once (268µs+4µs) by Net::LDAP::BEGIN@12 at line 63
BEGIN {
1716µs local $SIG{__DIE__};
1828µs14µs eval { require bytes and 'bytes'->import };
# spent 4µs making 1 call to bytes::import
19
201500ns if (CHECK_UTF8) {
211800ns require Encode;
2211µs require utf8;
23 }
24
25110µs @ISA = qw(Exporter);
261500ns $VERSION = "0.22";
27
28110µs %EXPORT_TAGS = (
29 io => [qw(asn_recv asn_send asn_read asn_write asn_get asn_ready)],
30
31 debug => [qw(asn_dump asn_hexdump)],
32
33 const => [qw(ASN_BOOLEAN ASN_INTEGER ASN_BIT_STR ASN_OCTET_STR
34 ASN_NULL ASN_OBJECT_ID ASN_REAL ASN_ENUMERATED
35 ASN_SEQUENCE ASN_SET ASN_PRINT_STR ASN_IA5_STR
36 ASN_UTC_TIME ASN_GENERAL_TIME ASN_RELATIVE_OID
37 ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
38 ASN_PRIMITIVE ASN_CONSTRUCTOR ASN_LONG_LEN ASN_EXTENSION_ID ASN_BIT)],
39
40 tag => [qw(asn_tag asn_decode_tag2 asn_decode_tag asn_encode_tag asn_decode_length asn_encode_length)]
41 );
42
43126µs @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
4412µs $EXPORT_TAGS{all} = \@EXPORT_OK;
45
4611µs @opParts = qw(
47 cTAG cTYPE cVAR cLOOP cOPT cCHILD cDEFINE
48 );
49
5012µs @opName = qw(
51 opUNKNOWN opBOOLEAN opINTEGER opBITSTR opSTRING opNULL opOBJID opREAL
52 opSEQUENCE opSET opUTIME opGTIME opUTF8 opANY opCHOICE opROID opBCD
53 );
54
5519µs foreach my $l (\@opParts, \@opName) {
562700ns my $i = 0;
5723µs foreach my $name (@$l) {
58246µs my $j = $i++;
59384µs254µs
# spent 33µs (12+21) within Convert::ASN1::BEGIN@59 which was called: # once (12µs+21µs) by Net::LDAP::BEGIN@12 at line 59
no strict 'refs';
# spent 33µs making 1 call to Convert::ASN1::BEGIN@59 # spent 21µs making 1 call to strict::unimport
60 *{__PACKAGE__ . '::' . $name} = sub () { $j }
6124178µs }
62 }
63159µs1272µs}
# spent 272µs making 1 call to Convert::ASN1::BEGIN@16
64
65
# spent 94µs within Convert::ASN1::_internal_syms which was called: # once (94µs+0s) by Convert::ASN1::parser::BEGIN@16 at line 16 of Convert/ASN1/parser.pm
sub _internal_syms {
6612µs my $pkg = caller;
6731.87ms237µs
# spent 24µs (11+13) within Convert::ASN1::BEGIN@67 which was called: # once (11µs+13µs) by Net::LDAP::BEGIN@12 at line 67
no strict 'refs';
# spent 24µs making 1 call to Convert::ASN1::BEGIN@67 # spent 13µs making 1 call to strict::unimport
6819µs for my $sub (@opParts,@opName,'dump_op') {
692587µs *{$pkg . '::' . $sub} = \&{__PACKAGE__ . '::' . $sub};
70 }
71}
72
73sub ASN_BOOLEAN () { 0x01 }
74sub ASN_INTEGER () { 0x02 }
75sub ASN_BIT_STR () { 0x03 }
76sub ASN_OCTET_STR () { 0x04 }
77sub ASN_NULL () { 0x05 }
78sub ASN_OBJECT_ID () { 0x06 }
79sub ASN_REAL () { 0x09 }
80sub ASN_ENUMERATED () { 0x0A }
81sub ASN_RELATIVE_OID () { 0x0D }
82sub ASN_SEQUENCE () { 0x10 }
83sub ASN_SET () { 0x11 }
84sub ASN_PRINT_STR () { 0x13 }
85sub ASN_IA5_STR () { 0x16 }
86sub ASN_UTC_TIME () { 0x17 }
87sub ASN_GENERAL_TIME () { 0x18 }
88
89sub ASN_UNIVERSAL () { 0x00 }
90sub ASN_APPLICATION () { 0x40 }
91sub ASN_CONTEXT () { 0x80 }
92sub ASN_PRIVATE () { 0xC0 }
93
94sub ASN_PRIMITIVE () { 0x00 }
95sub ASN_CONSTRUCTOR () { 0x20 }
96
97sub ASN_LONG_LEN () { 0x80 }
98sub ASN_EXTENSION_ID () { 0x1F }
99sub ASN_BIT () { 0x80 }
100
101
102
# spent 51µs (20+31) within Convert::ASN1::new which was called: # once (20µs+31µs) by Net::LDAP::Message::BEGIN@8 at line 8 of Net/LDAP/ASN.pm
sub new {
10312µs my $pkg = shift;
10419µs my $self = bless {}, $pkg;
105
10614µs131µs $self->configure(@_);
# spent 31µs making 1 call to Convert::ASN1::configure
10714µs $self;
108}
109
110
111
# spent 31µs (25+5) within Convert::ASN1::configure which was called: # once (25µs+5µs) by Convert::ASN1::new at line 106
sub configure {
11211µs my $self = shift;
11311µs my %opt = @_;
114
11514µs $self->{options}{encoding} = uc($opt{encoding} || 'BER');
116
117117µs15µs unless ($self->{options}{encoding} =~ /^[BD]ER$/) {
# spent 5µs making 1 call to Convert::ASN1::CORE:match
118 require Carp;
119 Carp::croak("Unsupported encoding format '$opt{encoding}'");
120 }
121
12217µs for my $type (qw(encode decode)) {
12322µs if (exists $opt{$type}) {
124 while(my($what,$value) = each %{$opt{$type}}) {
125 $self->{options}{"${type}_${what}"} = $value;
126 }
127 }
128 }
129}
130
- -
133
# spent 25µs within Convert::ASN1::find which was called 2 times, avg 13µs/call: # 2 times (25µs+0s) by Net::LDAP::ASN::import at line 15 of Net/LDAP/ASN.pm, avg 13µs/call
sub find {
1342900ns my $self = shift;
13521µs my $what = shift;
13622µs return unless exists $self->{tree}{$what};
137211µs my %new = %$self;
13823µs $new{script} = $new{tree}->{$what};
139212µs bless \%new, ref($self);
140}
141
142
143
# spent 71.1ms (38µs+71.0) within Convert::ASN1::prepare which was called: # once (38µs+71.0ms) by Net::LDAP::Message::BEGIN@8 at line 22 of Net/LDAP/ASN.pm
sub prepare {
1441800ns my $self = shift;
14514µs my $asn = shift;
146
1471800ns $self = $self->new unless ref($self);
1481200ns my $tree;
14911µs if( ref($asn) eq 'GLOB' ){
150 local $/ = undef;
151 my $txt = <$asn>;
152 $tree = Convert::ASN1::parser::parse($txt);
153 } else {
15413µs171.0ms $tree = Convert::ASN1::parser::parse($asn);
# spent 71.0ms making 1 call to Convert::ASN1::parser::parse
155 }
156
1571600ns unless ($tree) {
158 $self->{error} = $@;
159 return;
160 ### If $self has been set to a new object, not returning
161 ### this object here will destroy the object, so the caller
162 ### won't be able to get at the error.
163 }
164
16516µs13µs $self->{tree} = _pack_struct($tree);
# spent 3µs making 1 call to Convert::ASN1::_pack_struct
16617µs $self->{script} = (values %$tree)[0];
16716µs $self;
168}
169
170sub prepare_file {
171 my $self = shift;
172 my $asnp = shift;
173
174 local *ASN;
175 open( ASN, $asnp )
176 or do{ $self->{error} = $@; return; };
177 my $ret = $self->prepare( \*ASN );
178 close( ASN );
179 $ret;
180}
181
182sub registeroid {
183 my $self = shift;
184 my $oid = shift;
185 my $handler = shift;
186
187 $self->{options}{oidtable}{$oid}=$handler;
188 $self->{oidtable}{$oid}=$handler;
189}
190
191sub registertype {
192 my $self = shift;
193 my $def = shift;
194 my $type = shift;
195 my $handler = shift;
196
197 $self->{options}{handlers}{$def}{$type}=$handler;
198}
199
200# In XS the will convert the tree between perl and C structs
201
202112µs
# spent 3µs within Convert::ASN1::_pack_struct which was called: # once (3µs+0s) by Convert::ASN1::prepare at line 165
sub _pack_struct { $_[0] }
203sub _unpack_struct { $_[0] }
204
205##
206## Encoding
207##
208
209sub encode {
210 my $self = shift;
211 my $stash = @_ == 1 ? shift : { @_ };
212 my $buf = '';
213 local $SIG{__DIE__};
214 eval { _encode($self->{options}, $self->{script}, $stash, [], $buf) }
215 or do { $self->{error} = $@; undef }
216}
217
- -
220# Encode tag value for encoding.
221# We assume that the tag has been correctly generated with asn_tag()
222
223
# spent 252µs within Convert::ASN1::asn_encode_tag which was called 105 times, avg 2µs/call: # 45 times (90µs+0s) by Convert::ASN1::parser::compile_one at line 679 of Convert/ASN1/parser.pm, avg 2µs/call # 31 times (58µs+0s) by Convert::ASN1::BEGIN@415 at line 21 of Convert/ASN1/parser.pm, avg 2µs/call # 29 times (105µs+0s) by Convert::ASN1::parser::compile_one at line 664 of Convert/ASN1/parser.pm, avg 4µs/call
sub asn_encode_tag {
224105355µs $_[0] >> 8
225 ? $_[0] & 0x8000
226 ? $_[0] & 0x800000
227 ? pack("V",$_[0])
228 : substr(pack("V",$_[0]),0,3)
229 : pack("v", $_[0])
230 : chr($_[0]);
231}
232
233
234# Encode a length. If < 0x80 then encode as a byte. Otherwise encode
235# 0x80 | num_bytes followed by the bytes for the number. top end
236# bytes of all zeros are not encoded
237
238sub asn_encode_length {
239
240 if($_[0] >> 7) {
241 my $lenlen = &num_length;
242
243 return pack("Ca*", $lenlen | 0x80, substr(pack("N",$_[0]), -$lenlen));
244 }
245
246 return pack("C", $_[0]);
247}
248
249
250##
251## Decoding
252##
253
254sub decode {
255 my $self = shift;
256
257 local $SIG{__DIE__};
258 my $ret = eval {
259 my (%stash, $result);
260 my $script = $self->{script};
261 my $stash = (1 == @$script && !$self->{script}[0][cVAR]) ? \$result : ($result=\%stash);
262
263 _decode(
264 $self->{options},
265 $script,
266 $stash,
267 0,
268 length $_[0],
269 undef,
270 {},
271 $_[0]);
272
273 $result;
274 };
275 if ($@) {
276 $self->{'error'} = $@;
277 return undef;
278 }
279 $ret;
280}
281
282
283sub asn_decode_length {
284 return unless length $_[0];
285
286 my $len = ord substr($_[0],0,1);
287
288 if($len & 0x80) {
289 $len &= 0x7f or return (1,-1);
290
291 return if $len >= length $_[0];
292
293 return (1+$len, unpack("N", "\0" x (4 - $len) . substr($_[0],1,$len)));
294 }
295 return (1, $len);
296}
297
298
299sub asn_decode_tag {
300 return unless length $_[0];
301
302 my $tag = ord $_[0];
303 my $n = 1;
304
305 if(($tag & 0x1f) == 0x1f) {
306 my $b;
307 do {
308 return if $n >= length $_[0];
309 $b = ord substr($_[0],$n,1);
310 $tag |= $b << (8 * $n++);
311 } while($b & 0x80);
312 }
313 ($n, $tag);
314}
315
316
317sub asn_decode_tag2 {
318 return unless length $_[0];
319
320 my $tag = ord $_[0];
321 my $num = $tag & 0x1f;
322 my $len = 1;
323
324 if($num == 0x1f) {
325 $num = 0;
326 my $b;
327 do {
328 return if $len >= length $_[0];
329 $b = ord substr($_[0],$len++,1);
330 $num = ($num << 7) + ($b & 0x7f);
331 } while($b & 0x80);
332 }
333 ($len, $tag, $num);
334}
335
336
337##
338## Utilities
339##
340
341# How many bytes are needed to encode a number
342
343sub num_length {
344 $_[0] >> 8
345 ? $_[0] >> 16
346 ? $_[0] >> 24
347 ? 4
348 : 3
349 : 2
350 : 1
351}
352
353# Convert from a bigint to an octet string
354
355sub i2osp {
356 my($num, $biclass) = @_;
357 eval "use $biclass";
358 $num = $biclass->new($num);
359 my $neg = $num < 0
360 and $num = abs($num+1);
361 my $base = $biclass->new(256);
362 my $result = '';
363 while($num != 0) {
364 my $r = $num % $base;
365 $num = ($num-$r) / $base;
366 $result .= chr($r);
367 }
368 $result ^= chr(255) x length($result) if $neg;
369 return scalar reverse $result;
370}
371
372# Convert from an octet string to a bigint
373
374sub os2ip {
375 my($os, $biclass) = @_;
376 eval "require $biclass";
377 my $base = $biclass->new(256);
378 my $result = $biclass->new(0);
379 my $neg = ord($os) >= 0x80
380 and $os ^= chr(255) x length($os);
381 for (unpack("C*",$os)) {
382 $result = ($result * $base) + $_;
383 }
384 return $neg ? ($result + 1) * -1 : $result;
385}
386
387# Given a class and a tag, calculate an integer which when encoded
388# will become the tag. This means that the class bits are always
389# in the bottom byte, so are the tag bits if tag < 30. Otherwise
390# the tag is in the upper 3 bytes. The upper bytes are encoded
391# with bit8 representing that there is another byte. This
392# means the max tag we can do is 0x1fffff
393
394
# spent 374µs within Convert::ASN1::asn_tag which was called 74 times, avg 5µs/call: # 74 times (374µs+0s) by Convert::ASN1::parser::yylex at line 881 of Convert/ASN1/parser.pm, avg 5µs/call
sub asn_tag {
3957455µs my($class,$value) = @_;
396
3977442µs die sprintf "Bad tag class 0x%x",$class
398 if $class & ~0xe0;
399
40074307µs unless ($value & ~0x1f or $value == 0x1f) {
401 return (($class & 0xe0) | $value);
402 }
403
404 die sprintf "Tag value 0x%08x too big\n",$value
405 if $value & 0xffe00000;
406
407 $class = ($class | 0x1f) & 0xff;
408
409 my @t = ($value & 0x7f);
410 unshift @t, (0x80 | ($value & 0x7f)) while $value >>= 7;
411 unpack("V",pack("C4",$class,@t,0,0));
412}
413
414
415
# spent 14.0ms (12.0+2.06) within Convert::ASN1::BEGIN@415 which was called: # once (12.0ms+2.06ms) by Net::LDAP::BEGIN@12 at line 425
BEGIN {
416 # When we have XS &_encode will be defined by the XS code
417 # so will all the subs in these required packages
41812µs unless (defined &_encode) {
4191129µs require Convert::ASN1::_decode;
4201135µs require Convert::ASN1::_encode;
4211102µs require Convert::ASN1::IO;
422 }
423
424198µs require Convert::ASN1::parser;
4251204µs114.0ms}
# spent 14.0ms making 1 call to Convert::ASN1::BEGIN@415
426
427sub AUTOLOAD {
428 require Convert::ASN1::Debug if $AUTOLOAD =~ /dump/;
429 goto &{$AUTOLOAD} if defined &{$AUTOLOAD};
430 require Carp;
431 my $pkg = ref($_[0]) || ($_[0] =~ /^[\w\d]+(?:::[\w\d]+)*$/)[0];
432 if ($pkg and UNIVERSAL::isa($pkg, __PACKAGE__)) { # guess it was a method call
433 $AUTOLOAD =~ s/.*:://;
434 Carp::croak(sprintf q{Can't locate object method "%s" via package "%s"},$AUTOLOAD,$pkg);
435 }
436 else {
437 Carp::croak(sprintf q{Undefined subroutine &%s called}, $AUTOLOAD);
438 }
439}
440
441sub DESTROY {}
442
443sub error { $_[0]->{error} }
44414µs1;
 
# spent 5µs within Convert::ASN1::CORE:match which was called: # once (5µs+0s) by Convert::ASN1::configure at line 117
sub Convert::ASN1::CORE:match; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.