"Fossies" - the Fresh Open Source Software Archive

Member "IO-Compress-2.093/lib/IO/Compress/Base.pm" (7 Dec 2019, 23924 Bytes) of package /linux/privat/IO-Compress-2.093.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Base.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.092_vs_2.093.

    1 
    2 package IO::Compress::Base ;
    3 
    4 require 5.006 ;
    5 
    6 use strict ;
    7 use warnings;
    8 
    9 use IO::Compress::Base::Common 2.093 ;
   10 
   11 use IO::File (); ;
   12 use Scalar::Util ();
   13 
   14 #use File::Glob;
   15 #require Exporter ;
   16 use Carp() ;
   17 use Symbol();
   18 #use bytes;
   19 
   20 our (@ISA, $VERSION);
   21 @ISA    = qw(IO::File Exporter);
   22 
   23 $VERSION = '2.093';
   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 
   27 sub saveStatus
   28 {
   29     my $self   = shift ;
   30     ${ *$self->{ErrorNo} } = shift() + 0 ;
   31     ${ *$self->{Error} } = '' ;
   32 
   33     return ${ *$self->{ErrorNo} } ;
   34 }
   35 
   36 
   37 sub 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 
   47 sub croakError
   48 {
   49     my $self   = shift ;
   50     $self->saveErrorString(0, $_[0]);
   51     Carp::croak $_[0];
   52 }
   53 
   54 sub 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 
   70 
   71 
   72 sub error
   73 {
   74     my $self   = shift ;
   75     return ${ *$self->{Error} } ;
   76 }
   77 
   78 sub errorNo
   79 {
   80     my $self   = shift ;
   81     return ${ *$self->{ErrorNo} } ;
   82 }
   83 
   84 
   85 sub 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 
  109 sub outputPayload
  110 {
  111 
  112     my $self = shift ;
  113     return $self->output(@_);
  114 }
  115 
  116 
  117 sub 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 
  144 sub getOneShotParams
  145 {
  146     return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean,   1],
  147            );
  148 }
  149 
  150 our %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 
  161 sub 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 
  182 sub _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') {
  278                 no warnings;
  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 
  310 sub 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 
  329 sub _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 
  413 sub _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 
  469 sub _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 ;
  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 
  526 sub 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 
  549 sub getFileInfo
  550 {
  551 }
  552 
  553 sub TIEHANDLE
  554 {
  555     return $_[0] if ref($_[0]);
  556     die "OOPS\n" ;
  557 }
  558 
  559 sub UNTIE
  560 {
  561     my $self = shift ;
  562 }
  563 
  564 sub 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 
  578 
  579 
  580 sub filterUncompressed
  581 {
  582 }
  583 
  584 sub 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 
  657 sub 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 
  680 sub printf
  681 {
  682     my $self = shift;
  683     my $fmt = shift;
  684     defined $self->syswrite(sprintf($fmt, @_));
  685 }
  686 
  687 sub _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 
  708 sub 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 
  723 sub beforePayload
  724 {
  725 }
  726 
  727 sub _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 
  763 sub 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 
  787 sub reset
  788 {
  789     my $self = shift ;
  790     return *$self->{Compress}->reset() ;
  791 }
  792 
  793 sub _writeTrailer
  794 {
  795     my $self = shift ;
  796 
  797     my $trailer = '';
  798 
  799     my $status = *$self->{Compress}->close($trailer) ;
  800 
  801     return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
  802         if $status == STATUS_ERROR;
  803 
  804     *$self->{CompSize}->add(length $trailer) ;
  805 
  806     $trailer .= $self->mkTrailer();
  807     defined $trailer
  808       or return 0;
  809     return $self->output($trailer);
  810 }
  811 
  812 sub _writeFinalTrailer
  813 {
  814     my $self = shift ;
  815 
  816     return $self->output($self->mkFinalTrailer());
  817 }
  818 
  819 sub 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 
  889 sub tell
  890 {
  891     my $self = shift ;
  892 
  893     return *$self->{UnCompSize}->get32bit() ;
  894 }
  895 
  896 sub eof
  897 {
  898     my $self = shift ;
  899 
  900     return *$self->{Closed} ;
  901 }
  902 
  903 
  904 sub 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);
  914     use IO::Handle ;
  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 
  943 sub binmode
  944 {
  945     1;
  946 #    my $self     = shift ;
  947 #    return defined *$self->{FH}
  948 #            ? binmode *$self->{FH}
  949 #            : 1 ;
  950 }
  951 
  952 sub fileno
  953 {
  954     my $self     = shift ;
  955     return defined *$self->{FH}
  956             ? *$self->{FH}->fileno()
  957             : undef ;
  958 }
  959 
  960 sub opened
  961 {
  962     my $self     = shift ;
  963     return ! *$self->{Closed} ;
  964 }
  965 
  966 sub autoflush
  967 {
  968     my $self     = shift ;
  969     return defined *$self->{FH}
  970             ? *$self->{FH}->autoflush(@_)
  971             : undef ;
  972 }
  973 
  974 sub input_line_number
  975 {
  976     return undef ;
  977 }
  978 
  979 
  980 sub _notAvailable
  981 {
  982     my $name = shift ;
  983     return sub { Carp::croak "$name Not Available: File opened only for output" ; } ;
  984 }
  985 
  986 *read     = _notAvailable('read');
  987 *READ     = _notAvailable('read');
  988 *readline = _notAvailable('readline');
  989 *READLINE = _notAvailable('readline');
  990 *getc     = _notAvailable('getc');
  991 *GETC     = _notAvailable('getc');
  992 
  993 *FILENO   = \&fileno;
  994 *PRINT    = \&print;
  995 *PRINTF   = \&printf;
  996 *WRITE    = \&syswrite;
  997 *write    = \&syswrite;
  998 *SEEK     = \&seek;
  999 *TELL     = \&tell;
 1000 *EOF      = \&eof;
 1001 *CLOSE    = \&close;
 1002 *BINMODE  = \&binmode;
 1003 
 1004 #*sysread  = \&_notAvailable;
 1005 #*syswrite = \&_write;
 1006 
 1007 1;
 1008 
 1009 __END__
 1010 
 1011 =head1 NAME
 1012 
 1013 IO::Compress::Base - Base Class for IO::Compress modules
 1014 
 1015 =head1 SYNOPSIS
 1016 
 1017     use IO::Compress::Base ;
 1018 
 1019 =head1 DESCRIPTION
 1020 
 1021 This module is not intended for direct use in application code. Its sole
 1022 purpose is to be sub-classed by IO::Compress modules.
 1023 
 1024 =head1 SUPPORT
 1025 
 1026 General feedback/questions/bug reports should be sent to 
 1027 L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
 1028 L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.
 1029 
 1030 =head1 SEE ALSO
 1031 
 1032 L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
 1033 
 1034 L<IO::Compress::FAQ|IO::Compress::FAQ>
 1035 
 1036 L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
 1037 L<Archive::Tar|Archive::Tar>,
 1038 L<IO::Zlib|IO::Zlib>
 1039 
 1040 =head1 AUTHOR
 1041 
 1042 This module was written by Paul Marquess, C<pmqs@cpan.org>.
 1043 
 1044 =head1 MODIFICATION HISTORY
 1045 
 1046 See the Changes file.
 1047 
 1048 =head1 COPYRIGHT AND LICENSE
 1049 
 1050 Copyright (c) 2005-2019 Paul Marquess. All rights reserved.
 1051 
 1052 This program is free software; you can redistribute it and/or
 1053 modify it under the same terms as Perl itself.
 1054