← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:15 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/IO/Compress/Gzip.pm
StatementsExecuted 32 statements in 3.65ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.91ms11.3msIO::Compress::Gzip::::BEGIN@11IO::Compress::Gzip::BEGIN@11
1111.65ms3.55msIO::Compress::Gzip::::BEGIN@15IO::Compress::Gzip::BEGIN@15
1111.57ms1.93msIO::Compress::Gzip::::BEGIN@16IO::Compress::Gzip::BEGIN@16
11128µs255µsIO::Compress::Gzip::::BEGIN@12IO::Compress::Gzip::BEGIN@12
11127µs31µsIO::Compress::Gzip::::BEGIN@5IO::Compress::Gzip::BEGIN@5
11118µs164µsIO::Compress::Gzip::::BEGIN@14IO::Compress::Gzip::BEGIN@14
11111µs24µsIO::Compress::Gzip::::BEGIN@6IO::Compress::Gzip::BEGIN@6
11111µs14µsIO::Compress::Gzip::::BEGIN@7IO::Compress::Gzip::BEGIN@7
1117µs7µ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
1package IO::Compress::Gzip ;
2
3111µsrequire 5.006 ;
4
5238µs235µs
# spent 31µs (27+4) within IO::Compress::Gzip::BEGIN@5 which was called: # once (27µs+4µs) by Compress::Zlib::BEGIN@12 at line 5
use strict ;
# spent 31µs making 1 call to IO::Compress::Gzip::BEGIN@5 # spent 4µs making 1 call to strict::import
6232µs237µs
# spent 24µs (11+13) within IO::Compress::Gzip::BEGIN@6 which was called: # once (11µs+13µs) by Compress::Zlib::BEGIN@12 at line 6
use warnings;
# spent 24µs making 1 call to IO::Compress::Gzip::BEGIN@6 # spent 13µs making 1 call to warnings::import
7243µs217µs
# spent 14µs (11+3) within IO::Compress::Gzip::BEGIN@7 which was called: # once (11µs+3µs) by Compress::Zlib::BEGIN@12 at line 7
use bytes;
# spent 14µs making 1 call to IO::Compress::Gzip::BEGIN@7 # spent 3µs making 1 call to bytes::import
8
911µsrequire Exporter ;
10
113621µs211.3ms
# spent 11.3ms (1.91+9.36) within IO::Compress::Gzip::BEGIN@11 which was called: # once (1.91ms+9.36ms) by Compress::Zlib::BEGIN@12 at line 11
use IO::Compress::RawDeflate 2.074 () ;
# spent 11.3ms making 1 call to IO::Compress::Gzip::BEGIN@11 # spent 17µs making 1 call to version::_VERSION
12377µs3482µs
# spent 255µs (28+227) within IO::Compress::Gzip::BEGIN@12 which was called: # once (28µs+227µs) by Compress::Zlib::BEGIN@12 at line 12
use IO::Compress::Adapter::Deflate 2.074 ;
# spent 255µs making 1 call to IO::Compress::Gzip::BEGIN@12 # spent 211µs making 1 call to Exporter::import # spent 16µs making 1 call to version::_VERSION
13
14357µs3310µs
# spent 164µs (18+146) within IO::Compress::Gzip::BEGIN@14 which was called: # once (18µs+146µs) by Compress::Zlib::BEGIN@12 at line 14
use IO::Compress::Base::Common 2.074 qw(:Status );
# spent 164µs making 1 call to IO::Compress::Gzip::BEGIN@14 # spent 137µs making 1 call to Exporter::import # spent 9µs making 1 call to version::_VERSION
153608µs33.84ms
# spent 3.55ms (1.65+1.90) within IO::Compress::Gzip::BEGIN@15 which was called: # once (1.65ms+1.90ms) by Compress::Zlib::BEGIN@12 at line 15
use IO::Compress::Gzip::Constants 2.074 ;
# spent 3.55ms making 1 call to IO::Compress::Gzip::BEGIN@15 # spent 273µs making 1 call to Exporter::import # spent 12µs making 1 call to version::_VERSION
163596µs21.93ms
# spent 1.93ms (1.57+357µs) within IO::Compress::Gzip::BEGIN@16 which was called: # once (1.57ms+357µs) by Compress::Zlib::BEGIN@12 at line 16
use IO::Compress::Zlib::Extra 2.074 ;
# spent 1.93ms making 1 call to IO::Compress::Gzip::BEGIN@16 # spent 8µs making 1 call to version::_VERSION
17
18BEGIN
19
# spent 7µs within IO::Compress::Gzip::BEGIN@19 which was called: # once (7µs+0s) by Compress::Zlib::BEGIN@12 at line 24
{
2016µs if (defined &utf8::downgrade )
21 { *noUTF8 = \&utf8::downgrade }
22 else
23 { *noUTF8 = sub {} }
2411.52ms17µs}
# spent 7µs making 1 call to IO::Compress::Gzip::BEGIN@19
25
26our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
27
2810s$VERSION = '2.074';
2910s$GzipError = '' ;
30
31115µs@ISA = qw(IO::Compress::RawDeflate Exporter);
3211µs@EXPORT_OK = qw( $GzipError gzip ) ;
3315µs%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
34
3512µspush @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
3614µs126µsExporter::export_ok_tags('all');
# spent 26µs making 1 call to Exporter::export_ok_tags
37
38sub new
39{
40 my $class = shift ;
41
42 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError);
43
44 $obj->_create(undef, @_);
45}
46
47
48sub gzip
49{
50 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError);
51 return $obj->_def(@_);
52}
53
54#sub newHeader
55#{
56# my $self = shift ;
57# #return GZIP_MINIMUM_HEADER ;
58# return $self->mkHeader(*$self->{Got});
59#}
60
61sub getExtraParams
62{
63 my $self = shift ;
64
65 return (
66 # zlib behaviour
67 $self->getZlibParams(),
68
69 # Gzip header fields
70 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0],
71 'comment' => [IO::Compress::Base::Common::Parse_any, undef],
72 'name' => [IO::Compress::Base::Common::Parse_any, undef],
73 'time' => [IO::Compress::Base::Common::Parse_any, undef],
74 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0],
75 'headercrc' => [IO::Compress::Base::Common::Parse_boolean, 0],
76 'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
77 'extrafield'=> [IO::Compress::Base::Common::Parse_any, undef],
78 'extraflags'=> [IO::Compress::Base::Common::Parse_any, undef],
79
80 );
81}
82
83
84sub ckParams
85{
86 my $self = shift ;
87 my $got = shift ;
88
89 # gzip always needs crc32
90 $got->setValue('crc32' => 1);
91
92 return 1
93 if $got->getValue('merge') ;
94
95 my $strict = $got->getValue('strict') ;
96
97
98 {
99 if (! $got->parsed('time') ) {
100 # Modification time defaults to now.
101 $got->setValue(time => time) ;
102 }
103
104 # Check that the Name & Comment don't have embedded NULLs
105 # Also check that they only contain ISO 8859-1 chars.
106 if ($got->parsed('name') && defined $got->getValue('name')) {
107 my $name = $got->getValue('name');
108
109 return $self->saveErrorString(undef, "Null Character found in Name",
110 Z_DATA_ERROR)
111 if $strict && $name =~ /\x00/ ;
112
113 return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name",
114 Z_DATA_ERROR)
115 if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
116 }
117
118 if ($got->parsed('comment') && defined $got->getValue('comment')) {
119 my $comment = $got->getValue('comment');
120
121 return $self->saveErrorString(undef, "Null Character found in Comment",
122 Z_DATA_ERROR)
123 if $strict && $comment =~ /\x00/ ;
124
125 return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment",
126 Z_DATA_ERROR)
127 if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o;
128 }
129
130 if ($got->parsed('os_code') ) {
131 my $value = $got->getValue('os_code');
132
133 return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'")
134 if $value < 0 || $value > 255 ;
135
136 }
137
138 # gzip only supports Deflate at present
139 $got->setValue('method' => Z_DEFLATED) ;
140
141 if ( ! $got->parsed('extraflags')) {
142 $got->setValue('extraflags' => 2)
143 if $got->getValue('level') == Z_BEST_COMPRESSION ;
144 $got->setValue('extraflags' => 4)
145 if $got->getValue('level') == Z_BEST_SPEED ;
146 }
147
148 my $data = $got->getValue('extrafield') ;
149 if (defined $data) {
150 my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ;
151 return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR)
152 if $bad ;
153
154 $got->setValue('extrafield' => $data) ;
155 }
156 }
157
158 return 1;
159}
160
161sub mkTrailer
162{
163 my $self = shift ;
164 return pack("V V", *$self->{Compress}->crc32(),
165 *$self->{UnCompSize}->get32bit());
166}
167
168sub getInverseClass
169{
170 return ('IO::Uncompress::Gunzip',
171 \$IO::Uncompress::Gunzip::GunzipError);
172}
173
174sub getFileInfo
175{
176 my $self = shift ;
177 my $params = shift;
178 my $filename = shift ;
179
180 return if IO::Compress::Base::Common::isaScalar($filename);
181
182 my $defaultTime = (stat($filename))[9] ;
183
184 $params->setValue('name' => $filename)
185 if ! $params->parsed('name') ;
186
187 $params->setValue('time' => $defaultTime)
188 if ! $params->parsed('time') ;
189}
190
191
192sub mkHeader
193{
194 my $self = shift ;
195 my $param = shift ;
196
197 # short-circuit if a minimal header is requested.
198 return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ;
199
200 # METHOD
201 my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ;
202
203 # FLAGS
204 my $flags = GZIP_FLG_DEFAULT ;
205 $flags |= GZIP_FLG_FTEXT if $param->getValue('textflag') ;
206 $flags |= GZIP_FLG_FHCRC if $param->getValue('headercrc') ;
207 $flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ;
208 $flags |= GZIP_FLG_FNAME if $param->wantValue('name') ;
209 $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ;
210
211 # MTIME
212 my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ;
213
214 # EXTRA FLAGS
215 my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT);
216
217 # OS CODE
218 my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ;
219
220
221 my $out = pack("C4 V C C",
222 GZIP_ID1, # ID1
223 GZIP_ID2, # ID2
224 $method, # Compression Method
225 $flags, # Flags
226 $time, # Modification Time
227 $extra_flags, # Extra Flags
228 $os_code, # Operating System Code
229 ) ;
230
231 # EXTRA
232 if ($flags & GZIP_FLG_FEXTRA) {
233 my $extra = $param->getValue('extrafield') ;
234 $out .= pack("v", length $extra) . $extra ;
235 }
236
237 # NAME
238 if ($flags & GZIP_FLG_FNAME) {
239 my $name .= $param->getValue('name') ;
240 $name =~ s/\x00.*$//;
241 $out .= $name ;
242 # Terminate the filename with NULL unless it already is
243 $out .= GZIP_NULL_BYTE
244 if !length $name or
245 substr($name, 1, -1) ne GZIP_NULL_BYTE ;
246 }
247
248 # COMMENT
249 if ($flags & GZIP_FLG_FCOMMENT) {
250 my $comment .= $param->getValue('comment') ;
251 $comment =~ s/\x00.*$//;
252 $out .= $comment ;
253 # Terminate the comment with NULL unless it already is
254 $out .= GZIP_NULL_BYTE
255 if ! length $comment or
256 substr($comment, 1, -1) ne GZIP_NULL_BYTE;
257 }
258
259 # HEADER CRC
260 $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF )
261 if $param->getValue('headercrc') ;
262
263 noUTF8($out);
264
265 return $out ;
266}
267
268sub mkFinalTrailer
269{
270 return '';
271}
272
273110µs1;
274
275__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.