← 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:11:21 2013

Filename/usr/lib/perl/5.10/IO/Compress/Base/Common.pm
StatementsExecuted 122 statements in 6.62ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.45ms4.84msIO::Compress::Base::Common::::BEGIN@9 IO::Compress::Base::Common::BEGIN@9
111231µs236µsIO::Compress::Base::Common::::BEGIN@101 IO::Compress::Base::Common::BEGIN@101
11125µs65µsIO::Compress::Base::Common::::BEGIN@476 IO::Compress::Base::Common::BEGIN@476
11124µs29µsIO::Compress::Base::Common::::BEGIN@3 IO::Compress::Base::Common::BEGIN@3
11122µs29µsIO::Compress::Base::Common::::BEGIN@5 IO::Compress::Base::Common::BEGIN@5
11120µs70µsIO::Compress::Base::Common::::BEGIN@42 IO::Compress::Base::Common::BEGIN@42
11118µs68µsIO::Compress::Base::Common::::BEGIN@7 IO::Compress::Base::Common::BEGIN@7
11118µs100µsIO::Compress::Base::Common::::BEGIN@503 IO::Compress::Base::Common::BEGIN@503
11117µs52µsU64::::BEGIN@820 U64::BEGIN@820
11117µs70µsIO::Compress::Base::Common::::BEGIN@130 IO::Compress::Base::Common::BEGIN@130
11116µs91µsIO::Compress::Base::Common::::BEGIN@44 IO::Compress::Base::Common::BEGIN@44
11115µs69µsIO::Compress::Base::Common::::BEGIN@43 IO::Compress::Base::Common::BEGIN@43
11115µs39µsIO::Compress::Base::Common::::BEGIN@4 IO::Compress::Base::Common::BEGIN@4
11113µs60µsIO::Compress::Base::Common::::BEGIN@463 IO::Compress::Base::Common::BEGIN@463
11113µs62µsU64::::BEGIN@818 U64::BEGIN@818
11113µs18µsIO::Compress::Base::Common::::BEGIN@501 IO::Compress::Base::Common::BEGIN@501
11112µs61µsIO::Compress::Base::Common::::BEGIN@461 IO::Compress::Base::Common::BEGIN@461
11112µs71µsIO::Compress::Base::Common::::BEGIN@41 IO::Compress::Base::Common::BEGIN@41
11112µs50µsIO::Compress::Base::Common::::BEGIN@131 IO::Compress::Base::Common::BEGIN@131
11112µs46µsIO::Compress::Base::Common::::BEGIN@478 IO::Compress::Base::Common::BEGIN@478
11111µs54µsIO::Compress::Base::Common::::BEGIN@469 IO::Compress::Base::Common::BEGIN@469
11111µs49µsIO::Compress::Base::Common::::BEGIN@473 IO::Compress::Base::Common::BEGIN@473
11111µs46µsIO::Compress::Base::Common::::BEGIN@470 IO::Compress::Base::Common::BEGIN@470
11111µs49µsIO::Compress::Base::Common::::BEGIN@132 IO::Compress::Base::Common::BEGIN@132
11111µs71µsIO::Compress::Base::Common::::BEGIN@8 IO::Compress::Base::Common::BEGIN@8
11111µs54µsIO::Compress::Base::Common::::BEGIN@471 IO::Compress::Base::Common::BEGIN@471
11110µs32µsIO::Compress::Base::Common::::BEGIN@502 IO::Compress::Base::Common::BEGIN@502
1119µs41µsIO::Compress::Base::Common::::BEGIN@474 IO::Compress::Base::Common::BEGIN@474
1119µs41µsIO::Compress::Base::Common::::BEGIN@477 IO::Compress::Base::Common::BEGIN@477
1119µs42µsIO::Compress::Base::Common::::BEGIN@464 IO::Compress::Base::Common::BEGIN@464
1118µs42µsIO::Compress::Base::Common::::BEGIN@462 IO::Compress::Base::Common::BEGIN@462
1118µs40µsU64::::BEGIN@819 U64::BEGIN@819
1118µs38µsIO::Compress::Base::Common::::BEGIN@475 IO::Compress::Base::Common::BEGIN@475
1118µs39µsIO::Compress::Base::Common::::BEGIN@466 IO::Compress::Base::Common::BEGIN@466
1118µs40µsIO::Compress::Base::Common::::BEGIN@134 IO::Compress::Base::Common::BEGIN@134
1118µs45µsIO::Compress::Base::Common::::BEGIN@465 IO::Compress::Base::Common::BEGIN@465
1117µs7µsIO::Compress::Base::Common::::BEGIN@268 IO::Compress::Base::Common::BEGIN@268
0000s0sIO::Compress::Base::Common::::ParseParameters IO::Compress::Base::Common::ParseParameters
0000s0sIO::Compress::Base::Common::::cleanFileGlobString IO::Compress::Base::Common::cleanFileGlobString
0000s0sIO::Compress::Base::Common::::createSelfTiedObject IO::Compress::Base::Common::createSelfTiedObject
0000s0sIO::Compress::Base::Common::::getEncoding IO::Compress::Base::Common::getEncoding
0000s0sIO::Compress::Base::Common::::hasEncode IO::Compress::Base::Common::hasEncode
0000s0sIO::Compress::Base::Common::::isaFileGlobString IO::Compress::Base::Common::isaFileGlobString
0000s0sIO::Compress::Base::Common::::isaFilehandle IO::Compress::Base::Common::isaFilehandle
0000s0sIO::Compress::Base::Common::::isaFilename IO::Compress::Base::Common::isaFilename
0000s0sIO::Compress::Base::Common::::oneTarget IO::Compress::Base::Common::oneTarget
0000s0sIO::Compress::Base::Common::::setBinModeInput IO::Compress::Base::Common::setBinModeInput
0000s0sIO::Compress::Base::Common::::setBinModeOutput IO::Compress::Base::Common::setBinModeOutput
0000s0sIO::Compress::Base::Common::::whatIs IO::Compress::Base::Common::whatIs
0000s0sIO::Compress::Base::Common::::whatIsInput IO::Compress::Base::Common::whatIsInput
0000s0sIO::Compress::Base::Common::::whatIsOutput IO::Compress::Base::Common::whatIsOutput
0000s0sIO::Compress::Base::Parameters::::_checkTypeIO::Compress::Base::Parameters::_checkType
0000s0sIO::Compress::Base::Parameters::::cloneIO::Compress::Base::Parameters::clone
0000s0sIO::Compress::Base::Parameters::::newIO::Compress::Base::Parameters::new
0000s0sIO::Compress::Base::Parameters::::parseIO::Compress::Base::Parameters::parse
0000s0sIO::Compress::Base::Parameters::::parsedIO::Compress::Base::Parameters::parsed
0000s0sIO::Compress::Base::Parameters::::setErrorIO::Compress::Base::Parameters::setError
0000s0sIO::Compress::Base::Parameters::::valueIO::Compress::Base::Parameters::value
0000s0sIO::Compress::Base::Parameters::::valueOrDefaultIO::Compress::Base::Parameters::valueOrDefault
0000s0sIO::Compress::Base::Parameters::::wantValueIO::Compress::Base::Parameters::wantValue
0000s0sIO::Compress::Base::Validator::::croakError IO::Compress::Base::Validator::croakError
0000s0sIO::Compress::Base::Validator::::new IO::Compress::Base::Validator::new
0000s0sIO::Compress::Base::Validator::::saveErrorString IO::Compress::Base::Validator::saveErrorString
0000s0sIO::Compress::Base::Validator::::validateInputArray IO::Compress::Base::Validator::validateInputArray
0000s0sIO::Compress::Base::Validator::::validateInputFilenames IO::Compress::Base::Validator::validateInputFilenames
0000s0sU64::::add U64::add
0000s0sU64::::clone U64::clone
0000s0sU64::::equal U64::equal
0000s0sU64::::get32bit U64::get32bit
0000s0sU64::::getHigh U64::getHigh
0000s0sU64::::getLow U64::getLow
0000s0sU64::::getPacked_V32 U64::getPacked_V32
0000s0sU64::::getPacked_V64 U64::getPacked_V64
0000s0sU64::::new U64::new
0000s0sU64::::newUnpack_V32 U64::newUnpack_V32
0000s0sU64::::newUnpack_V64 U64::newUnpack_V64
0000s0sU64::::pack_V64 U64::pack_V64
0000s0sU64::::reset U64::reset
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::Base::Common;
2
3332µs234µs
# spent 29µs (24+5) within IO::Compress::Base::Common::BEGIN@3 which was called: # once (24µs+5µs) by Compress::Zlib::BEGIN@11 at line 3
use strict ;
# spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@3 # spent 5µs making 1 call to strict::import
4355µs264µs
# spent 39µs (15+25) within IO::Compress::Base::Common::BEGIN@4 which was called: # once (15µs+25µs) by Compress::Zlib::BEGIN@11 at line 4
use warnings;
# spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@4 # spent 25µs making 1 call to warnings::import
5365µs237µs
# spent 29µs (22+7) within IO::Compress::Base::Common::BEGIN@5 which was called: # once (22µs+7µs) by Compress::Zlib::BEGIN@11 at line 5
use bytes;
# spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@5 # spent 7µs making 1 call to bytes::import
6
7338µs2118µs
# spent 68µs (18+50) within IO::Compress::Base::Common::BEGIN@7 which was called: # once (18µs+50µs) by Compress::Zlib::BEGIN@11 at line 7
use Carp;
# spent 68µs making 1 call to IO::Compress::Base::Common::BEGIN@7 # spent 50µs making 1 call to Exporter::import
8344µs2131µs
# spent 71µs (11+60) within IO::Compress::Base::Common::BEGIN@8 which was called: # once (11µs+60µs) by Compress::Zlib::BEGIN@11 at line 8
use Scalar::Util qw(blessed readonly);
# spent 71µs making 1 call to IO::Compress::Base::Common::BEGIN@8 # spent 60µs making 1 call to Exporter::import
93307µs14.84ms
# spent 4.84ms (2.45+2.39) within IO::Compress::Base::Common::BEGIN@9 which was called: # once (2.45ms+2.39ms) by Compress::Zlib::BEGIN@11 at line 9
use File::GlobMapper;
# spent 4.84ms making 1 call to IO::Compress::Base::Common::BEGIN@9
10
1111µsrequire Exporter;
1211µsour ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
13111µs@ISA = qw(Exporter);
141500ns$VERSION = '2.020';
15
1614µs@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput
17 isaFileGlobString cleanFileGlobString oneTarget
18 setBinModeInput setBinModeOutput
19 ckInOutParams
20 createSelfTiedObject
21 getEncoding
22
23 WANT_CODE
24 WANT_EXT
25 WANT_UNDEF
26 WANT_HASH
27
28 STATUS_OK
29 STATUS_ENDSTREAM
30 STATUS_EOF
31 STATUS_ERROR
32 );
33
3412µs%EXPORT_TAGS = ( Status => [qw( STATUS_OK
35 STATUS_ENDSTREAM
36 STATUS_EOF
37 STATUS_ERROR
38 )]);
39
40
41357µs2130µs
# spent 71µs (12+59) within IO::Compress::Base::Common::BEGIN@41 which was called: # once (12µs+59µs) by Compress::Zlib::BEGIN@11 at line 41
use constant STATUS_OK => 0;
# spent 71µs making 1 call to IO::Compress::Base::Common::BEGIN@41 # spent 59µs making 1 call to constant::import
42347µs2120µs
# spent 70µs (20+50) within IO::Compress::Base::Common::BEGIN@42 which was called: # once (20µs+50µs) by Compress::Zlib::BEGIN@11 at line 42
use constant STATUS_ENDSTREAM => 1;
# spent 70µs making 1 call to IO::Compress::Base::Common::BEGIN@42 # spent 50µs making 1 call to constant::import
433100µs2123µs
# spent 69µs (15+54) within IO::Compress::Base::Common::BEGIN@43 which was called: # once (15µs+54µs) by Compress::Zlib::BEGIN@11 at line 43
use constant STATUS_EOF => 2;
# spent 69µs making 1 call to IO::Compress::Base::Common::BEGIN@43 # spent 54µs making 1 call to constant::import
443419µs2166µs
# spent 91µs (16+75) within IO::Compress::Base::Common::BEGIN@44 which was called: # once (16µs+75µs) by Compress::Zlib::BEGIN@11 at line 44
use constant STATUS_ERROR => -1;
# spent 91µs making 1 call to IO::Compress::Base::Common::BEGIN@44 # spent 75µs making 1 call to constant::import
45
46sub hasEncode()
47{
48 if (! defined $HAS_ENCODE) {
49 eval
50 {
51 require Encode;
52 Encode->import();
53 };
54
55 $HAS_ENCODE = $@ ? 0 : 1 ;
56 }
57
58 return $HAS_ENCODE;
59}
60
61sub getEncoding($$$)
62{
63 my $obj = shift;
64 my $class = shift ;
65 my $want_encoding = shift ;
66
67 $obj->croakError("$class: Encode module needed to use -Encode")
68 if ! hasEncode();
69
70 my $encoding = Encode::find_encoding($want_encoding);
71
72 $obj->croakError("$class: Encoding '$want_encoding' is not available")
73 if ! $encoding;
74
75 return $encoding;
76}
77
781200nsour ($needBinmode);
79136µs$needBinmode = ($^O eq 'MSWin32' ||
# spent 6µs executing statements in string eval
80 ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} '))
81 ? 1 : 1 ;
82
83sub setBinModeInput($)
84{
85 my $handle = shift ;
86
87 binmode $handle
88 if $needBinmode;
89}
90
91sub setBinModeOutput($)
92{
93 my $handle = shift ;
94
95 binmode $handle
96 if $needBinmode;
97}
98
99sub isaFilehandle($)
100{
1013427µs2242µs
# spent 236µs (231+5) within IO::Compress::Base::Common::BEGIN@101 which was called: # once (231µs+5µs) by Compress::Zlib::BEGIN@11 at line 101
use utf8; # Pragma needed to keep Perl 5.6.0 happy
# spent 236µs making 1 call to IO::Compress::Base::Common::BEGIN@101 # spent 5µs making 1 call to utf8::import
102 return (defined $_[0] and
103 (UNIVERSAL::isa($_[0],'GLOB') or
104 UNIVERSAL::isa($_[0],'IO::Handle') or
105 UNIVERSAL::isa(\$_[0],'GLOB'))
106 )
107}
108
109sub isaFilename($)
110{
111 return (defined $_[0] and
112 ! ref $_[0] and
113 UNIVERSAL::isa(\$_[0], 'SCALAR'));
114}
115
116sub isaFileGlobString
117{
118 return defined $_[0] && $_[0] =~ /^<.*>$/;
119}
120
121sub cleanFileGlobString
122{
123 my $string = shift ;
124
125 $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
126
127 return $string;
128}
129
130339µs2123µs
# spent 70µs (17+53) within IO::Compress::Base::Common::BEGIN@130 which was called: # once (17µs+53µs) by Compress::Zlib::BEGIN@11 at line 130
use constant WANT_CODE => 1 ;
# spent 70µs making 1 call to IO::Compress::Base::Common::BEGIN@130 # spent 53µs making 1 call to constant::import
131360µs289µs
# spent 50µs (12+39) within IO::Compress::Base::Common::BEGIN@131 which was called: # once (12µs+39µs) by Compress::Zlib::BEGIN@11 at line 131
use constant WANT_EXT => 2 ;
# spent 50µs making 1 call to IO::Compress::Base::Common::BEGIN@131 # spent 39µs making 1 call to constant::import
132333µs288µs
# spent 49µs (11+38) within IO::Compress::Base::Common::BEGIN@132 which was called: # once (11µs+38µs) by Compress::Zlib::BEGIN@11 at line 132
use constant WANT_UNDEF => 4 ;
# spent 49µs making 1 call to IO::Compress::Base::Common::BEGIN@132 # spent 38µs making 1 call to constant::import
133#use constant WANT_HASH => 8 ;
1343762µs273µs
# spent 40µs (8+32) within IO::Compress::Base::Common::BEGIN@134 which was called: # once (8µs+32µs) by Compress::Zlib::BEGIN@11 at line 134
use constant WANT_HASH => 0 ;
# spent 40µs making 1 call to IO::Compress::Base::Common::BEGIN@134 # spent 32µs making 1 call to constant::import
135
136sub whatIsInput($;$)
137{
138 my $got = whatIs(@_);
139
140 if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
141 {
142 #use IO::File;
143 $got = 'handle';
144 $_[0] = *STDIN;
145 #$_[0] = new IO::File("<-");
146 }
147
148 return $got;
149}
150
151sub whatIsOutput($;$)
152{
153 my $got = whatIs(@_);
154
155 if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
156 {
157 $got = 'handle';
158 $_[0] = *STDOUT;
159 #$_[0] = new IO::File(">-");
160 }
161
162 return $got;
163}
164
165sub whatIs ($;$)
166{
167 return 'handle' if isaFilehandle($_[0]);
168
169 my $wantCode = defined $_[1] && $_[1] & WANT_CODE ;
170 my $extended = defined $_[1] && $_[1] & WANT_EXT ;
171 my $undef = defined $_[1] && $_[1] & WANT_UNDEF ;
172 my $hash = defined $_[1] && $_[1] & WANT_HASH ;
173
174 return 'undef' if ! defined $_[0] && $undef ;
175
176 if (ref $_[0]) {
177 return '' if blessed($_[0]); # is an object
178 #return '' if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object
179 return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR');
180 return 'array' if UNIVERSAL::isa($_[0], 'ARRAY') && $extended ;
181 return 'hash' if UNIVERSAL::isa($_[0], 'HASH') && $hash ;
182 return 'code' if UNIVERSAL::isa($_[0], 'CODE') && $wantCode ;
183 return '';
184 }
185
186 return 'fileglob' if $extended && isaFileGlobString($_[0]);
187 return 'filename';
188}
189
190sub oneTarget
191{
192 return $_[0] =~ /^(code|handle|buffer|filename)$/;
193}
194
195sub IO::Compress::Base::Validator::new
196{
197 my $class = shift ;
198
199 my $Class = shift ;
200 my $error_ref = shift ;
201 my $reportClass = shift ;
202
203 my %data = (Class => $Class,
204 Error => $error_ref,
205 reportClass => $reportClass,
206 ) ;
207
208 my $obj = bless \%data, $class ;
209
210 local $Carp::CarpLevel = 1;
211
212 my $inType = $data{inType} = whatIsInput($_[0], WANT_EXT|WANT_HASH);
213 my $outType = $data{outType} = whatIsOutput($_[1], WANT_EXT|WANT_HASH);
214
215 my $oneInput = $data{oneInput} = oneTarget($inType);
216 my $oneOutput = $data{oneOutput} = oneTarget($outType);
217
218 if (! $inType)
219 {
220 $obj->croakError("$reportClass: illegal input parameter") ;
221 #return undef ;
222 }
223
224# if ($inType eq 'hash')
225# {
226# $obj->{Hash} = 1 ;
227# $obj->{oneInput} = 1 ;
228# return $obj->validateHash($_[0]);
229# }
230
231 if (! $outType)
232 {
233 $obj->croakError("$reportClass: illegal output parameter") ;
234 #return undef ;
235 }
236
237
238 if ($inType ne 'fileglob' && $outType eq 'fileglob')
239 {
240 $obj->croakError("Need input fileglob for outout fileglob");
241 }
242
243# if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' )
244# {
245# $obj->croakError("input must ne filename or fileglob when output is a hash");
246# }
247
248 if ($inType eq 'fileglob' && $outType eq 'fileglob')
249 {
250 $data{GlobMap} = 1 ;
251 $data{inType} = $data{outType} = 'filename';
252 my $mapper = new File::GlobMapper($_[0], $_[1]);
253 if ( ! $mapper )
254 {
255 return $obj->saveErrorString($File::GlobMapper::Error) ;
256 }
257 $data{Pairs} = $mapper->getFileMap();
258
259 return $obj;
260 }
261
262 $obj->croakError("$reportClass: input and output $inType are identical")
263 if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ;
264
265 if ($inType eq 'fileglob') # && $outType ne 'fileglob'
266 {
267 my $glob = cleanFileGlobString($_[0]);
2683966µs17µs
# spent 7µs within IO::Compress::Base::Common::BEGIN@268 which was called: # once (7µs+0s) by Compress::Zlib::BEGIN@11 at line 268
my @inputs = glob($glob);
# spent 7µs making 1 call to IO::Compress::Base::Common::BEGIN@268
269
270 if (@inputs == 0)
271 {
272 # TODO -- legal or die?
273 die "globmap matched zero file -- legal or die???" ;
274 }
275 elsif (@inputs == 1)
276 {
277 $obj->validateInputFilenames($inputs[0])
278 or return undef;
279 $_[0] = $inputs[0] ;
280 $data{inType} = 'filename' ;
281 $data{oneInput} = 1;
282 }
283 else
284 {
285 $obj->validateInputFilenames(@inputs)
286 or return undef;
287 $_[0] = [ @inputs ] ;
288 $data{inType} = 'filenames' ;
289 }
290 }
291 elsif ($inType eq 'filename')
292 {
293 $obj->validateInputFilenames($_[0])
294 or return undef;
295 }
296 elsif ($inType eq 'array')
297 {
298 $data{inType} = 'filenames' ;
299 $obj->validateInputArray($_[0])
300 or return undef ;
301 }
302
303 return $obj->saveErrorString("$reportClass: output buffer is read-only")
304 if $outType eq 'buffer' && readonly(${ $_[1] });
305
306 if ($outType eq 'filename' )
307 {
308 $obj->croakError("$reportClass: output filename is undef or null string")
309 if ! defined $_[1] || $_[1] eq '' ;
310
311 if (-e $_[1])
312 {
313 if (-d _ )
314 {
315 return $obj->saveErrorString("output file '$_[1]' is a directory");
316 }
317 }
318 }
319
320 return $obj ;
321}
322
323sub IO::Compress::Base::Validator::saveErrorString
324{
325 my $self = shift ;
326 ${ $self->{Error} } = shift ;
327 return undef;
328
329}
330
331sub IO::Compress::Base::Validator::croakError
332{
333 my $self = shift ;
334 $self->saveErrorString($_[0]);
335 croak $_[0];
336}
337
- -
340sub IO::Compress::Base::Validator::validateInputFilenames
341{
342 my $self = shift ;
343
344 foreach my $filename (@_)
345 {
346 $self->croakError("$self->{reportClass}: input filename is undef or null string")
347 if ! defined $filename || $filename eq '' ;
348
349 next if $filename eq '-';
350
351 if (! -e $filename )
352 {
353 return $self->saveErrorString("input file '$filename' does not exist");
354 }
355
356 if (-d _ )
357 {
358 return $self->saveErrorString("input file '$filename' is a directory");
359 }
360
361 if (! -r _ )
362 {
363 return $self->saveErrorString("cannot open file '$filename': $!");
364 }
365 }
366
367 return 1 ;
368}
369
370sub IO::Compress::Base::Validator::validateInputArray
371{
372 my $self = shift ;
373
374 if ( @{ $_[0] } == 0 )
375 {
376 return $self->saveErrorString("empty array reference") ;
377 }
378
379 foreach my $element ( @{ $_[0] } )
380 {
381 my $inType = whatIsInput($element);
382
383 if (! $inType)
384 {
385 $self->croakError("unknown input parameter") ;
386 }
387 elsif($inType eq 'filename')
388 {
389 $self->validateInputFilenames($element)
390 or return undef ;
391 }
392 else
393 {
394 $self->croakError("not a filename") ;
395 }
396 }
397
398 return 1 ;
399}
400
401#sub IO::Compress::Base::Validator::validateHash
402#{
403# my $self = shift ;
404# my $href = shift ;
405#
406# while (my($k, $v) = each %$href)
407# {
408# my $ktype = whatIsInput($k);
409# my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ;
410#
411# if ($ktype ne 'filename')
412# {
413# return $self->saveErrorString("hash key not filename") ;
414# }
415#
416# my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ;
417# if (! $valid{$vtype})
418# {
419# return $self->saveErrorString("hash value not ok") ;
420# }
421# }
422#
423# return $self ;
424#}
425
426sub createSelfTiedObject
427{
428 my $class = shift || (caller)[0] ;
429 my $error_ref = shift ;
430
431 my $obj = bless Symbol::gensym(), ref($class) || $class;
432 tie *$obj, $obj if $] >= 5.005;
433 *$obj->{Closed} = 1 ;
434 $$error_ref = '';
435 *$obj->{Error} = $error_ref ;
436 my $errno = 0 ;
437 *$obj->{ErrorNo} = \$errno ;
438
439 return $obj;
440}
441
- -
444#package Parse::Parameters ;
445#
446#
447#require Exporter;
448#our ($VERSION, @ISA, @EXPORT);
449#$VERSION = '2.000_08';
450#@ISA = qw(Exporter);
451
45213µs$EXPORT_TAGS{Parse} = [qw( ParseParameters
453 Parse_any Parse_unsigned Parse_signed
454 Parse_boolean Parse_custom Parse_string
455 Parse_multiple Parse_writable_scalar
456 )
457 ];
458
45913µspush @EXPORT, @{ $EXPORT_TAGS{Parse} } ;
460
461337µs2109µs
# spent 61µs (12+49) within IO::Compress::Base::Common::BEGIN@461 which was called: # once (12µs+49µs) by Compress::Zlib::BEGIN@11 at line 461
use constant Parse_any => 0x01;
# spent 61µs making 1 call to IO::Compress::Base::Common::BEGIN@461 # spent 49µs making 1 call to constant::import
462337µs275µs
# spent 42µs (8+33) within IO::Compress::Base::Common::BEGIN@462 which was called: # once (8µs+33µs) by Compress::Zlib::BEGIN@11 at line 462
use constant Parse_unsigned => 0x02;
# spent 42µs making 1 call to IO::Compress::Base::Common::BEGIN@462 # spent 33µs making 1 call to constant::import
463335µs2107µs
# spent 60µs (13+47) within IO::Compress::Base::Common::BEGIN@463 which was called: # once (13µs+47µs) by Compress::Zlib::BEGIN@11 at line 463
use constant Parse_signed => 0x04;
# spent 60µs making 1 call to IO::Compress::Base::Common::BEGIN@463 # spent 47µs making 1 call to constant::import
464329µs276µs
# spent 42µs (9+34) within IO::Compress::Base::Common::BEGIN@464 which was called: # once (9µs+34µs) by Compress::Zlib::BEGIN@11 at line 464
use constant Parse_boolean => 0x08;
# spent 42µs making 1 call to IO::Compress::Base::Common::BEGIN@464 # spent 34µs making 1 call to constant::import
465330µs282µs
# spent 45µs (8+37) within IO::Compress::Base::Common::BEGIN@465 which was called: # once (8µs+37µs) by Compress::Zlib::BEGIN@11 at line 465
use constant Parse_string => 0x10;
# spent 45µs making 1 call to IO::Compress::Base::Common::BEGIN@465 # spent 37µs making 1 call to constant::import
466330µs269µs
# spent 39µs (8+31) within IO::Compress::Base::Common::BEGIN@466 which was called: # once (8µs+31µs) by Compress::Zlib::BEGIN@11 at line 466
use constant Parse_custom => 0x12;
# spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@466 # spent 31µs making 1 call to constant::import
467
468#use constant Parse_store_ref => 0x100 ;
469337µs296µs
# spent 54µs (11+42) within IO::Compress::Base::Common::BEGIN@469 which was called: # once (11µs+42µs) by Compress::Zlib::BEGIN@11 at line 469
use constant Parse_multiple => 0x100 ;
# spent 54µs making 1 call to IO::Compress::Base::Common::BEGIN@469 # spent 42µs making 1 call to constant::import
470364µs280µs
# spent 46µs (11+35) within IO::Compress::Base::Common::BEGIN@470 which was called: # once (11µs+35µs) by Compress::Zlib::BEGIN@11 at line 470
use constant Parse_writable => 0x200 ;
# spent 46µs making 1 call to IO::Compress::Base::Common::BEGIN@470 # spent 35µs making 1 call to constant::import
471351µs298µs
# spent 54µs (11+44) within IO::Compress::Base::Common::BEGIN@471 which was called: # once (11µs+44µs) by Compress::Zlib::BEGIN@11 at line 471
use constant Parse_writable_scalar => 0x400 | Parse_writable ;
# spent 54µs making 1 call to IO::Compress::Base::Common::BEGIN@471 # spent 44µs making 1 call to constant::import
472
473334µs287µs
# spent 49µs (11+38) within IO::Compress::Base::Common::BEGIN@473 which was called: # once (11µs+38µs) by Compress::Zlib::BEGIN@11 at line 473
use constant OFF_PARSED => 0 ;
# spent 49µs making 1 call to IO::Compress::Base::Common::BEGIN@473 # spent 38µs making 1 call to constant::import
474329µs273µs
# spent 41µs (9+32) within IO::Compress::Base::Common::BEGIN@474 which was called: # once (9µs+32µs) by Compress::Zlib::BEGIN@11 at line 474
use constant OFF_TYPE => 1 ;
# spent 41µs making 1 call to IO::Compress::Base::Common::BEGIN@474 # spent 32µs making 1 call to constant::import
475351µs269µs
# spent 38µs (8+30) within IO::Compress::Base::Common::BEGIN@475 which was called: # once (8µs+30µs) by Compress::Zlib::BEGIN@11 at line 475
use constant OFF_DEFAULT => 2 ;
# spent 38µs making 1 call to IO::Compress::Base::Common::BEGIN@475 # spent 30µs making 1 call to constant::import
476336µs2105µs
# spent 65µs (25+40) within IO::Compress::Base::Common::BEGIN@476 which was called: # once (25µs+40µs) by Compress::Zlib::BEGIN@11 at line 476
use constant OFF_FIXED => 3 ;
# spent 65µs making 1 call to IO::Compress::Base::Common::BEGIN@476 # spent 40µs making 1 call to constant::import
477329µs274µs
# spent 41µs (9+33) within IO::Compress::Base::Common::BEGIN@477 which was called: # once (9µs+33µs) by Compress::Zlib::BEGIN@11 at line 477
use constant OFF_FIRST_ONLY => 4 ;
# spent 41µs making 1 call to IO::Compress::Base::Common::BEGIN@477 # spent 33µs making 1 call to constant::import
4783147µs280µs
# spent 46µs (12+34) within IO::Compress::Base::Common::BEGIN@478 which was called: # once (12µs+34µs) by Compress::Zlib::BEGIN@11 at line 478
use constant OFF_STICKY => 5 ;
# spent 46µs making 1 call to IO::Compress::Base::Common::BEGIN@478 # spent 34µs making 1 call to constant::import
479
- -
482sub ParseParameters
483{
484 my $level = shift || 0 ;
485
486 my $sub = (caller($level + 1))[3] ;
487 local $Carp::CarpLevel = 1 ;
488
489 return $_[1]
490 if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters");
491
492 my $p = new IO::Compress::Base::Parameters() ;
493 $p->parse(@_)
494 or croak "$sub: $p->{Error}" ;
495
496 return $p;
497}
498
499#package IO::Compress::Base::Parameters;
500
501328µs223µs
# spent 18µs (13+5) within IO::Compress::Base::Common::BEGIN@501 which was called: # once (13µs+5µs) by Compress::Zlib::BEGIN@11 at line 501
use strict;
# spent 18µs making 1 call to IO::Compress::Base::Common::BEGIN@501 # spent 5µs making 1 call to strict::import
502335µs254µs
# spent 32µs (10+22) within IO::Compress::Base::Common::BEGIN@502 which was called: # once (10µs+22µs) by Compress::Zlib::BEGIN@11 at line 502
use warnings;
# spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@502 # spent 22µs making 1 call to warnings::import
50331.62ms2181µs
# spent 100µs (18+81) within IO::Compress::Base::Common::BEGIN@503 which was called: # once (18µs+81µs) by Compress::Zlib::BEGIN@11 at line 503
use Carp;
# spent 100µs making 1 call to IO::Compress::Base::Common::BEGIN@503 # spent 81µs making 1 call to Exporter::import
504
505sub IO::Compress::Base::Parameters::new
506{
507 my $class = shift ;
508
509 my $obj = { Error => '',
510 Got => {},
511 } ;
512
513 #return bless $obj, ref($class) || $class || __PACKAGE__ ;
514 return bless $obj, 'IO::Compress::Base::Parameters' ;
515}
516
517sub IO::Compress::Base::Parameters::setError
518{
519 my $self = shift ;
520 my $error = shift ;
521 my $retval = @_ ? shift : undef ;
522
523 $self->{Error} = $error ;
524 return $retval;
525}
526
527#sub getError
528#{
529# my $self = shift ;
530# return $self->{Error} ;
531#}
532
533sub IO::Compress::Base::Parameters::parse
534{
535 my $self = shift ;
536
537 my $default = shift ;
538
539 my $got = $self->{Got} ;
540 my $firstTime = keys %{ $got } == 0 ;
541 my $other;
542
543 my (@Bad) ;
544 my @entered = () ;
545
546 # Allow the options to be passed as a hash reference or
547 # as the complete hash.
548 if (@_ == 0) {
549 @entered = () ;
550 }
551 elsif (@_ == 1) {
552 my $href = $_[0] ;
553
554 return $self->setError("Expected even number of parameters, got 1")
555 if ! defined $href or ! ref $href or ref $href ne "HASH" ;
556
557 foreach my $key (keys %$href) {
558 push @entered, $key ;
559 push @entered, \$href->{$key} ;
560 }
561 }
562 else {
563 my $count = @_;
564 return $self->setError("Expected even number of parameters, got $count")
565 if $count % 2 != 0 ;
566
567 for my $i (0.. $count / 2 - 1) {
568 if ($_[2 * $i] eq '__xxx__') {
569 $other = $_[2 * $i + 1] ;
570 }
571 else {
572 push @entered, $_[2 * $i] ;
573 push @entered, \$_[2 * $i + 1] ;
574 }
575 }
576 }
577
578
579 while (my ($key, $v) = each %$default)
580 {
581 croak "need 4 params [@$v]"
582 if @$v != 4 ;
583
584 my ($first_only, $sticky, $type, $value) = @$v ;
585 my $x ;
586 $self->_checkType($key, \$value, $type, 0, \$x)
587 or return undef ;
588
589 $key = lc $key;
590
591 if ($firstTime || ! $sticky) {
592 $x = [ $x ]
593 if $type & Parse_multiple;
594
595 $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
596 }
597
598 $got->{$key}[OFF_PARSED] = 0 ;
599 }
600
601 my %parsed = ();
602
603 if ($other)
604 {
605 for my $key (keys %$default)
606 {
607 my $canonkey = lc $key;
608 if ($other->parsed($canonkey))
609 {
610 my $value = $other->value($canonkey);
611#print "SET '$canonkey' to $value [$$value]\n";
612 ++ $parsed{$canonkey};
613 $got->{$canonkey}[OFF_PARSED] = 1;
614 $got->{$canonkey}[OFF_DEFAULT] = $value;
615 $got->{$canonkey}[OFF_FIXED] = $value;
616 }
617 }
618 }
619
620 for my $i (0.. @entered / 2 - 1) {
621 my $key = $entered[2* $i] ;
622 my $value = $entered[2* $i+1] ;
623
624 #print "Key [$key] Value [$value]" ;
625 #print defined $$value ? "[$$value]\n" : "[undef]\n";
626
627 $key =~ s/^-// ;
628 my $canonkey = lc $key;
629
630 if ($got->{$canonkey} && ($firstTime ||
631 ! $got->{$canonkey}[OFF_FIRST_ONLY] ))
632 {
633 my $type = $got->{$canonkey}[OFF_TYPE] ;
634 my $parsed = $parsed{$canonkey};
635 ++ $parsed{$canonkey};
636
637 return $self->setError("Muliple instances of '$key' found")
638 if $parsed && $type & Parse_multiple == 0 ;
639
640 my $s ;
641 $self->_checkType($key, $value, $type, 1, \$s)
642 or return undef ;
643
644 $value = $$value ;
645 if ($type & Parse_multiple) {
646 $got->{$canonkey}[OFF_PARSED] = 1;
647 push @{ $got->{$canonkey}[OFF_FIXED] }, $s ;
648 }
649 else {
650 $got->{$canonkey} = [1, $type, $value, $s] ;
651 }
652 }
653 else
654 { push (@Bad, $key) }
655 }
656
657 if (@Bad) {
658 my ($bad) = join(", ", @Bad) ;
659 return $self->setError("unknown key value(s) @Bad") ;
660 }
661
662 return 1;
663}
664
665sub IO::Compress::Base::Parameters::_checkType
666{
667 my $self = shift ;
668
669 my $key = shift ;
670 my $value = shift ;
671 my $type = shift ;
672 my $validate = shift ;
673 my $output = shift;
674
675 #local $Carp::CarpLevel = $level ;
676 #print "PARSE $type $key $value $validate $sub\n" ;
677
678 if ($type & Parse_writable_scalar)
679 {
680 return $self->setError("Parameter '$key' not writable")
681 if $validate && readonly $$value ;
682
683 if (ref $$value)
684 {
685 return $self->setError("Parameter '$key' not a scalar reference")
686 if $validate && ref $$value ne 'SCALAR' ;
687
688 $$output = $$value ;
689 }
690 else
691 {
692 return $self->setError("Parameter '$key' not a scalar")
693 if $validate && ref $value ne 'SCALAR' ;
694
695 $$output = $value ;
696 }
697
698 return 1;
699 }
700
701# if ($type & Parse_store_ref)
702# {
703# #$value = $$value
704# # if ref ${ $value } ;
705#
706# $$output = $value ;
707# return 1;
708# }
709
710 $value = $$value ;
711
712 if ($type & Parse_any)
713 {
714 $$output = $value ;
715 return 1;
716 }
717 elsif ($type & Parse_unsigned)
718 {
719 return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
720 if $validate && ! defined $value ;
721 return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
722 if $validate && $value !~ /^\d+$/;
723
724 $$output = defined $value ? $value : 0 ;
725 return 1;
726 }
727 elsif ($type & Parse_signed)
728 {
729 return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
730 if $validate && ! defined $value ;
731 return $self->setError("Parameter '$key' must be a signed int, got '$value'")
732 if $validate && $value !~ /^-?\d+$/;
733
734 $$output = defined $value ? $value : 0 ;
735 return 1 ;
736 }
737 elsif ($type & Parse_boolean)
738 {
739 return $self->setError("Parameter '$key' must be an int, got '$value'")
740 if $validate && defined $value && $value !~ /^\d*$/;
741 $$output = defined $value ? $value != 0 : 0 ;
742 return 1;
743 }
744 elsif ($type & Parse_string)
745 {
746 $$output = defined $value ? $value : "" ;
747 return 1;
748 }
749
750 $$output = $value ;
751 return 1;
752}
753
- -
756sub IO::Compress::Base::Parameters::parsed
757{
758 my $self = shift ;
759 my $name = shift ;
760
761 return $self->{Got}{lc $name}[OFF_PARSED] ;
762}
763
764sub IO::Compress::Base::Parameters::value
765{
766 my $self = shift ;
767 my $name = shift ;
768
769 if (@_)
770 {
771 $self->{Got}{lc $name}[OFF_PARSED] = 1;
772 $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ;
773 $self->{Got}{lc $name}[OFF_FIXED] = $_[0] ;
774 }
775
776 return $self->{Got}{lc $name}[OFF_FIXED] ;
777}
778
779sub IO::Compress::Base::Parameters::valueOrDefault
780{
781 my $self = shift ;
782 my $name = shift ;
783 my $default = shift ;
784
785 my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ;
786
787 return $value if defined $value ;
788 return $default ;
789}
790
791sub IO::Compress::Base::Parameters::wantValue
792{
793 my $self = shift ;
794 my $name = shift ;
795
796 return defined $self->{Got}{lc $name}[OFF_DEFAULT] ;
797
798}
799
800sub IO::Compress::Base::Parameters::clone
801{
802 my $self = shift ;
803 my $obj = { };
804 my %got ;
805
806 while (my ($k, $v) = each %{ $self->{Got} }) {
807 $got{$k} = [ @$v ];
808 }
809
810 $obj->{Error} = $self->{Error};
811 $obj->{Got} = \%got ;
812
813 return bless $obj, 'IO::Compress::Base::Parameters' ;
814}
815
816package U64;
817
818343µs2111µs
# spent 62µs (13+49) within U64::BEGIN@818 which was called: # once (13µs+49µs) by Compress::Zlib::BEGIN@11 at line 818
use constant MAX32 => 0xFFFFFFFF ;
# spent 62µs making 1 call to U64::BEGIN@818 # spent 49µs making 1 call to constant::import
819329µs272µs
# spent 40µs (8+32) within U64::BEGIN@819 which was called: # once (8µs+32µs) by Compress::Zlib::BEGIN@11 at line 819
use constant LOW => 0 ;
# spent 40µs making 1 call to U64::BEGIN@819 # spent 32µs making 1 call to constant::import
8203663µs287µs
# spent 52µs (17+35) within U64::BEGIN@820 which was called: # once (17µs+35µs) by Compress::Zlib::BEGIN@11 at line 820
use constant HIGH => 1;
# spent 52µs making 1 call to U64::BEGIN@820 # spent 35µs making 1 call to constant::import
821
822sub new
823{
824 my $class = shift ;
825
826 my $high = 0 ;
827 my $low = 0 ;
828
829 if (@_ == 2) {
830 $high = shift ;
831 $low = shift ;
832 }
833 elsif (@_ == 1) {
834 $low = shift ;
835 }
836
837 bless [$low, $high], $class;
838}
839
840sub newUnpack_V64
841{
842 my $string = shift;
843
844 my ($low, $hi) = unpack "V V", $string ;
845 bless [ $low, $hi ], "U64";
846}
847
848sub newUnpack_V32
849{
850 my $string = shift;
851
852 my $low = unpack "V", $string ;
853 bless [ $low, 0 ], "U64";
854}
855
856sub reset
857{
858 my $self = shift;
859 $self->[HIGH] = $self->[LOW] = 0;
860}
861
862sub clone
863{
864 my $self = shift;
865 bless [ @$self ], ref $self ;
866}
867
868sub getHigh
869{
870 my $self = shift;
871 return $self->[HIGH];
872}
873
874sub getLow
875{
876 my $self = shift;
877 return $self->[LOW];
878}
879
880sub get32bit
881{
882 my $self = shift;
883 return $self->[LOW];
884}
885
886sub add
887{
888 my $self = shift;
889 my $value = shift;
890
891 if (ref $value eq 'U64') {
892 $self->[HIGH] += $value->[HIGH] ;
893 $value = $value->[LOW];
894 }
895
896 my $available = MAX32 - $self->[LOW] ;
897
898 if ($value > $available) {
899 ++ $self->[HIGH] ;
900 $self->[LOW] = $value - $available - 1;
901 }
902 else {
903 $self->[LOW] += $value ;
904 }
905}
906
907sub equal
908{
909 my $self = shift;
910 my $other = shift;
911
912 return $self->[LOW] == $other->[LOW] &&
913 $self->[HIGH] == $other->[HIGH] ;
914}
915
916sub getPacked_V64
917{
918 my $self = shift;
919
920 return pack "V V", @$self ;
921}
922
923sub getPacked_V32
924{
925 my $self = shift;
926
927 return pack "V", $self->[LOW] ;
928}
929
930sub pack_V64
931{
932 my $low = shift;
933
934 return pack "V V", $low, 0;
935}
936
937
938package IO::Compress::Base::Common;
939
940113µs1;
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.