← 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/Base.pm
StatementsExecuted 52 statements in 5.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11126µs29µsIO::Compress::Base::::BEGIN@6IO::Compress::Base::BEGIN@6
11120µs49µsIO::Compress::Base::::BEGIN@914IO::Compress::Base::BEGIN@914
11117µs27µsIO::Compress::Base::::BEGIN@7IO::Compress::Base::BEGIN@7
66116µs16µsIO::Compress::Base::::_notAvailableIO::Compress::Base::_notAvailable
11116µs178µsIO::Compress::Base::::BEGIN@9IO::Compress::Base::BEGIN@9
11115µs33µsIO::Compress::Base::::BEGIN@278IO::Compress::Base::BEGIN@278
1115µs5µsIO::Compress::Base::::BEGIN@11IO::Compress::Base::BEGIN@11
1115µs5µsIO::Compress::Base::::BEGIN@12IO::Compress::Base::BEGIN@12
1115µs5µsIO::Compress::Base::::BEGIN@16IO::Compress::Base::BEGIN@16
1114µs4µsIO::Compress::Base::::BEGIN@17IO::Compress::Base::BEGIN@17
0000s0sIO::Compress::Base::::DESTROYIO::Compress::Base::DESTROY
0000s0sIO::Compress::Base::::TIEHANDLEIO::Compress::Base::TIEHANDLE
0000s0sIO::Compress::Base::::UNTIEIO::Compress::Base::UNTIE
0000s0sIO::Compress::Base::::__ANON__[:983]IO::Compress::Base::__ANON__[:983]
0000s0sIO::Compress::Base::::_createIO::Compress::Base::_create
0000s0sIO::Compress::Base::::_defIO::Compress::Base::_def
0000s0sIO::Compress::Base::::_flushCompressedIO::Compress::Base::_flushCompressed
0000s0sIO::Compress::Base::::_newStreamIO::Compress::Base::_newStream
0000s0sIO::Compress::Base::::_singleTargetIO::Compress::Base::_singleTarget
0000s0sIO::Compress::Base::::_wr2IO::Compress::Base::_wr2
0000s0sIO::Compress::Base::::_writeFinalTrailerIO::Compress::Base::_writeFinalTrailer
0000s0sIO::Compress::Base::::_writeTrailerIO::Compress::Base::_writeTrailer
0000s0sIO::Compress::Base::::addInterStreamIO::Compress::Base::addInterStream
0000s0sIO::Compress::Base::::autoflushIO::Compress::Base::autoflush
0000s0sIO::Compress::Base::::beforePayloadIO::Compress::Base::beforePayload
0000s0sIO::Compress::Base::::binmodeIO::Compress::Base::binmode
0000s0sIO::Compress::Base::::checkParamsIO::Compress::Base::checkParams
0000s0sIO::Compress::Base::::ckOutputParamIO::Compress::Base::ckOutputParam
0000s0sIO::Compress::Base::::closeIO::Compress::Base::close
0000s0sIO::Compress::Base::::closeErrorIO::Compress::Base::closeError
0000s0sIO::Compress::Base::::croakErrorIO::Compress::Base::croakError
0000s0sIO::Compress::Base::::eofIO::Compress::Base::eof
0000s0sIO::Compress::Base::::errorIO::Compress::Base::error
0000s0sIO::Compress::Base::::errorNoIO::Compress::Base::errorNo
0000s0sIO::Compress::Base::::filenoIO::Compress::Base::fileno
0000s0sIO::Compress::Base::::filterUncompressedIO::Compress::Base::filterUncompressed
0000s0sIO::Compress::Base::::flushIO::Compress::Base::flush
0000s0sIO::Compress::Base::::getFileInfoIO::Compress::Base::getFileInfo
0000s0sIO::Compress::Base::::getOneShotParamsIO::Compress::Base::getOneShotParams
0000s0sIO::Compress::Base::::input_line_numberIO::Compress::Base::input_line_number
0000s0sIO::Compress::Base::::newStreamIO::Compress::Base::newStream
0000s0sIO::Compress::Base::::openedIO::Compress::Base::opened
0000s0sIO::Compress::Base::::outputIO::Compress::Base::output
0000s0sIO::Compress::Base::::outputPayloadIO::Compress::Base::outputPayload
0000s0sIO::Compress::Base::::printIO::Compress::Base::print
0000s0sIO::Compress::Base::::printfIO::Compress::Base::printf
0000s0sIO::Compress::Base::::resetIO::Compress::Base::reset
0000s0sIO::Compress::Base::::saveErrorStringIO::Compress::Base::saveErrorString
0000s0sIO::Compress::Base::::saveStatusIO::Compress::Base::saveStatus
0000s0sIO::Compress::Base::::seekIO::Compress::Base::seek
0000s0sIO::Compress::Base::::syswriteIO::Compress::Base::syswrite
0000s0sIO::Compress::Base::::tellIO::Compress::Base::tell
0000s0sIO::Compress::Base::::writeAtIO::Compress::Base::writeAt
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1
2package IO::Compress::Base ;
3
4113µsrequire 5.006 ;
5
6242µs232µs
# spent 29µs (26+3) within IO::Compress::Base::BEGIN@6 which was called: # once (26µs+3µs) by IO::Compress::RawDeflate::BEGIN@9 at line 6
use strict ;
# spent 29µs making 1 call to IO::Compress::Base::BEGIN@6 # spent 3µs making 1 call to strict::import
7238µs237µs
# spent 27µs (17+10) within IO::Compress::Base::BEGIN@7 which was called: # once (17µs+10µs) by IO::Compress::RawDeflate::BEGIN@9 at line 7
use warnings;
# spent 27µs making 1 call to IO::Compress::Base::BEGIN@7 # spent 10µs making 1 call to warnings::import
8
9351µs3340µs
# spent 178µs (16+162) within IO::Compress::Base::BEGIN@9 which was called: # once (16µs+162µs) by IO::Compress::RawDeflate::BEGIN@9 at line 9
use IO::Compress::Base::Common 2.074 ;
# spent 178µs making 1 call to IO::Compress::Base::BEGIN@9 # spent 150µs making 1 call to Exporter::import # spent 12µs making 1 call to version::_VERSION
10
11226µs15µs
# spent 5µs within IO::Compress::Base::BEGIN@11 which was called: # once (5µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 11
use IO::File (); ;
# spent 5µs making 1 call to IO::Compress::Base::BEGIN@11
12225µs15µs
# spent 5µs within IO::Compress::Base::BEGIN@12 which was called: # once (5µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 12
use Scalar::Util ();
# spent 5µs making 1 call to IO::Compress::Base::BEGIN@12
13
14#use File::Glob;
15#require Exporter ;
16224µs15µs
# spent 5µs within IO::Compress::Base::BEGIN@16 which was called: # once (5µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 16
use Carp() ;
# spent 5µs making 1 call to IO::Compress::Base::BEGIN@16
1721.33ms14µs
# spent 4µs within IO::Compress::Base::BEGIN@17 which was called: # once (4µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 17
use Symbol();
# spent 4µs making 1 call to IO::Compress::Base::BEGIN@17
18#use bytes;
19
20our (@ISA, $VERSION);
21115µs@ISA = qw(IO::File Exporter);
22
2311µs$VERSION = '2.074';
24
25#Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.
26
27sub saveStatus
28{
29 my $self = shift ;
30 ${ *$self->{ErrorNo} } = shift() + 0 ;
31 ${ *$self->{Error} } = '' ;
32
33 return ${ *$self->{ErrorNo} } ;
34}
35
36
37sub saveErrorString
38{
39 my $self = shift ;
40 my $retval = shift ;
41 ${ *$self->{Error} } = shift ;
42 ${ *$self->{ErrorNo} } = shift() + 0 if @_ ;
43
44 return $retval;
45}
46
47sub croakError
48{
49 my $self = shift ;
50 $self->saveErrorString(0, $_[0]);
51 Carp::croak $_[0];
52}
53
54sub closeError
55{
56 my $self = shift ;
57 my $retval = shift ;
58
59 my $errno = *$self->{ErrorNo};
60 my $error = ${ *$self->{Error} };
61
62 $self->close();
63
64 *$self->{ErrorNo} = $errno ;
65 ${ *$self->{Error} } = $error ;
66
67 return $retval;
68}
69
- -
72sub error
73{
74 my $self = shift ;
75 return ${ *$self->{Error} } ;
76}
77
78sub errorNo
79{
80 my $self = shift ;
81 return ${ *$self->{ErrorNo} } ;
82}
83
84
85sub writeAt
86{
87 my $self = shift ;
88 my $offset = shift;
89 my $data = shift;
90
91 if (defined *$self->{FH}) {
92 my $here = tell(*$self->{FH});
93 return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!)
94 if $here < 0 ;
95 seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET)
96 or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
97 defined *$self->{FH}->write($data, length $data)
98 or return $self->saveErrorString(undef, $!, $!) ;
99 seek(*$self->{FH}, $here, IO::Handle::SEEK_SET)
100 or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
101 }
102 else {
103 substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ;
104 }
105
106 return 1;
107}
108
109sub outputPayload
110{
111
112 my $self = shift ;
113 return $self->output(@_);
114}
115
116
117sub output
118{
119 my $self = shift ;
120 my $data = shift ;
121 my $last = shift ;
122
123 return 1
124 if length $data == 0 && ! $last ;
125
126 if ( *$self->{FilterContainer} ) {
127 *_ = \$data;
128 &{ *$self->{FilterContainer} }();
129 }
130
131 if (length $data) {
132 if ( defined *$self->{FH} ) {
133 defined *$self->{FH}->write( $data, length $data )
134 or return $self->saveErrorString(0, $!, $!);
135 }
136 else {
137 ${ *$self->{Buffer} } .= $data ;
138 }
139 }
140
141 return 1;
142}
143
144sub getOneShotParams
145{
146 return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean, 1],
147 );
148}
149
15016µsour %PARAMS = (
151 # Generic Parameters
152 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0],
153 'encode' => [IO::Compress::Base::Common::Parse_any, undef],
154 'strict' => [IO::Compress::Base::Common::Parse_boolean, 1],
155 'append' => [IO::Compress::Base::Common::Parse_boolean, 0],
156 'binmodein' => [IO::Compress::Base::Common::Parse_boolean, 0],
157
158 'filtercontainer' => [IO::Compress::Base::Common::Parse_code, undef],
159 );
160
161sub checkParams
162{
163 my $self = shift ;
164 my $class = shift ;
165
166 my $got = shift || IO::Compress::Base::Parameters::new();
167
168 $got->parse(
169 {
170 %PARAMS,
171
172
173 $self->getExtraParams(),
174 *$self->{OneShot} ? $self->getOneShotParams()
175 : (),
176 },
177 @_) or $self->croakError("${class}: " . $got->getError()) ;
178
179 return $got ;
180}
181
182sub _create
183{
184 my $obj = shift;
185 my $got = shift;
186
187 *$obj->{Closed} = 1 ;
188
189 my $class = ref $obj;
190 $obj->croakError("$class: Missing Output parameter")
191 if ! @_ && ! $got ;
192
193 my $outValue = shift ;
194 my $oneShot = 1 ;
195
196 if (! $got)
197 {
198 $oneShot = 0 ;
199 $got = $obj->checkParams($class, undef, @_)
200 or return undef ;
201 }
202
203 my $lax = ! $got->getValue('strict') ;
204
205 my $outType = IO::Compress::Base::Common::whatIsOutput($outValue);
206
207 $obj->ckOutputParam($class, $outValue)
208 or return undef ;
209
210 if ($outType eq 'buffer') {
211 *$obj->{Buffer} = $outValue;
212 }
213 else {
214 my $buff = "" ;
215 *$obj->{Buffer} = \$buff ;
216 }
217
218 # Merge implies Append
219 my $merge = $got->getValue('merge') ;
220 my $appendOutput = $got->getValue('append') || $merge ;
221 *$obj->{Append} = $appendOutput;
222 *$obj->{FilterContainer} = $got->getValue('filtercontainer') ;
223
224 if ($merge)
225 {
226 # Switch off Merge mode if output file/buffer is empty/doesn't exist
227 if (($outType eq 'buffer' && length $$outValue == 0 ) ||
228 ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) )
229 { $merge = 0 }
230 }
231
232 # If output is a file, check that it is writable
233 #no warnings;
234 #if ($outType eq 'filename' && -e $outValue && ! -w _)
235 # { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) }
236
237 $obj->ckParams($got)
238 or $obj->croakError("${class}: " . $obj->error());
239
240 if ($got->getValue('encode')) {
241 my $want_encoding = $got->getValue('encode');
242 *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
243 my $x = *$obj->{Encoding};
244 }
245 else {
246 *$obj->{Encoding} = undef;
247 }
248
249 $obj->saveStatus(STATUS_OK) ;
250
251 my $status ;
252 if (! $merge)
253 {
254 *$obj->{Compress} = $obj->mkComp($got)
255 or return undef;
256
257 *$obj->{UnCompSize} = new U64 ;
258 *$obj->{CompSize} = new U64 ;
259
260 if ( $outType eq 'buffer') {
261 ${ *$obj->{Buffer} } = ''
262 unless $appendOutput ;
263 }
264 else {
265 if ($outType eq 'handle') {
266 *$obj->{FH} = $outValue ;
267 setBinModeOutput(*$obj->{FH}) ;
268 #$outValue->flush() ;
269 *$obj->{Handle} = 1 ;
270 if ($appendOutput)
271 {
272 seek(*$obj->{FH}, 0, IO::Handle::SEEK_END)
273 or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
274
275 }
276 }
277 elsif ($outType eq 'filename') {
27823.42ms251µs
# spent 33µs (15+18) within IO::Compress::Base::BEGIN@278 which was called: # once (15µs+18µs) by IO::Compress::RawDeflate::BEGIN@9 at line 278
no warnings;
# spent 33µs making 1 call to IO::Compress::Base::BEGIN@278 # spent 18µs making 1 call to warnings::unimport
279 my $mode = '>' ;
280 $mode = '>>'
281 if $appendOutput;
282 *$obj->{FH} = new IO::File "$mode $outValue"
283 or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ;
284 *$obj->{StdIO} = ($outValue eq '-');
285 setBinModeOutput(*$obj->{FH}) ;
286 }
287 }
288
289 *$obj->{Header} = $obj->mkHeader($got) ;
290 $obj->output( *$obj->{Header} )
291 or return undef;
292 $obj->beforePayload();
293 }
294 else
295 {
296 *$obj->{Compress} = $obj->createMerge($outValue, $outType)
297 or return undef;
298 }
299
300 *$obj->{Closed} = 0 ;
301 *$obj->{AutoClose} = $got->getValue('autoclose') ;
302 *$obj->{Output} = $outValue;
303 *$obj->{ClassName} = $class;
304 *$obj->{Got} = $got;
305 *$obj->{OneShot} = 0 ;
306
307 return $obj ;
308}
309
310sub ckOutputParam
311{
312 my $self = shift ;
313 my $from = shift ;
314 my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]);
315
316 $self->croakError("$from: output parameter not a filename, filehandle or scalar ref")
317 if ! $outType ;
318
319 #$self->croakError("$from: output filename is undef or null string")
320 #if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ;
321
322 $self->croakError("$from: output buffer is read-only")
323 if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] });
324
325 return 1;
326}
327
328
329sub _def
330{
331 my $obj = shift ;
332
333 my $class= (caller)[0] ;
334 my $name = (caller(1))[3] ;
335
336 $obj->croakError("$name: expected at least 1 parameters\n")
337 unless @_ >= 1 ;
338
339 my $input = shift ;
340 my $haveOut = @_ ;
341 my $output = shift ;
342
343 my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output)
344 or return undef ;
345
346 push @_, $output if $haveOut && $x->{Hash};
347
348 *$obj->{OneShot} = 1 ;
349
350 my $got = $obj->checkParams($name, undef, @_)
351 or return undef ;
352
353 $x->{Got} = $got ;
354
355# if ($x->{Hash})
356# {
357# while (my($k, $v) = each %$input)
358# {
359# $v = \$input->{$k}
360# unless defined $v ;
361#
362# $obj->_singleTarget($x, 1, $k, $v, @_)
363# or return undef ;
364# }
365#
366# return keys %$input ;
367# }
368
369 if ($x->{GlobMap})
370 {
371 $x->{oneInput} = 1 ;
372 foreach my $pair (@{ $x->{Pairs} })
373 {
374 my ($from, $to) = @$pair ;
375 $obj->_singleTarget($x, 1, $from, $to, @_)
376 or return undef ;
377 }
378
379 return scalar @{ $x->{Pairs} } ;
380 }
381
382 if (! $x->{oneOutput} )
383 {
384 my $inFile = ($x->{inType} eq 'filenames'
385 || $x->{inType} eq 'filename');
386
387 $x->{inType} = $inFile ? 'filename' : 'buffer';
388
389 foreach my $in ($x->{oneInput} ? $input : @$input)
390 {
391 my $out ;
392 $x->{oneInput} = 1 ;
393
394 $obj->_singleTarget($x, $inFile, $in, \$out, @_)
395 or return undef ;
396
397 push @$output, \$out ;
398 #if ($x->{outType} eq 'array')
399 # { push @$output, \$out }
400 #else
401 # { $output->{$in} = \$out }
402 }
403
404 return 1 ;
405 }
406
407 # finally the 1 to 1 and n to 1
408 return $obj->_singleTarget($x, 1, $input, $output, @_);
409
410 Carp::croak "should not be here" ;
411}
412
413sub _singleTarget
414{
415 my $obj = shift ;
416 my $x = shift ;
417 my $inputIsFilename = shift;
418 my $input = shift;
419
420 if ($x->{oneInput})
421 {
422 $obj->getFileInfo($x->{Got}, $input)
423 if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ;
424
425 my $z = $obj->_create($x->{Got}, @_)
426 or return undef ;
427
428
429 defined $z->_wr2($input, $inputIsFilename)
430 or return $z->closeError(undef) ;
431
432 return $z->close() ;
433 }
434 else
435 {
436 my $afterFirst = 0 ;
437 my $inputIsFilename = ($x->{inType} ne 'array');
438 my $keep = $x->{Got}->clone();
439
440 #for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
441 for my $element ( @$input)
442 {
443 my $isFilename = isaFilename($element);
444
445 if ( $afterFirst ++ )
446 {
447 defined addInterStream($obj, $element, $isFilename)
448 or return $obj->closeError(undef) ;
449 }
450 else
451 {
452 $obj->getFileInfo($x->{Got}, $element)
453 if isaScalar($element) || $isFilename;
454
455 $obj->_create($x->{Got}, @_)
456 or return undef ;
457 }
458
459 defined $obj->_wr2($element, $isFilename)
460 or return $obj->closeError(undef) ;
461
462 *$obj->{Got} = $keep->clone();
463 }
464 return $obj->close() ;
465 }
466
467}
468
469sub _wr2
470{
471 my $self = shift ;
472
473 my $source = shift ;
474 my $inputIsFilename = shift;
475
476 my $input = $source ;
477 if (! $inputIsFilename)
478 {
479 $input = \$source
480 if ! ref $source;
481 }
482
483 if ( ref $input && ref $input eq 'SCALAR' )
484 {
485 return $self->syswrite($input, @_) ;
486 }
487
488 if ( ! ref $input || isaFilehandle($input))
489 {
490 my $isFilehandle = isaFilehandle($input) ;
491
492 my $fh = $input ;
493
494 if ( ! $isFilehandle )
495 {
496 $fh = new IO::File "<$input"
497 or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ;
498 }
499 binmode $fh if *$self->{Got}->valueOrDefault('binmodein') ;
500
501 my $status ;
502 my $buff ;
503 my $count = 0 ;
504 while ($status = read($fh, $buff, 16 * 1024)) {
505 $count += length $buff;
506 defined $self->syswrite($buff, @_)
507 or return undef ;
508 }
509
510 return $self->saveErrorString(undef, $!, $!)
511 if ! defined $status ;
512
513 if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-')
514 {
515 $fh->close()
516 or return undef ;
517 }
518
519 return $count ;
520 }
521
522 Carp::croak "Should not be here";
523 return undef;
524}
525
526sub addInterStream
527{
528 my $self = shift ;
529 my $input = shift ;
530 my $inputIsFilename = shift ;
531
532 if (*$self->{Got}->getValue('multistream'))
533 {
534 $self->getFileInfo(*$self->{Got}, $input)
535 #if isaFilename($input) and $inputIsFilename ;
536 if isaScalar($input) || isaFilename($input) ;
537
538 # TODO -- newStream needs to allow gzip/zip header to be modified
539 return $self->newStream();
540 }
541 elsif (*$self->{Got}->getValue('autoflush'))
542 {
543 #return $self->flush(Z_FULL_FLUSH);
544 }
545
546 return 1 ;
547}
548
549sub getFileInfo
550{
551}
552
553sub TIEHANDLE
554{
555 return $_[0] if ref($_[0]);
556 die "OOPS\n" ;
557}
558
559sub UNTIE
560{
561 my $self = shift ;
562}
563
564sub DESTROY
565{
566 my $self = shift ;
567 local ($., $@, $!, $^E, $?);
568
569 $self->close() ;
570
571 # TODO - memory leak with 5.8.0 - this isn't called until
572 # global destruction
573 #
574 %{ *$self } = () ;
575 undef $self ;
576}
577
- -
580sub filterUncompressed
581{
582}
583
584sub syswrite
585{
586 my $self = shift ;
587
588 my $buffer ;
589 if (ref $_[0] ) {
590 $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" )
591 unless ref $_[0] eq 'SCALAR' ;
592 $buffer = $_[0] ;
593 }
594 else {
595 $buffer = \$_[0] ;
596 }
597
598 if (@_ > 1) {
599 my $slen = defined $$buffer ? length($$buffer) : 0;
600 my $len = $slen;
601 my $offset = 0;
602 $len = $_[1] if $_[1] < $len;
603
604 if (@_ > 2) {
605 $offset = $_[2] || 0;
606 $self->croakError(*$self->{ClassName} . "::write: offset outside string")
607 if $offset > $slen;
608 if ($offset < 0) {
609 $offset += $slen;
610 $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0;
611 }
612 my $rem = $slen - $offset;
613 $len = $rem if $rem < $len;
614 }
615
616 $buffer = \substr($$buffer, $offset, $len) ;
617 }
618
619 return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending};
620
621# *$self->{Pending} .= $$buffer ;
622#
623# return length $$buffer
624# if (length *$self->{Pending} < 1024 * 16 && ! *$self->{FlushPending}) ;
625#
626# $$buffer = *$self->{Pending} ;
627# *$self->{Pending} = '';
628
629 if (*$self->{Encoding}) {
630 $$buffer = *$self->{Encoding}->encode($$buffer);
631 }
632 else {
633 $] >= 5.008 and ( utf8::downgrade($$buffer, 1)
634 or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:");
635 }
636
637 $self->filterUncompressed($buffer);
638
639 my $buffer_length = defined $$buffer ? length($$buffer) : 0 ;
640 *$self->{UnCompSize}->add($buffer_length) ;
641
642 my $outBuffer='';
643 my $status = *$self->{Compress}->compr($buffer, $outBuffer) ;
644
645 return $self->saveErrorString(undef, *$self->{Compress}{Error},
646 *$self->{Compress}{ErrorNo})
647 if $status == STATUS_ERROR;
648
649 *$self->{CompSize}->add(length $outBuffer) ;
650
651 $self->outputPayload($outBuffer)
652 or return undef;
653
654 return $buffer_length;
655}
656
657sub print
658{
659 my $self = shift;
660
661 #if (ref $self) {
662 # $self = *$self{GLOB} ;
663 #}
664
665 if (defined $\) {
666 if (defined $,) {
667 defined $self->syswrite(join($,, @_) . $\);
668 } else {
669 defined $self->syswrite(join("", @_) . $\);
670 }
671 } else {
672 if (defined $,) {
673 defined $self->syswrite(join($,, @_));
674 } else {
675 defined $self->syswrite(join("", @_));
676 }
677 }
678}
679
680sub printf
681{
682 my $self = shift;
683 my $fmt = shift;
684 defined $self->syswrite(sprintf($fmt, @_));
685}
686
687sub _flushCompressed
688{
689 my $self = shift ;
690
691 my $outBuffer='';
692 my $status = *$self->{Compress}->flush($outBuffer, @_) ;
693 return $self->saveErrorString(0, *$self->{Compress}{Error},
694 *$self->{Compress}{ErrorNo})
695 if $status == STATUS_ERROR;
696
697 if ( defined *$self->{FH} ) {
698 *$self->{FH}->clearerr();
699 }
700
701 *$self->{CompSize}->add(length $outBuffer) ;
702
703 $self->outputPayload($outBuffer)
704 or return 0;
705 return 1;
706}
707
708sub flush
709{
710 my $self = shift ;
711
712 $self->_flushCompressed(@_)
713 or return 0;
714
715 if ( defined *$self->{FH} ) {
716 defined *$self->{FH}->flush()
717 or return $self->saveErrorString(0, $!, $!);
718 }
719
720 return 1;
721}
722
723sub beforePayload
724{
725}
726
727sub _newStream
728{
729 my $self = shift ;
730 my $got = shift;
731
732 my $class = ref $self;
733
734 $self->_writeTrailer()
735 or return 0 ;
736
737 $self->ckParams($got)
738 or $self->croakError("newStream: $self->{Error}");
739
740 if ($got->getValue('encode')) {
741 my $want_encoding = $got->getValue('encode');
742 *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding);
743 }
744 else {
745 *$self->{Encoding} = undef;
746 }
747
748 *$self->{Compress} = $self->mkComp($got)
749 or return 0;
750
751 *$self->{Header} = $self->mkHeader($got) ;
752 $self->output(*$self->{Header} )
753 or return 0;
754
755 *$self->{UnCompSize}->reset();
756 *$self->{CompSize}->reset();
757
758 $self->beforePayload();
759
760 return 1 ;
761}
762
763sub newStream
764{
765 my $self = shift ;
766
767 my $got = $self->checkParams('newStream', *$self->{Got}, @_)
768 or return 0 ;
769
770 $self->_newStream($got);
771
772# *$self->{Compress} = $self->mkComp($got)
773# or return 0;
774#
775# *$self->{Header} = $self->mkHeader($got) ;
776# $self->output(*$self->{Header} )
777# or return 0;
778#
779# *$self->{UnCompSize}->reset();
780# *$self->{CompSize}->reset();
781#
782# $self->beforePayload();
783#
784# return 1 ;
785}
786
787sub reset
788{
789 my $self = shift ;
790 return *$self->{Compress}->reset() ;
791}
792
793sub _writeTrailer
794{
795 my $self = shift ;
796
797 my $trailer = '';
798
799 my $status = *$self->{Compress}->close($trailer) ;
800 return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
801 if $status == STATUS_ERROR;
802
803 *$self->{CompSize}->add(length $trailer) ;
804
805 $trailer .= $self->mkTrailer();
806 defined $trailer
807 or return 0;
808
809 return $self->output($trailer);
810}
811
812sub _writeFinalTrailer
813{
814 my $self = shift ;
815
816 return $self->output($self->mkFinalTrailer());
817}
818
819sub close
820{
821 my $self = shift ;
822 return 1 if *$self->{Closed} || ! *$self->{Compress} ;
823 *$self->{Closed} = 1 ;
824
825 untie *$self
826 if $] >= 5.008 ;
827
828 *$self->{FlushPending} = 1 ;
829 $self->_writeTrailer()
830 or return 0 ;
831
832 $self->_writeFinalTrailer()
833 or return 0 ;
834
835 $self->output( "", 1 )
836 or return 0;
837
838 if (defined *$self->{FH}) {
839
840 if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
841 $! = 0 ;
842 *$self->{FH}->close()
843 or return $self->saveErrorString(0, $!, $!);
844 }
845 delete *$self->{FH} ;
846 # This delete can set $! in older Perls, so reset the errno
847 $! = 0 ;
848 }
849
850 return 1;
851}
852
853
854#sub total_in
855#sub total_out
856#sub msg
857#
858#sub crc
859#{
860# my $self = shift ;
861# return *$self->{Compress}->crc32() ;
862#}
863#
864#sub msg
865#{
866# my $self = shift ;
867# return *$self->{Compress}->msg() ;
868#}
869#
870#sub dict_adler
871#{
872# my $self = shift ;
873# return *$self->{Compress}->dict_adler() ;
874#}
875#
876#sub get_Level
877#{
878# my $self = shift ;
879# return *$self->{Compress}->get_Level() ;
880#}
881#
882#sub get_Strategy
883#{
884# my $self = shift ;
885# return *$self->{Compress}->get_Strategy() ;
886#}
887
888
889sub tell
890{
891 my $self = shift ;
892
893 return *$self->{UnCompSize}->get32bit() ;
894}
895
896sub eof
897{
898 my $self = shift ;
899
900 return *$self->{Closed} ;
901}
902
903
904sub seek
905{
906 my $self = shift ;
907 my $position = shift;
908 my $whence = shift ;
909
910 my $here = $self->tell() ;
911 my $target = 0 ;
912
913 #use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
9142542µs278µs
# spent 49µs (20+29) within IO::Compress::Base::BEGIN@914 which was called: # once (20µs+29µs) by IO::Compress::RawDeflate::BEGIN@9 at line 914
use IO::Handle ;
# spent 49µs making 1 call to IO::Compress::Base::BEGIN@914 # spent 29µs making 1 call to Exporter::import
915
916 if ($whence == IO::Handle::SEEK_SET) {
917 $target = $position ;
918 }
919 elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) {
920 $target = $here + $position ;
921 }
922 else {
923 $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter");
924 }
925
926 # short circuit if seeking to current offset
927 return 1 if $target == $here ;
928
929 # Outlaw any attempt to seek backwards
930 $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards")
931 if $target < $here ;
932
933 # Walk the file to the new offset
934 my $offset = $target - $here ;
935
936 my $buffer ;
937 defined $self->syswrite("\x00" x $offset)
938 or return 0;
939
940 return 1 ;
941}
942
943sub binmode
944{
945 1;
946# my $self = shift ;
947# return defined *$self->{FH}
948# ? binmode *$self->{FH}
949# : 1 ;
950}
951
952sub fileno
953{
954 my $self = shift ;
955 return defined *$self->{FH}
956 ? *$self->{FH}->fileno()
957 : undef ;
958}
959
960sub opened
961{
962 my $self = shift ;
963 return ! *$self->{Closed} ;
964}
965
966sub autoflush
967{
968 my $self = shift ;
969 return defined *$self->{FH}
970 ? *$self->{FH}->autoflush(@_)
971 : undef ;
972}
973
974sub input_line_number
975{
976 return undef ;
977}
978
979
980sub _notAvailable
981
# spent 16µs within IO::Compress::Base::_notAvailable which was called 6 times, avg 3µs/call: # once (5µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 986 # once (3µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 991 # once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 990 # once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 989 # once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 987 # once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 988
{
98261µs my $name = shift ;
983629µs return sub { Carp::croak "$name Not Available: File opened only for output" ; } ;
984}
985
98614µs15µs*read = _notAvailable('read');
# spent 5µs making 1 call to IO::Compress::Base::_notAvailable
98711µs12µs*READ = _notAvailable('read');
# spent 2µs making 1 call to IO::Compress::Base::_notAvailable
98812µs12µs*readline = _notAvailable('readline');
# spent 2µs making 1 call to IO::Compress::Base::_notAvailable
98912µs12µs*READLINE = _notAvailable('readline');
# spent 2µs making 1 call to IO::Compress::Base::_notAvailable
99011µs12µs*getc = _notAvailable('getc');
# spent 2µs making 1 call to IO::Compress::Base::_notAvailable
99112µs13µs*GETC = _notAvailable('getc');
# spent 3µs making 1 call to IO::Compress::Base::_notAvailable
992
99310s*FILENO = \&fileno;
99410s*PRINT = \&print;
99510s*PRINTF = \&printf;
99611µs*WRITE = \&syswrite;
99710s*write = \&syswrite;
99810s*SEEK = \&seek;
99910s*TELL = \&tell;
100010s*EOF = \&eof;
100110s*CLOSE = \&close;
100210s*BINMODE = \&binmode;
1003
1004#*sysread = \&_notAvailable;
1005#*syswrite = \&_write;
1006
1007120µs1;
1008
1009__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.