← 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:11:35 2013

Filename/usr/lib/perl/5.10/IO/Compress/Zlib/Extra.pm
StatementsExecuted 16 statements in 955µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11120µs362µsIO::Compress::Zlib::Extra::::BEGIN@13IO::Compress::Zlib::Extra::BEGIN@13
11119µs24µsIO::Compress::Zlib::Extra::::BEGIN@5IO::Compress::Zlib::Extra::BEGIN@5
11110µs27µsIO::Compress::Zlib::Extra::::BEGIN@6IO::Compress::Zlib::Extra::BEGIN@6
11110µs13µsIO::Compress::Zlib::Extra::::BEGIN@7IO::Compress::Zlib::Extra::BEGIN@7
0000s0sIO::Compress::Zlib::Extra::::ExtraFieldErrorIO::Compress::Zlib::Extra::ExtraFieldError
0000s0sIO::Compress::Zlib::Extra::::mkSubFieldIO::Compress::Zlib::Extra::mkSubField
0000s0sIO::Compress::Zlib::Extra::::parseExtraFieldIO::Compress::Zlib::Extra::parseExtraField
0000s0sIO::Compress::Zlib::Extra::::parseRawExtraIO::Compress::Zlib::Extra::parseRawExtra
0000s0sIO::Compress::Zlib::Extra::::validateExtraFieldPairIO::Compress::Zlib::Extra::validateExtraFieldPair
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package IO::Compress::Zlib::Extra;
2
3118µsrequire 5.004 ;
4
5329µs230µs
# spent 24µs (19+5) within IO::Compress::Zlib::Extra::BEGIN@5 which was called: # once (19µs+5µs) by IO::Compress::Gzip::BEGIN@16 at line 5
use strict ;
# spent 24µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@5 # spent 5µs making 1 call to strict::import
6328µs243µs
# spent 27µs (10+16) within IO::Compress::Zlib::Extra::BEGIN@6 which was called: # once (10µs+16µs) by IO::Compress::Gzip::BEGIN@16 at line 6
use warnings;
# spent 27µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@6 # spent 16µs making 1 call to warnings::import
7369µs216µs
# spent 13µs (10+3) within IO::Compress::Zlib::Extra::BEGIN@7 which was called: # once (10µs+3µs) by IO::Compress::Gzip::BEGIN@16 at line 7
use bytes;
# spent 13µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@7 # spent 3µs making 1 call to bytes::import
8
91900nsour ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
10
111500ns$VERSION = '2.020';
12
133806µs3703µs
# spent 362µs (20+341) within IO::Compress::Zlib::Extra::BEGIN@13 which was called: # once (20µs+341µs) by IO::Compress::Gzip::BEGIN@16 at line 13
use IO::Compress::Gzip::Constants 2.020 ;
# spent 362µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@13 # spent 326µs making 1 call to Exporter::import # spent 15µs making 1 call to UNIVERSAL::VERSION
14
15sub ExtraFieldError
16{
17 return $_[0];
18 return "Error with ExtraField Parameter: $_[0]" ;
19}
20
21sub validateExtraFieldPair
22{
23 my $pair = shift ;
24 my $strict = shift;
25 my $gzipMode = shift ;
26
27 return ExtraFieldError("Not an array ref")
28 unless ref $pair && ref $pair eq 'ARRAY';
29
30 return ExtraFieldError("SubField must have two parts")
31 unless @$pair == 2 ;
32
33 return ExtraFieldError("SubField ID is a reference")
34 if ref $pair->[0] ;
35
36 return ExtraFieldError("SubField Data is a reference")
37 if ref $pair->[1] ;
38
39 # ID is exactly two chars
40 return ExtraFieldError("SubField ID not two chars long")
41 unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ;
42
43 # Check that the 2nd byte of the ID isn't 0
44 return ExtraFieldError("SubField ID 2nd byte is 0x00")
45 if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ;
46
47 return ExtraFieldError("SubField Data too long")
48 if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ;
49
50
51 return undef ;
52}
53
54sub parseRawExtra
55{
56 my $data = shift ;
57 my $extraRef = shift;
58 my $strict = shift;
59 my $gzipMode = shift ;
60
61 #my $lax = shift ;
62
63 #return undef
64 # if $lax ;
65
66 my $XLEN = length $data ;
67
68 return ExtraFieldError("Too Large")
69 if $XLEN > GZIP_FEXTRA_MAX_SIZE;
70
71 my $offset = 0 ;
72 while ($offset < $XLEN) {
73
74 return ExtraFieldError("Truncated in FEXTRA Body Section")
75 if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ;
76
77 my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);
78 $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;
79
80 my $subLen = unpack("v", substr($data, $offset,
81 GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
82 $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
83
84 return ExtraFieldError("Truncated in FEXTRA Body Section")
85 if $offset + $subLen > $XLEN ;
86
87 my $bad = validateExtraFieldPair( [$id,
88 substr($data, $offset, $subLen)],
89 $strict, $gzipMode );
90 return $bad if $bad ;
91 push @$extraRef, [$id => substr($data, $offset, $subLen)]
92 if defined $extraRef;;
93
94 $offset += $subLen ;
95 }
96
97
98 return undef ;
99}
100
101
102sub mkSubField
103{
104 my $id = shift ;
105 my $data = shift ;
106
107 return $id . pack("v", length $data) . $data ;
108}
109
110sub parseExtraField
111{
112 my $dataRef = $_[0];
113 my $strict = $_[1];
114 my $gzipMode = $_[2];
115 #my $lax = @_ == 2 ? $_[1] : 1;
116
117
118 # ExtraField can be any of
119 #
120 # -ExtraField => $data
121 #
122 # -ExtraField => [$id1, $data1,
123 # $id2, $data2]
124 # ...
125 # ]
126 #
127 # -ExtraField => [ [$id1 => $data1],
128 # [$id2 => $data2],
129 # ...
130 # ]
131 #
132 # -ExtraField => { $id1 => $data1,
133 # $id2 => $data2,
134 # ...
135 # }
136
137 if ( ! ref $dataRef ) {
138
139 return undef
140 if ! $strict;
141
142 return parseRawExtra($dataRef, undef, 1, $gzipMode);
143 }
144
145 #my $data = $$dataRef;
146 my $data = $dataRef;
147 my $out = '' ;
148
149 if (ref $data eq 'ARRAY') {
150 if (ref $data->[0]) {
151
152 foreach my $pair (@$data) {
153 return ExtraFieldError("Not list of lists")
154 unless ref $pair eq 'ARRAY' ;
155
156 my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ;
157 return $bad if $bad ;
158
159 $out .= mkSubField(@$pair);
160 }
161 }
162 else {
163 return ExtraFieldError("Not even number of elements")
164 unless @$data % 2 == 0;
165
166 for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) {
167 my $bad = validateExtraFieldPair([$data->[$ix],
168 $data->[$ix+1]],
169 $strict, $gzipMode) ;
170 return $bad if $bad ;
171
172 $out .= mkSubField($data->[$ix], $data->[$ix+1]);
173 }
174 }
175 }
176 elsif (ref $data eq 'HASH') {
177 while (my ($id, $info) = each %$data) {
178 my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode);
179 return $bad if $bad ;
180
181 $out .= mkSubField($id, $info);
182 }
183 }
184 else {
185 return ExtraFieldError("Not a scalar, array ref or hash ref") ;
186 }
187
188 return ExtraFieldError("Too Large")
189 if length $out > GZIP_FEXTRA_MAX_SIZE;
190
191 $_[0] = $out ;
192
193 return undef;
194}
195
19614µs1;
197
198__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.