Profile of /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Compress/Zlib/Extra.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:14 2010

File | /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Compress/Zlib/Extra.pm
Statements Executed | 16
Statement Execution Time | 619µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 15µs | 247µs | IO::Compress::Zlib::Extra::::BEGIN@13IO::Compress::Zlib::Extra::BEGIN@13
1 | 1 | 1 | 15µs | 18µs | IO::Compress::Zlib::Extra::::BEGIN@5IO::Compress::Zlib::Extra::BEGIN@5
1 | 1 | 1 | 7µs | 17µs | IO::Compress::Zlib::Extra::::BEGIN@6IO::Compress::Zlib::Extra::BEGIN@6
1 | 1 | 1 | 7µs | 9µs | IO::Compress::Zlib::Extra::::BEGIN@7IO::Compress::Zlib::Extra::BEGIN@7
0 | 0 | 0 | 0s | 0s | IO::Compress::Zlib::Extra::::ExtraFieldErrorIO::Compress::Zlib::Extra::ExtraFieldError
0 | 0 | 0 | 0s | 0s | IO::Compress::Zlib::Extra::::mkSubFieldIO::Compress::Zlib::Extra::mkSubField
0 | 0 | 0 | 0s | 0s | IO::Compress::Zlib::Extra::::parseExtraFieldIO::Compress::Zlib::Extra::parseExtraField
0 | 0 | 0 | 0s | 0s | IO::Compress::Zlib::Extra::::parseRawExtraIO::Compress::Zlib::Extra::parseRawExtra
0 | 0 | 0 | 0s | 0s | IO::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package IO::Compress::Zlib::Extra;
2 |  |  |  |  |
3 | 1 | 16µs |  |  | require 5.004 ;
4 |  |  |  |  |
5 | 3 | 22µs | 2 | 21µs | # spent 18µs (15+3) within IO::Compress::Zlib::Extra::BEGIN@5 which was called # once (15µs+3µs) by IO::Uncompress::Gunzip::BEGIN@17 at line 5 use strict ; # spent 18µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@5 # spent 3µs making 1 call to strict::import
6 | 3 | 20µs | 2 | 26µs | # spent 17µs (7+9) within IO::Compress::Zlib::Extra::BEGIN@6 which was called # once (7µs+9µs) by IO::Uncompress::Gunzip::BEGIN@17 at line 6 use warnings; # spent 17µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@6 # spent 9µs making 1 call to warnings::import
7 | 3 | 54µs | 2 | 10µs | # spent 9µs (7+2) within IO::Compress::Zlib::Extra::BEGIN@7 which was called # once (7µs+2µs) by IO::Uncompress::Gunzip::BEGIN@17 at line 7 use bytes; # spent 9µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@7 # spent 2µs making 1 call to bytes::import
8 |  |  |  |  |
9 | 1 | 500ns |  |  | our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
10 |  |  |  |  |
11 | 1 | 400ns |  |  | $VERSION = '2.020';
12 |  |  |  |  |
13 | 3 | 495µs | 3 | 479µs | # spent 247µs (15+232) within IO::Compress::Zlib::Extra::BEGIN@13 which was called # once (15µs+232µs) by IO::Uncompress::Gunzip::BEGIN@17 at line 13 use IO::Compress::Gzip::Constants 2.020 ; # spent 247µs making 1 call to IO::Compress::Zlib::Extra::BEGIN@13 # spent 219µs making 1 call to Exporter::import # spent 13µs making 1 call to UNIVERSAL::VERSION
14 |  |  |  |  |
15 |  |  |  |  | sub ExtraFieldError
16 |  |  |  |  | {
17 |  |  |  |  | return $_[0];
18 |  |  |  |  | return "Error with ExtraField Parameter: $_[0]" ;
19 |  |  |  |  | }
20 |  |  |  |  |
21 |  |  |  |  | sub 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 |  |  |  |  |
54 |  |  |  |  | sub 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 |  |  |  |  |
102 |  |  |  |  | sub mkSubField
103 |  |  |  |  | {
104 |  |  |  |  | my $id = shift ;
105 |  |  |  |  | my $data = shift ;
106 |  |  |  |  |
107 |  |  |  |  | return $id . pack("v", length $data) . $data ;
108 |  |  |  |  | }
109 |  |  |  |  |
110 |  |  |  |  | sub 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 |  |  |  |  |
196 | 1 | 11µs |  |  | 1;
197 |  |  |  |  |
198 |  |  |  |  | __END__