← 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:19 2013

Filename/usr/lib/perl/5.10/IO/Compress/Gzip.pm
StatementsExecuted 36 statements in 2.01ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.47ms9.27msIO::Compress::Gzip::::BEGIN@11IO::Compress::Gzip::BEGIN@11
1111.41ms3.18msIO::Compress::Gzip::::BEGIN@15IO::Compress::Gzip::BEGIN@15
1111.03ms1.47msIO::Compress::Gzip::::BEGIN@16IO::Compress::Gzip::BEGIN@16
11123µs29µsIO::Compress::Gzip::::BEGIN@6IO::Compress::Gzip::BEGIN@6
11119µs291µsIO::Compress::Gzip::::BEGIN@13IO::Compress::Gzip::BEGIN@13
11115µs235µsIO::Compress::Gzip::::BEGIN@14IO::Compress::Gzip::BEGIN@14
11113µs32µsIO::Compress::Gzip::::BEGIN@7IO::Compress::Gzip::BEGIN@7
11110µs13µsIO::Compress::Gzip::::BEGIN@8IO::Compress::Gzip::BEGIN@8
1118µs8µsIO::Compress::Gzip::::BEGIN@19IO::Compress::Gzip::BEGIN@19
0000s0sIO::Compress::Gzip::::__ANON__[:23]IO::Compress::Gzip::__ANON__[:23]
0000s0sIO::Compress::Gzip::::ckParamsIO::Compress::Gzip::ckParams
0000s0sIO::Compress::Gzip::::getExtraParamsIO::Compress::Gzip::getExtraParams
0000s0sIO::Compress::Gzip::::getFileInfoIO::Compress::Gzip::getFileInfo
0000s0sIO::Compress::Gzip::::getInverseClassIO::Compress::Gzip::getInverseClass
0000s0sIO::Compress::Gzip::::gzipIO::Compress::Gzip::gzip
0000s0sIO::Compress::Gzip::::mkFinalTrailerIO::Compress::Gzip::mkFinalTrailer
0000s0sIO::Compress::Gzip::::mkHeaderIO::Compress::Gzip::mkHeader
0000s0sIO::Compress::Gzip::::mkTrailerIO::Compress::Gzip::mkTrailer
0000s0sIO::Compress::Gzip::::newIO::Compress::Gzip::new
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1
2package IO::Compress::Gzip ;
3
4118µsrequire 5.004 ;
5
6331µs235µs
# spent 29µs (23+6) within IO::Compress::Gzip::BEGIN@6 which was called: # once (23µs+6µs) by Compress::Zlib::BEGIN@13 at line 6
use strict ;
# spent 29µs making 1 call to IO::Compress::Gzip::BEGIN@6 # spent 6µs making 1 call to strict::import
7328µs251µs
# spent 32µs (13+19) within IO::Compress::Gzip::BEGIN@7 which was called: # once (13µs+19µs) by Compress::Zlib::BEGIN@13 at line 7
use warnings;
# spent 32µs making 1 call to IO::Compress::Gzip::BEGIN@7 # spent 19µs making 1 call to warnings::import
8329µs216µs
# spent 13µs (10+3) within IO::Compress::Gzip::BEGIN@8 which was called: # once (10µs+3µs) by Compress::Zlib::BEGIN@13 at line 8
use bytes;
# spent 13µs making 1 call to IO::Compress::Gzip::BEGIN@8 # spent 3µs making 1 call to bytes::import
9
10
113162µs39.32ms
# spent 9.27ms (1.47+7.80) within IO::Compress::Gzip::BEGIN@11 which was called: # once (1.47ms+7.80ms) by Compress::Zlib::BEGIN@13 at line 11
use IO::Compress::RawDeflate 2.020 ;
# spent 9.27ms making 1 call to IO::Compress::Gzip::BEGIN@11 # spent 26µs making 1 call to Exporter::import # spent 20µs making 1 call to UNIVERSAL::VERSION
12
13362µs3563µs
# spent 291µs (19+272) within IO::Compress::Gzip::BEGIN@13 which was called: # once (19µs+272µs) by Compress::Zlib::BEGIN@13 at line 13
use Compress::Raw::Zlib 2.020 ;
# spent 291µs making 1 call to IO::Compress::Gzip::BEGIN@13 # spent 258µs making 1 call to Exporter::import # spent 14µs making 1 call to UNIVERSAL::VERSION
14375µs3455µs
# spent 235µs (15+220) within IO::Compress::Gzip::BEGIN@14 which was called: # once (15µs+220µs) by Compress::Zlib::BEGIN@13 at line 14
use IO::Compress::Base::Common 2.020 qw(:Status :Parse createSelfTiedObject);
# spent 235µs making 1 call to IO::Compress::Gzip::BEGIN@14 # spent 206µs making 1 call to Exporter::import # spent 14µs making 1 call to UNIVERSAL::VERSION
153188µs33.52ms
# spent 3.18ms (1.41+1.77) within IO::Compress::Gzip::BEGIN@15 which was called: # once (1.41ms+1.77ms) by Compress::Zlib::BEGIN@13 at line 15
use IO::Compress::Gzip::Constants 2.020 ;
# spent 3.18ms making 1 call to IO::Compress::Gzip::BEGIN@15 # spent 330µs making 1 call to Exporter::import # spent 19µs making 1 call to UNIVERSAL::VERSION
163203µs21.48ms
# spent 1.47ms (1.03+436µs) within IO::Compress::Gzip::BEGIN@16 which was called: # once (1.03ms+436µs) by Compress::Zlib::BEGIN@13 at line 16
use IO::Compress::Zlib::Extra 2.020 ;
# spent 1.47ms making 1 call to IO::Compress::Gzip::BEGIN@16 # spent 10µs making 1 call to UNIVERSAL::VERSION
17
18BEGIN
19
# spent 8µs within IO::Compress::Gzip::BEGIN@19 which was called: # once (8µs+0s) by Compress::Zlib::BEGIN@13 at line 24
{
2018µs if (defined &utf8::downgrade )
21 { *noUTF8 = \&utf8::downgrade }
22 else
23 { *noUTF8 = sub {} }
2411.16ms18µs}
# spent 8µs making 1 call to IO::Compress::Gzip::BEGIN@19
25
261600nsrequire Exporter ;
27
2811µsour ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError);
29
301500ns$VERSION = '2.020';
311300ns$GzipError = '' ;
32
33120µs@ISA = qw(Exporter IO::Compress::RawDeflate);
3411µs@EXPORT_OK = qw( $GzipError gzip ) ;
3515µs%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
3612µspush @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
3714µs130µsExporter::export_ok_tags('all');
# spent 30µs making 1 call to Exporter::export_ok_tags
38
39sub new
40{
41 my $class = shift ;
42
43 my $obj = createSelfTiedObject($class, \$GzipError);
44
45 $obj->_create(undef, @_);
46}
47
48
49sub gzip
50{
51 my $obj = createSelfTiedObject(undef, \$GzipError);
52 return $obj->_def(@_);
53}
54
55#sub newHeader
56#{
57# my $self = shift ;
58# #return GZIP_MINIMUM_HEADER ;
59# return $self->mkHeader(*$self->{Got});
60#}
61
62sub getExtraParams
63{
64 my $self = shift ;
65
66 return (
67 # zlib behaviour
68 $self->getZlibParams(),
69
70 # Gzip header fields
71 'Minimal' => [0, 1, Parse_boolean, 0],
72 'Comment' => [0, 1, Parse_any, undef],
73 'Name' => [0, 1, Parse_any, undef],
74 'Time' => [0, 1, Parse_any, undef],
75 'TextFlag' => [0, 1, Parse_boolean, 0],
76 'HeaderCRC' => [0, 1, Parse_boolean, 0],
77 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
78 'ExtraField'=> [0, 1, Parse_any, undef],
79 'ExtraFlags'=> [0, 1, Parse_any, undef],
80
81 );
82}
83
84
85sub ckParams
86{
87 my $self = shift ;
88 my $got = shift ;
89
90 # gzip always needs crc32
91 $got->value('CRC32' => 1);
92
93 return 1
94 if $got->value('Merge') ;
95
96 my $strict = $got->value('Strict') ;
97
98
99 {
100 if (! $got->parsed('Time') ) {
101 # Modification time defaults to now.
102 $got->value('Time' => time) ;
103 }
104
105 # Check that the Name & Comment don't have embedded NULLs
106 # Also check that they only contain ISO 8859-1 chars.
107 if ($got->parsed('Name') && defined $got->value('Name')) {
108 my $name = $got->value('Name');
109
110 return $self->saveErrorString(undef, "Null Character found in Name",
111 Z_DATA_ERROR)
112 if $strict && $name =~ /\x00/ ;
113
114 return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name",
115 Z_DATA_ERROR)
116 if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
117 }
118
119 if ($got->parsed('Comment') && defined $got->value('Comment')) {
120 my $comment = $got->value('Comment');
121
122 return $self->saveErrorString(undef, "Null Character found in Comment",
123 Z_DATA_ERROR)
124 if $strict && $comment =~ /\x00/ ;
125
126 return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment",
127 Z_DATA_ERROR)
128 if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o;
129 }
130
131 if ($got->parsed('OS_Code') ) {
132 my $value = $got->value('OS_Code');
133
134 return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'")
135 if $value < 0 || $value > 255 ;
136
137 }
138
139 # gzip only supports Deflate at present
140 $got->value('Method' => Z_DEFLATED) ;
141
142 if ( ! $got->parsed('ExtraFlags')) {
143 $got->value('ExtraFlags' => 2)
144 if $got->value('Level') == Z_BEST_SPEED ;
145 $got->value('ExtraFlags' => 4)
146 if $got->value('Level') == Z_BEST_COMPRESSION ;
147 }
148
149 my $data = $got->value('ExtraField') ;
150 if (defined $data) {
151 my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ;
152 return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR)
153 if $bad ;
154
155 $got->value('ExtraField', $data) ;
156 }
157 }
158
159 return 1;
160}
161
162sub mkTrailer
163{
164 my $self = shift ;
165 return pack("V V", *$self->{Compress}->crc32(),
166 *$self->{UnCompSize}->get32bit());
167}
168
169sub getInverseClass
170{
171 return ('IO::Uncompress::Gunzip',
172 \$IO::Uncompress::Gunzip::GunzipError);
173}
174
175sub getFileInfo
176{
177 my $self = shift ;
178 my $params = shift;
179 my $filename = shift ;
180
181 my $defaultTime = (stat($filename))[9] ;
182
183 $params->value('Name' => $filename)
184 if ! $params->parsed('Name') ;
185
186 $params->value('Time' => $defaultTime)
187 if ! $params->parsed('Time') ;
188}
189
190
191sub mkHeader
192{
193 my $self = shift ;
194 my $param = shift ;
195
196 # stort-circuit if a minimal header is requested.
197 return GZIP_MINIMUM_HEADER if $param->value('Minimal') ;
198
199 # METHOD
200 my $method = $param->valueOrDefault('Method', GZIP_CM_DEFLATED) ;
201
202 # FLAGS
203 my $flags = GZIP_FLG_DEFAULT ;
204 $flags |= GZIP_FLG_FTEXT if $param->value('TextFlag') ;
205 $flags |= GZIP_FLG_FHCRC if $param->value('HeaderCRC') ;
206 $flags |= GZIP_FLG_FEXTRA if $param->wantValue('ExtraField') ;
207 $flags |= GZIP_FLG_FNAME if $param->wantValue('Name') ;
208 $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('Comment') ;
209
210 # MTIME
211 my $time = $param->valueOrDefault('Time', GZIP_MTIME_DEFAULT) ;
212
213 # EXTRA FLAGS
214 my $extra_flags = $param->valueOrDefault('ExtraFlags', GZIP_XFL_DEFAULT);
215
216 # OS CODE
217 my $os_code = $param->valueOrDefault('OS_Code', GZIP_OS_DEFAULT) ;
218
219
220 my $out = pack("C4 V C C",
221 GZIP_ID1, # ID1
222 GZIP_ID2, # ID2
223 $method, # Compression Method
224 $flags, # Flags
225 $time, # Modification Time
226 $extra_flags, # Extra Flags
227 $os_code, # Operating System Code
228 ) ;
229
230 # EXTRA
231 if ($flags & GZIP_FLG_FEXTRA) {
232 my $extra = $param->value('ExtraField') ;
233 $out .= pack("v", length $extra) . $extra ;
234 }
235
236 # NAME
237 if ($flags & GZIP_FLG_FNAME) {
238 my $name .= $param->value('Name') ;
239 $name =~ s/\x00.*$//;
240 $out .= $name ;
241 # Terminate the filename with NULL unless it already is
242 $out .= GZIP_NULL_BYTE
243 if !length $name or
244 substr($name, 1, -1) ne GZIP_NULL_BYTE ;
245 }
246
247 # COMMENT
248 if ($flags & GZIP_FLG_FCOMMENT) {
249 my $comment .= $param->value('Comment') ;
250 $comment =~ s/\x00.*$//;
251 $out .= $comment ;
252 # Terminate the comment with NULL unless it already is
253 $out .= GZIP_NULL_BYTE
254 if ! length $comment or
255 substr($comment, 1, -1) ne GZIP_NULL_BYTE;
256 }
257
258 # HEADER CRC
259 $out .= pack("v", crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ;
260
261 noUTF8($out);
262
263 return $out ;
264}
265
266sub mkFinalTrailer
267{
268 return '';
269}
270
271112µs1;
272
273__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.