← 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/Zlib/Extra.pm
StatementsExecuted 12 statements in 1.12ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11128µs32µsIO::Compress::Zlib::Extra::::BEGIN@5IO::Compress::Zlib::Extra::BEGIN@5
11117µs282µsIO::Compress::Zlib::Extra::::BEGIN@13IO::Compress::Zlib::Extra::BEGIN@13
11112µs22µsIO::Compress::Zlib::Extra::::BEGIN@6IO::Compress::Zlib::Extra::BEGIN@6
11111µ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::::findIDIO::Compress::Zlib::Extra::findID
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
3110µsrequire 5.006 ;
4
5238µs236µs
# spent 32µs (28+4) within IO::Compress::Zlib::Extra::BEGIN@5 which was called: # once (28µs+4µs) by IO::Compress::Gzip::BEGIN@16 at line 5
use strict ;
# spent 32µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@5 # spent 4µs making 1 call to strict::import
6230µs232µs
# spent 22µs (12+10) within IO::Compress::Zlib::Extra::BEGIN@6 which was called: # once (12µs+10µs) by IO::Compress::Gzip::BEGIN@16 at line 6
use warnings;
# spent 22µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@6 # spent 10µs making 1 call to warnings::import
7274µs215µs
# spent 13µs (11+2) within IO::Compress::Zlib::Extra::BEGIN@7 which was called: # once (11µs+2µ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 2µs making 1 call to bytes::import
8
9our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
10
1111µs$VERSION = '2.074';
12
133965µs3547µs
# spent 282µs (17+265) within IO::Compress::Zlib::Extra::BEGIN@13 which was called: # once (17µs+265µs) by IO::Compress::Gzip::BEGIN@16 at line 13
use IO::Compress::Gzip::Constants 2.074 ;
# spent 282µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@13 # spent 254µs making 1 call to Exporter::import # spent 11µs making 1 call to version::_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
101sub findID
102{
103 my $id_want = shift ;
104 my $data = shift;
105
106 my $XLEN = length $data ;
107
108 my $offset = 0 ;
109 while ($offset < $XLEN) {
110
111 return undef
112 if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ;
113
114 my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);
115 $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;
116
117 my $subLen = unpack("v", substr($data, $offset,
118 GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
119 $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
120
121 return undef
122 if $offset + $subLen > $XLEN ;
123
124 return substr($data, $offset, $subLen)
125 if $id eq $id_want ;
126
127 $offset += $subLen ;
128 }
129
130 return undef ;
131}
132
133
134sub mkSubField
135{
136 my $id = shift ;
137 my $data = shift ;
138
139 return $id . pack("v", length $data) . $data ;
140}
141
142sub parseExtraField
143{
144 my $dataRef = $_[0];
145 my $strict = $_[1];
146 my $gzipMode = $_[2];
147 #my $lax = @_ == 2 ? $_[1] : 1;
148
149
150 # ExtraField can be any of
151 #
152 # -ExtraField => $data
153 #
154 # -ExtraField => [$id1, $data1,
155 # $id2, $data2]
156 # ...
157 # ]
158 #
159 # -ExtraField => [ [$id1 => $data1],
160 # [$id2 => $data2],
161 # ...
162 # ]
163 #
164 # -ExtraField => { $id1 => $data1,
165 # $id2 => $data2,
166 # ...
167 # }
168
169 if ( ! ref $dataRef ) {
170
171 return undef
172 if ! $strict;
173
174 return parseRawExtra($dataRef, undef, 1, $gzipMode);
175 }
176
177 my $data = $dataRef;
178 my $out = '' ;
179
180 if (ref $data eq 'ARRAY') {
181 if (ref $data->[0]) {
182
183 foreach my $pair (@$data) {
184 return ExtraFieldError("Not list of lists")
185 unless ref $pair eq 'ARRAY' ;
186
187 my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ;
188 return $bad if $bad ;
189
190 $out .= mkSubField(@$pair);
191 }
192 }
193 else {
194 return ExtraFieldError("Not even number of elements")
195 unless @$data % 2 == 0;
196
197 for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) {
198 my $bad = validateExtraFieldPair([$data->[$ix],
199 $data->[$ix+1]],
200 $strict, $gzipMode) ;
201 return $bad if $bad ;
202
203 $out .= mkSubField($data->[$ix], $data->[$ix+1]);
204 }
205 }
206 }
207 elsif (ref $data eq 'HASH') {
208 while (my ($id, $info) = each %$data) {
209 my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode);
210 return $bad if $bad ;
211
212 $out .= mkSubField($id, $info);
213 }
214 }
215 else {
216 return ExtraFieldError("Not a scalar, array ref or hash ref") ;
217 }
218
219 return ExtraFieldError("Too Large")
220 if length $out > GZIP_FEXTRA_MAX_SIZE;
221
222 $_[0] = $out ;
223
224 return undef;
225}
226
22715µs1;
228
229__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.