← 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:02:22 2013

Filename/usr/share/perl5/Convert/ASN1.pm
StatementsExecuted 481 statements in 4.81ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111.8ms13.8msConvert::ASN1::::BEGIN@415Convert::ASN1::BEGIN@415
7411638µs638µsConvert::ASN1::::asn_tagConvert::ASN1::asn_tag
111267µs271µsConvert::ASN1::::BEGIN@16Convert::ASN1::BEGIN@16
10531216µs216µsConvert::ASN1::::asn_encode_tagConvert::ASN1::asn_encode_tag
11189µs89µsConvert::ASN1::::_internal_symsConvert::ASN1::_internal_syms
11167µs67µsConvert::ASN1::::BEGIN@9Convert::ASN1::BEGIN@9
11134µs103msConvert::ASN1::::prepareConvert::ASN1::prepare
11128µs137µsConvert::ASN1::::BEGIN@14Convert::ASN1::BEGIN@14
11126µs31µsConvert::ASN1::::configureConvert::ASN1::configure
21124µs24µsConvert::ASN1::::findConvert::ASN1::find
11123µs211µsConvert::ASN1::::BEGIN@11Convert::ASN1::BEGIN@11
11123µs57µsConvert::ASN1::::BEGIN@12Convert::ASN1::BEGIN@12
11121µs32µsConvert::ASN1::::BEGIN@10Convert::ASN1::BEGIN@10
11121µs52µsConvert::ASN1::::newConvert::ASN1::new
11116µs38µsConvert::ASN1::::BEGIN@67Convert::ASN1::BEGIN@67
11115µs49µsConvert::ASN1::::BEGIN@59Convert::ASN1::BEGIN@59
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
9388µs167µs
# spent 67µs within Convert::ASN1::BEGIN@9 which was called: # once (67µs+0s) by Net::LDAP::BEGIN@12 at line 9
use 5.004;
# spent 67µs making 1 call to Convert::ASN1::BEGIN@9
103111µs242µs
# spent 32µs (21+10) within Convert::ASN1::BEGIN@10 which was called: # once (21µs+10µs) by Net::LDAP::BEGIN@12 at line 10
use strict;
# spent 32µs making 1 call to Convert::ASN1::BEGIN@10 # spent 10µs making 1 call to strict::import
11357µs2399µs
# spent 211µs (23+188) within Convert::ASN1::BEGIN@11 which was called: # once (23µs+188µs) by Net::LDAP::BEGIN@12 at line 11
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @opParts @opName $AUTOLOAD);
# spent 211µs making 1 call to Convert::ASN1::BEGIN@11 # spent 188µs making 1 call to vars::import
12374µs291µs
# spent 57µs (23+34) within Convert::ASN1::BEGIN@12 which was called: # once (23µs+34µs) by Net::LDAP::BEGIN@12 at line 12
use Exporter;
# spent 57µs making 1 call to Convert::ASN1::BEGIN@12 # spent 34µs making 1 call to Exporter::import
13
143336µs2247µs
# spent 137µs (28+109) within Convert::ASN1::BEGIN@14 which was called: # once (28µs+109µs) by Net::LDAP::BEGIN@12 at line 14
use constant CHECK_UTF8 => $] > 5.007;
# spent 137µs making 1 call to Convert::ASN1::BEGIN@14 # spent 109µs making 1 call to constant::import
15
16
# spent 271µs (267+4) within Convert::ASN1::BEGIN@16 which was called: # once (267µs+4µs) by Net::LDAP::BEGIN@12 at line 63
BEGIN {
1715µs local $SIG{__DIE__};
1829µs14µs eval { require bytes and 'bytes'->import };
# spent 4µs making 1 call to bytes::import
19
201500ns if (CHECK_UTF8) {
211900ns require Encode;
2211µs require utf8;
23 }
24
2519µs @ISA = qw(Exporter);
261600ns $VERSION = "0.22";
27
28114µ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
43122µ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
55110µs foreach my $l (\@opParts, \@opName) {
562700ns my $i = 0;
5723µs foreach my $name (@$l) {
58248µs my $j = $i++;
59393µs282µs
# spent 49µs (15+33) within Convert::ASN1::BEGIN@59 which was called: # once (15µs+33µs) by Net::LDAP::BEGIN@12 at line 59
no strict 'refs';
# spent 49µs making 1 call to Convert::ASN1::BEGIN@59 # spent 33µs making 1 call to strict::unimport
60 *{__PACKAGE__ . '::' . $name} = sub () { $j }
6124171µs }
62 }
63185µs1271µs}
# spent 271µs making 1 call to Convert::ASN1::BEGIN@16
64
65
# spent 89µs within Convert::ASN1::_internal_syms which was called: # once (89µs+0s) by Convert::ASN1::parser::BEGIN@16 at line 16 of Convert/ASN1/parser.pm
sub _internal_syms {
6611µs my $pkg = caller;
6731.93ms261µs
# spent 38µs (16+22) within Convert::ASN1::BEGIN@67 which was called: # once (16µs+22µs) by Net::LDAP::BEGIN@12 at line 67
no strict 'refs';
# spent 38µs making 1 call to Convert::ASN1::BEGIN@67 # spent 22µs making 1 call to strict::unimport
68112µs for my $sub (@opParts,@opName,'dump_op') {
692584µ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 52µs (21+31) within Convert::ASN1::new which was called: # once (21µs+31µs) by Net::LDAP::Message::BEGIN@8 at line 8 of Net/LDAP/ASN.pm
sub new {
10312µs my $pkg = shift;
104110µ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 (26+5) within Convert::ASN1::configure which was called: # once (26µs+5µs) by Convert::ASN1::new at line 106
sub configure {
1121600ns my $self = shift;
11312µs my %opt = @_;
114
11515µs $self->{options}{encoding} = uc($opt{encoding} || 'BER');
116
117118µ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
12216µ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 24µs within Convert::ASN1::find which was called 2 times, avg 12µs/call: # 2 times (24µs+0s) by Net::LDAP::ASN::import at line 15 of Net/LDAP/ASN.pm, avg 12µs/call
sub find {
13421µs my $self = shift;
13521µs my $what = shift;
13623µs return unless exists $self->{tree}{$what};
13728µs my %new = %$self;
13823µs $new{script} = $new{tree}->{$what};
139213µs bless \%new, ref($self);
140}
141
142
143
# spent 103ms (34µs+103) within Convert::ASN1::prepare which was called: # once (34µs+103ms) 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
14711µs $self = $self->new unless ref($self);
1481400ns my $tree;
14912µs if( ref($asn) eq 'GLOB' ){
150 local $/ = undef;
151 my $txt = <$asn>;
152 $tree = Convert::ASN1::parser::parse($txt);
153 } else {
15414µs1103ms $tree = Convert::ASN1::parser::parse($asn);
# spent 103ms making 1 call to Convert::ASN1::parser::parse
155 }
156
1571900ns 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
20215µ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 216µs within Convert::ASN1::asn_encode_tag which was called 105 times, avg 2µs/call: # 45 times (106µs+0s) by Convert::ASN1::parser::compile_one at line 679 of Convert/ASN1/parser.pm, avg 2µs/call # 31 times (42µs+0s) by Convert::ASN1::BEGIN@415 at line 21 of Convert/ASN1/parser.pm, avg 1µs/call # 29 times (69µs+0s) by Convert::ASN1::parser::compile_one at line 664 of Convert/ASN1/parser.pm, avg 2µs/call
sub asn_encode_tag {
224105314µ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 638µs within Convert::ASN1::asn_tag which was called 74 times, avg 9µs/call: # 74 times (638µs+0s) by Convert::ASN1::parser::yylex at line 881 of Convert/ASN1/parser.pm, avg 9µs/call
sub asn_tag {
3957498µs my($class,$value) = @_;
396
3977460µs die sprintf "Bad tag class 0x%x",$class
398 if $class & ~0xe0;
399
40074486µ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 13.8ms (11.8+1.98) within Convert::ASN1::BEGIN@415 which was called: # once (11.8ms+1.98ms) 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) {
4191107µs require Convert::ASN1::_decode;
4201119µs require Convert::ASN1::_encode;
421185µs require Convert::ASN1::IO;
422 }
423
424190µs require Convert::ASN1::parser;
4251196µs113.8ms}
# spent 13.8ms 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} }
44413µ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.