← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:47 2010

File/opt/wise/lib/perl5/5.10.0/x86_64-linux-thread-multi/IO/Compress/Zlib/Extra.pm
Statements Executed16
Total Time0.000894 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
00000IO::Compress::Zlib::Extra::BEGIN
00000IO::Compress::Zlib::Extra::ExtraFieldError
00000IO::Compress::Zlib::Extra::mkSubField
00000IO::Compress::Zlib::Extra::parseExtraField
00000IO::Compress::Zlib::Extra::parseRawExtra
00000IO::Compress::Zlib::Extra::validateExtraFieldPair

LineStmts.Exclusive
Time		Avg.Code
1package IO::Compress::Zlib::Extra;
2
311.7e-51.7e-5require 5.004 ;
4
532.8e-59.3e-6use strict ;
# spent 9µs making 1 call to strict::import
633.3e-51.1e-5use warnings;
# spent 24µs making 1 call to warnings::import
736.4e-52.1e-5use bytes;
# spent 6µs making 1 call to bytes::import
8
9100our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
10
1111.0e-61.0e-6$VERSION = '2.008';
12
1330.000750.00025use IO::Compress::Gzip::Constants 2.008 ;
# spent 271µs making 1 call to Exporter::import # spent 26µ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
19615.0e-65.0e-61;
197
198__END__

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.