"Fossies" - the Fresh Open Source Software Archive

Member "IO-Compress-2.093/lib/IO/Uncompress/Base.pm" (7 Dec 2019, 38594 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::Uncompress::Base ;
    3 
    4 use strict ;
    5 use warnings;
    6 use bytes;
    7 
    8 our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
    9 @ISA    = qw(IO::File Exporter);
   10 
   11 
   12 $VERSION = '2.093';
   13 
   14 use constant G_EOF => 0 ;
   15 use constant G_ERR => -1 ;
   16 
   17 use IO::Compress::Base::Common 2.093 ;
   18 
   19 use IO::File ;
   20 use Symbol;
   21 use Scalar::Util ();
   22 use List::Util ();
   23 use Carp ;
   24 
   25 %EXPORT_TAGS = ( );
   26 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
   27 
   28 sub smartRead
   29 {
   30     my $self = $_[0];
   31     my $out = $_[1];
   32     my $size = $_[2];
   33     $$out = "" ;
   34 
   35     my $offset = 0 ;
   36     my $status = 1;
   37 
   38 
   39     if (defined *$self->{InputLength}) {
   40         return 0
   41             if *$self->{InputLengthRemaining} <= 0 ;
   42         $size = List::Util::min($size, *$self->{InputLengthRemaining});
   43     }
   44 
   45     if ( length *$self->{Prime} ) {
   46         $$out = substr(*$self->{Prime}, 0, $size) ;
   47         substr(*$self->{Prime}, 0, $size) =  '' ;
   48         if (length $$out == $size) {
   49             *$self->{InputLengthRemaining} -= length $$out
   50                 if defined *$self->{InputLength};
   51 
   52             return length $$out ;
   53         }
   54         $offset = length $$out ;
   55     }
   56 
   57     my $get_size = $size - $offset ;
   58 
   59     if (defined *$self->{FH}) {
   60         if ($offset) {
   61             # Not using this 
   62             #
   63             #  *$self->{FH}->read($$out, $get_size, $offset);
   64             #
   65             # because the filehandle may not support the offset parameter
   66             # An example is Net::FTP
   67             my $tmp = '';
   68             $status = *$self->{FH}->read($tmp, $get_size) ;
   69             substr($$out, $offset) = $tmp
   70                 if defined $status && $status > 0 ;
   71         }
   72         else
   73           { $status = *$self->{FH}->read($$out, $get_size) }
   74     }
   75     elsif (defined *$self->{InputEvent}) {
   76         my $got = 1 ;
   77         while (length $$out < $size) {
   78             last 
   79                 if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0;
   80         }
   81 
   82         if (length $$out > $size ) {
   83             *$self->{Prime} = substr($$out, $size, length($$out));
   84             substr($$out, $size, length($$out)) =  '';
   85         }
   86 
   87        *$self->{EventEof} = 1 if $got <= 0 ;
   88     }
   89     else {
   90        no warnings 'uninitialized';
   91        my $buf = *$self->{Buffer} ;
   92        $$buf = '' unless defined $$buf ;
   93        substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
   94        if (*$self->{ConsumeInput})
   95          { substr($$buf, 0, $get_size) = '' }
   96        else  
   97          { *$self->{BufferOffset} += length($$out) - $offset }
   98     }
   99 
  100     *$self->{InputLengthRemaining} -= length($$out) #- $offset 
  101         if defined *$self->{InputLength};
  102         
  103     if (! defined $status) {
  104         $self->saveStatus($!) ;
  105         return STATUS_ERROR;
  106     }
  107 
  108     $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ;
  109 
  110     return length $$out;
  111 }
  112 
  113 sub pushBack
  114 {
  115     my $self = shift ;
  116 
  117     return if ! defined $_[0] || length $_[0] == 0 ;
  118 
  119     if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
  120         *$self->{Prime} = $_[0] . *$self->{Prime} ;
  121         *$self->{InputLengthRemaining} += length($_[0]);
  122     }
  123     else {
  124         my $len = length $_[0];
  125 
  126         if($len > *$self->{BufferOffset}) {
  127             *$self->{Prime} = substr($_[0], 0, $len - *$self->{BufferOffset}) . *$self->{Prime} ;
  128             *$self->{InputLengthRemaining} = *$self->{InputLength};
  129             *$self->{BufferOffset} = 0
  130         }
  131         else {
  132             *$self->{InputLengthRemaining} += length($_[0]);
  133             *$self->{BufferOffset} -= length($_[0]) ;
  134         }
  135     }
  136 }
  137 
  138 sub smartSeek
  139 {
  140     my $self   = shift ;
  141     my $offset = shift ;
  142     my $truncate = shift;
  143     my $position = shift || SEEK_SET;
  144 
  145     # TODO -- need to take prime into account
  146     *$self->{Prime} = '';
  147     if (defined *$self->{FH})
  148       { *$self->{FH}->seek($offset, $position) }
  149     else {
  150         if ($position == SEEK_END) {
  151             *$self->{BufferOffset} = length(${ *$self->{Buffer} }) + $offset ;
  152         }
  153         elsif ($position == SEEK_CUR) {
  154             *$self->{BufferOffset} += $offset ;
  155         }
  156         else {
  157             *$self->{BufferOffset} = $offset ;
  158         }
  159 
  160         substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = ''
  161             if $truncate;
  162         return 1;
  163     }
  164 }
  165 
  166 sub smartTell
  167 {
  168     my $self   = shift ;
  169 
  170     if (defined *$self->{FH})
  171       { return *$self->{FH}->tell() }
  172     else 
  173       { return *$self->{BufferOffset} }
  174 }
  175 
  176 sub smartWrite
  177 {
  178     my $self   = shift ;
  179     my $out_data = shift ;
  180 
  181     if (defined *$self->{FH}) {
  182         # flush needed for 5.8.0 
  183         defined *$self->{FH}->write($out_data, length $out_data) &&
  184         defined *$self->{FH}->flush() ;
  185     }
  186     else {
  187        my $buf = *$self->{Buffer} ;
  188        substr($$buf, *$self->{BufferOffset}, length $out_data) = $out_data ;
  189        *$self->{BufferOffset} += length($out_data) ;
  190        return 1;
  191     }
  192 }
  193 
  194 sub smartReadExact
  195 {
  196     return $_[0]->smartRead($_[1], $_[2]) == $_[2];
  197 }
  198 
  199 sub smartEof
  200 {
  201     my ($self) = $_[0];
  202     local $.; 
  203 
  204     return 0 if length *$self->{Prime} || *$self->{PushMode};
  205 
  206     if (defined *$self->{FH})
  207     {
  208         # Could use
  209         #
  210         #  *$self->{FH}->eof() 
  211         #
  212         # here, but this can cause trouble if
  213         # the filehandle is itself a tied handle, but it uses sysread.
  214         # Then we get into mixing buffered & non-buffered IO, 
  215         # which will cause trouble
  216 
  217         my $info = $self->getErrInfo();
  218         
  219         my $buffer = '';
  220         my $status = $self->smartRead(\$buffer, 1);
  221         $self->pushBack($buffer) if length $buffer;
  222         $self->setErrInfo($info);
  223 
  224         return $status == 0 ;
  225     }
  226     elsif (defined *$self->{InputEvent})
  227      { *$self->{EventEof} }
  228     else 
  229      { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) }
  230 }
  231 
  232 sub clearError
  233 {
  234     my $self   = shift ;
  235 
  236     *$self->{ErrorNo}  =  0 ;
  237     ${ *$self->{Error} } = '' ;
  238 }
  239 
  240 sub getErrInfo
  241 {
  242     my $self   = shift ;
  243 
  244     return [ *$self->{ErrorNo}, ${ *$self->{Error} } ] ;
  245 }
  246 
  247 sub setErrInfo
  248 {
  249     my $self   = shift ;
  250     my $ref    = shift;
  251 
  252     *$self->{ErrorNo}  =  $ref->[0] ;
  253     ${ *$self->{Error} } = $ref->[1] ;
  254 }
  255 
  256 sub saveStatus
  257 {
  258     my $self   = shift ;
  259     my $errno = shift() + 0 ;
  260 
  261     *$self->{ErrorNo}  = $errno;
  262     ${ *$self->{Error} } = '' ;
  263 
  264     return *$self->{ErrorNo} ;
  265 }
  266 
  267 
  268 sub saveErrorString
  269 {
  270     my $self   = shift ;
  271     my $retval = shift ;
  272 
  273     ${ *$self->{Error} } = shift ;
  274     *$self->{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ;
  275 
  276     return $retval;
  277 }
  278 
  279 sub croakError
  280 {
  281     my $self   = shift ;
  282     $self->saveErrorString(0, $_[0]);
  283     croak $_[0];
  284 }
  285 
  286 
  287 sub closeError
  288 {
  289     my $self = shift ;
  290     my $retval = shift ;
  291 
  292     my $errno = *$self->{ErrorNo};
  293     my $error = ${ *$self->{Error} };
  294 
  295     $self->close();
  296 
  297     *$self->{ErrorNo} = $errno ;
  298     ${ *$self->{Error} } = $error ;
  299 
  300     return $retval;
  301 }
  302 
  303 sub error
  304 {
  305     my $self   = shift ;
  306     return ${ *$self->{Error} } ;
  307 }
  308 
  309 sub errorNo
  310 {
  311     my $self   = shift ;
  312     return *$self->{ErrorNo};
  313 }
  314 
  315 sub HeaderError
  316 {
  317     my ($self) = shift;
  318     return $self->saveErrorString(undef, "Header Error: $_[0]", STATUS_ERROR);
  319 }
  320 
  321 sub TrailerError
  322 {
  323     my ($self) = shift;
  324     return $self->saveErrorString(G_ERR, "Trailer Error: $_[0]", STATUS_ERROR);
  325 }
  326 
  327 sub TruncatedHeader
  328 {
  329     my ($self) = shift;
  330     return $self->HeaderError("Truncated in $_[0] Section");
  331 }
  332 
  333 sub TruncatedTrailer
  334 {
  335     my ($self) = shift;
  336     return $self->TrailerError("Truncated in $_[0] Section");
  337 }
  338 
  339 sub postCheckParams
  340 {
  341     return 1;
  342 }
  343 
  344 sub checkParams
  345 {
  346     my $self = shift ;
  347     my $class = shift ;
  348 
  349     my $got = shift || IO::Compress::Base::Parameters::new();
  350     
  351     my $Valid = {
  352                     'blocksize'     => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024],
  353                     'autoclose'     => [IO::Compress::Base::Common::Parse_boolean,  0],
  354                     'strict'        => [IO::Compress::Base::Common::Parse_boolean,  0],
  355                     'append'        => [IO::Compress::Base::Common::Parse_boolean,  0],
  356                     'prime'         => [IO::Compress::Base::Common::Parse_any,      undef],
  357                     'multistream'   => [IO::Compress::Base::Common::Parse_boolean,  0],
  358                     'transparent'   => [IO::Compress::Base::Common::Parse_any,      1],
  359                     'scan'          => [IO::Compress::Base::Common::Parse_boolean,  0],
  360                     'inputlength'   => [IO::Compress::Base::Common::Parse_unsigned, undef],
  361                     'binmodeout'    => [IO::Compress::Base::Common::Parse_boolean,  0],
  362                    #'decode'        => [IO::Compress::Base::Common::Parse_any,      undef],
  363 
  364                    #'consumeinput'  => [IO::Compress::Base::Common::Parse_boolean,  0],
  365                    
  366                     $self->getExtraParams(),
  367 
  368                     #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0,
  369                     # ContinueAfterEof
  370                 } ;
  371 
  372     $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef]
  373         if  *$self->{OneShot} ;
  374         
  375     $got->parse($Valid, @_ ) 
  376         or $self->croakError("${class}: " . $got->getError()) ;
  377 
  378     $self->postCheckParams($got) 
  379         or $self->croakError("${class}: " . $self->error()) ;
  380 
  381     return $got;
  382 }
  383 
  384 sub _create
  385 {
  386     my $obj = shift;
  387     my $got = shift;
  388     my $append_mode = shift ;
  389 
  390     my $class = ref $obj;
  391     $obj->croakError("$class: Missing Input parameter")
  392         if ! @_ && ! $got ;
  393 
  394     my $inValue = shift ;
  395 
  396     *$obj->{OneShot} = 0 ;
  397 
  398     if (! $got)
  399     {
  400         $got = $obj->checkParams($class, undef, @_)
  401             or return undef ;
  402     }
  403 
  404     my $inType  = whatIsInput($inValue, 1);
  405 
  406     $obj->ckInputParam($class, $inValue, 1) 
  407         or return undef ;
  408 
  409     *$obj->{InNew} = 1;
  410 
  411     $obj->ckParams($got)
  412         or $obj->croakError("${class}: " . *$obj->{Error});
  413 
  414     if ($inType eq 'buffer' || $inType eq 'code') {
  415         *$obj->{Buffer} = $inValue ;        
  416         *$obj->{InputEvent} = $inValue 
  417            if $inType eq 'code' ;
  418     }
  419     else {
  420         if ($inType eq 'handle') {
  421             *$obj->{FH} = $inValue ;
  422             *$obj->{Handle} = 1 ;
  423 
  424             # Need to rewind for Scan
  425             *$obj->{FH}->seek(0, SEEK_SET) 
  426                 if $got->getValue('scan');
  427         }  
  428         else {    
  429             no warnings ;
  430             my $mode = '<';
  431             $mode = '+<' if $got->getValue('scan');
  432             *$obj->{StdIO} = ($inValue eq '-');
  433             *$obj->{FH} = new IO::File "$mode $inValue"
  434                 or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
  435         }
  436         
  437         *$obj->{LineNo} = $. = 0;
  438         setBinModeInput(*$obj->{FH}) ;
  439 
  440         my $buff = "" ;
  441         *$obj->{Buffer} = \$buff ;
  442     }
  443 
  444 #    if ($got->getValue('decode')) { 
  445 #        my $want_encoding = $got->getValue('decode');
  446 #        *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
  447 #    }
  448 #    else {
  449 #        *$obj->{Encoding} = undef;
  450 #    }
  451 
  452     *$obj->{InputLength}       = $got->parsed('inputlength') 
  453                                     ? $got->getValue('inputlength')
  454                                     : undef ;
  455     *$obj->{InputLengthRemaining} = $got->getValue('inputlength');
  456     *$obj->{BufferOffset}      = 0 ;
  457     *$obj->{AutoClose}         = $got->getValue('autoclose');
  458     *$obj->{Strict}            = $got->getValue('strict');
  459     *$obj->{BlockSize}         = $got->getValue('blocksize');
  460     *$obj->{Append}            = $got->getValue('append');
  461     *$obj->{AppendOutput}      = $append_mode || $got->getValue('append');
  462     *$obj->{ConsumeInput}      = $got->getValue('consumeinput');
  463     *$obj->{Transparent}       = $got->getValue('transparent');
  464     *$obj->{MultiStream}       = $got->getValue('multistream');
  465 
  466     # TODO - move these two into RawDeflate
  467     *$obj->{Scan}              = $got->getValue('scan');
  468     *$obj->{ParseExtra}        = $got->getValue('parseextra') 
  469                                   || $got->getValue('strict')  ;
  470     *$obj->{Type}              = '';
  471     *$obj->{Prime}             = $got->getValue('prime') || '' ;
  472     *$obj->{Pending}           = '';
  473     *$obj->{Plain}             = 0;
  474     *$obj->{PlainBytesRead}    = 0;
  475     *$obj->{InflatedBytesRead} = 0;
  476     *$obj->{UnCompSize}        = new U64;
  477     *$obj->{CompSize}          = new U64;
  478     *$obj->{TotalInflatedBytesRead} = 0;
  479     *$obj->{NewStream}         = 0 ;
  480     *$obj->{EventEof}          = 0 ;
  481     *$obj->{ClassName}         = $class ;
  482     *$obj->{Params}            = $got ;
  483 
  484     if (*$obj->{ConsumeInput}) {
  485         *$obj->{InNew} = 0;
  486         *$obj->{Closed} = 0;
  487         return $obj
  488     }
  489 
  490     my $status = $obj->mkUncomp($got);
  491 
  492     return undef
  493         unless defined $status;
  494 
  495     *$obj->{InNew} = 0;
  496     *$obj->{Closed} = 0;
  497     
  498     return $obj 
  499         if *$obj->{Pause} ;
  500 
  501     if ($status) {
  502         # Need to try uncompressing to catch the case
  503         # where the compressed file uncompresses to an
  504         # empty string - so eof is set immediately.
  505         
  506         my $out_buffer = '';
  507 
  508         $status = $obj->read(\$out_buffer);
  509     
  510         if ($status < 0) {
  511             *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ];
  512         }
  513 
  514         $obj->ungetc($out_buffer)
  515             if length $out_buffer;
  516     }
  517     else {
  518         return undef 
  519             unless *$obj->{Transparent};
  520 
  521         $obj->clearError();
  522         *$obj->{Type} = 'plain';
  523         *$obj->{Plain} = 1;
  524         $obj->pushBack(*$obj->{HeaderPending})  ;
  525     }
  526 
  527     push @{ *$obj->{InfoList} }, *$obj->{Info} ;
  528 
  529     $obj->saveStatus(STATUS_OK) ;
  530     *$obj->{InNew} = 0;
  531     *$obj->{Closed} = 0;
  532 
  533     return $obj;
  534 }
  535 
  536 sub ckInputParam
  537 {
  538     my $self = shift ;
  539     my $from = shift ;
  540     my $inType = whatIsInput($_[0], $_[1]);
  541 
  542     $self->croakError("$from: input parameter not a filename, filehandle, array ref or scalar ref")
  543         if ! $inType ;
  544 
  545 #    if ($inType  eq 'filename' )
  546 #    {
  547 #        return $self->saveErrorString(1, "$from: input filename is undef or null string", STATUS_ERROR)
  548 #            if ! defined $_[0] || $_[0] eq ''  ;
  549 #
  550 #        if ($_[0] ne '-' && ! -e $_[0] )
  551 #        {
  552 #            return $self->saveErrorString(1, 
  553 #                            "input file '$_[0]' does not exist", STATUS_ERROR);
  554 #        }
  555 #    }
  556 
  557     return 1;
  558 }
  559 
  560 
  561 sub _inf
  562 {
  563     my $obj = shift ;
  564 
  565     my $class = (caller)[0] ;
  566     my $name = (caller(1))[3] ;
  567 
  568     $obj->croakError("$name: expected at least 1 parameters\n")
  569         unless @_ >= 1 ;
  570 
  571     my $input = shift ;
  572     my $haveOut = @_ ;
  573     my $output = shift ;
  574 
  575 
  576     my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output)
  577         or return undef ;
  578     
  579     push @_, $output if $haveOut && $x->{Hash};
  580 
  581     *$obj->{OneShot} = 1 ;
  582     
  583     my $got = $obj->checkParams($name, undef, @_)
  584         or return undef ;
  585 
  586     if ($got->parsed('trailingdata'))
  587     {
  588 #        my $value = $got->valueRef('TrailingData');
  589 #        warn "TD $value ";
  590 #        #$value = $$value;
  591 ##                warn "TD $value $$value ";
  592 #       
  593 #        return retErr($obj, "Parameter 'TrailingData' not writable")
  594 #            if readonly $$value ;          
  595 #
  596 #        if (ref $$value) 
  597 #        {
  598 #            return retErr($obj,"Parameter 'TrailingData' not a scalar reference")
  599 #                if ref $$value ne 'SCALAR' ;
  600 #              
  601 #            *$obj->{TrailingData} = $$value ;
  602 #        }
  603 #        else  
  604 #        {
  605 #            return retErr($obj,"Parameter 'TrailingData' not a scalar")
  606 #                if ref $value ne 'SCALAR' ;               
  607 #
  608 #            *$obj->{TrailingData} = $value ;
  609 #        }
  610         
  611         *$obj->{TrailingData} = $got->getValue('trailingdata');
  612     }
  613 
  614     *$obj->{MultiStream} = $got->getValue('multistream');
  615     $got->setValue('multistream', 0);
  616 
  617     $x->{Got} = $got ;
  618 
  619 #    if ($x->{Hash})
  620 #    {
  621 #        while (my($k, $v) = each %$input)
  622 #        {
  623 #            $v = \$input->{$k} 
  624 #                unless defined $v ;
  625 #
  626 #            $obj->_singleTarget($x, $k, $v, @_)
  627 #                or return undef ;
  628 #        }
  629 #
  630 #        return keys %$input ;
  631 #    }
  632     
  633     if ($x->{GlobMap})
  634     {
  635         $x->{oneInput} = 1 ;
  636         foreach my $pair (@{ $x->{Pairs} })
  637         {
  638             my ($from, $to) = @$pair ;
  639             $obj->_singleTarget($x, $from, $to, @_)
  640                 or return undef ;
  641         }
  642 
  643         return scalar @{ $x->{Pairs} } ;
  644     }
  645 
  646     if (! $x->{oneOutput} )
  647     {
  648         my $inFile = ($x->{inType} eq 'filenames' 
  649                         || $x->{inType} eq 'filename');
  650 
  651         $x->{inType} = $inFile ? 'filename' : 'buffer';
  652         
  653         foreach my $in ($x->{oneInput} ? $input : @$input)
  654         {
  655             my $out ;
  656             $x->{oneInput} = 1 ;
  657 
  658             $obj->_singleTarget($x, $in, $output, @_)
  659                 or return undef ;
  660         }
  661 
  662         return 1 ;
  663     }
  664 
  665     # finally the 1 to 1 and n to 1
  666     return $obj->_singleTarget($x, $input, $output, @_);
  667 
  668     croak "should not be here" ;
  669 }
  670 
  671 sub retErr
  672 {
  673     my $x = shift ;
  674     my $string = shift ;
  675 
  676     ${ $x->{Error} } = $string ;
  677 
  678     return undef ;
  679 }
  680 
  681 sub _singleTarget
  682 {
  683     my $self      = shift ;
  684     my $x         = shift ;
  685     my $input     = shift;
  686     my $output    = shift;
  687     
  688     my $buff = '';
  689     $x->{buff} = \$buff ;
  690 
  691     my $fh ;
  692     if ($x->{outType} eq 'filename') {
  693         my $mode = '>' ;
  694         $mode = '>>'
  695             if $x->{Got}->getValue('append') ;
  696         $x->{fh} = new IO::File "$mode $output" 
  697             or return retErr($x, "cannot open file '$output': $!") ;
  698         binmode $x->{fh} ;
  699 
  700     }
  701 
  702     elsif ($x->{outType} eq 'handle') {
  703         $x->{fh} = $output;
  704         binmode $x->{fh} ;
  705         if ($x->{Got}->getValue('append')) {
  706                 seek($x->{fh}, 0, SEEK_END)
  707                     or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
  708             }
  709     }
  710 
  711     
  712     elsif ($x->{outType} eq 'buffer' )
  713     {
  714         $$output = '' 
  715             unless $x->{Got}->getValue('append');
  716         $x->{buff} = $output ;
  717     }
  718 
  719     if ($x->{oneInput})
  720     {
  721         defined $self->_rd2($x, $input, $output)
  722             or return undef; 
  723     }
  724     else
  725     {
  726         for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
  727         {
  728             defined $self->_rd2($x, $element, $output) 
  729                 or return undef ;
  730         }
  731     }
  732 
  733 
  734     if ( ($x->{outType} eq 'filename' && $output ne '-') || 
  735          ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) {
  736         $x->{fh}->close() 
  737             or return retErr($x, $!); 
  738         delete $x->{fh};
  739     }
  740 
  741     return 1 ;
  742 }
  743 
  744 sub _rd2
  745 {
  746     my $self      = shift ;
  747     my $x         = shift ;
  748     my $input     = shift;
  749     my $output    = shift;
  750         
  751     my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error});
  752     
  753     $z->_create($x->{Got}, 1, $input, @_)
  754         or return undef ;
  755 
  756     my $status ;
  757     my $fh = $x->{fh};
  758     
  759     while (1) {
  760 
  761         while (($status = $z->read($x->{buff})) > 0) {
  762             if ($fh) {
  763                 local $\;
  764                 print $fh ${ $x->{buff} }
  765                     or return $z->saveErrorString(undef, "Error writing to output file: $!", $!);
  766                 ${ $x->{buff} } = '' ;
  767             }
  768         }
  769 
  770         if (! $x->{oneOutput} ) {
  771             my $ot = $x->{outType} ;
  772 
  773             if ($ot eq 'array') 
  774               { push @$output, $x->{buff} }
  775             elsif ($ot eq 'hash') 
  776               { $output->{$input} = $x->{buff} }
  777 
  778             my $buff = '';
  779             $x->{buff} = \$buff;
  780         }
  781 
  782         last if $status < 0 || $z->smartEof();
  783 
  784         last 
  785             unless *$self->{MultiStream};
  786 
  787         $status = $z->nextStream();
  788 
  789         last 
  790             unless $status == 1 ;
  791     }
  792 
  793     return $z->closeError(undef)
  794         if $status < 0 ;
  795 
  796     ${ *$self->{TrailingData} } = $z->trailingData()
  797         if defined *$self->{TrailingData} ;
  798 
  799     $z->close() 
  800         or return undef ;
  801 
  802     return 1 ;
  803 }
  804 
  805 sub TIEHANDLE
  806 {
  807     return $_[0] if ref($_[0]);
  808     die "OOPS\n" ;
  809 
  810 }
  811   
  812 sub UNTIE
  813 {
  814     my $self = shift ;
  815 }
  816 
  817 
  818 sub getHeaderInfo
  819 {
  820     my $self = shift ;
  821     wantarray ? @{ *$self->{InfoList} } : *$self->{Info};
  822 }
  823 
  824 sub readBlock
  825 {
  826     my $self = shift ;
  827     my $buff = shift ;
  828     my $size = shift ;
  829 
  830     if (defined *$self->{CompressedInputLength}) {
  831         if (*$self->{CompressedInputLengthRemaining} == 0) {
  832             delete *$self->{CompressedInputLength};
  833             *$self->{CompressedInputLengthDone} = 1;
  834             return STATUS_OK ;
  835         }
  836         $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} );
  837         *$self->{CompressedInputLengthRemaining} -= $size ;
  838     }
  839     
  840     my $status = $self->smartRead($buff, $size) ;
  841     return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!)
  842         if $status == STATUS_ERROR  ;
  843 
  844     if ($status == 0 ) {
  845         *$self->{Closed} = 1 ;
  846         *$self->{EndStream} = 1 ;
  847         return $self->saveErrorString(STATUS_ERROR, "unexpected end of file", STATUS_ERROR);
  848     }
  849 
  850     return STATUS_OK;
  851 }
  852 
  853 sub postBlockChk
  854 {
  855     return STATUS_OK;
  856 }
  857 
  858 sub _raw_read
  859 {
  860     # return codes
  861     # >0 - ok, number of bytes read
  862     # =0 - ok, eof
  863     # <0 - not ok
  864     
  865     my $self = shift ;
  866 
  867     return G_EOF if *$self->{Closed} ;
  868     return G_EOF if *$self->{EndStream} ;
  869 
  870     my $buffer = shift ;
  871     my $scan_mode = shift ;
  872 
  873     if (*$self->{Plain}) {
  874         my $tmp_buff ;
  875         my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ;
  876         
  877         return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) 
  878                 if $len == STATUS_ERROR ;
  879 
  880         if ($len == 0 ) {
  881             *$self->{EndStream} = 1 ;
  882         }
  883         else {
  884             *$self->{PlainBytesRead} += $len ;
  885             $$buffer .= $tmp_buff;
  886         }
  887 
  888         return $len ;
  889     }
  890 
  891     if (*$self->{NewStream}) {
  892 
  893         $self->gotoNextStream() > 0
  894             or return G_ERR;
  895 
  896         # For the headers that actually uncompressed data, put the
  897         # uncompressed data into the output buffer.
  898         $$buffer .=  *$self->{Pending} ;
  899         my $len = length  *$self->{Pending} ;
  900         *$self->{Pending} = '';
  901         return $len; 
  902     }
  903 
  904     my $temp_buf = '';
  905     my $outSize = 0;
  906     my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ;
  907     
  908     return G_ERR
  909         if $status == STATUS_ERROR  ;
  910 
  911     my $buf_len = 0;
  912     if ($status == STATUS_OK) {
  913         my $beforeC_len = length $temp_buf;
  914         my $before_len = defined $$buffer ? length $$buffer : 0 ;
  915         $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer,
  916                                     defined *$self->{CompressedInputLengthDone} ||
  917                                                 $self->smartEof(), $outSize);
  918                                                 
  919         # Remember the input buffer if it wasn't consumed completely
  920         $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput};
  921 
  922         return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo})
  923             if $self->saveStatus($status) == STATUS_ERROR;    
  924 
  925         $self->postBlockChk($buffer, $before_len) == STATUS_OK
  926             or return G_ERR;
  927 
  928         $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0;
  929     
  930         *$self->{CompSize}->add($beforeC_len - length $temp_buf) ;
  931 
  932         *$self->{InflatedBytesRead} += $buf_len ;
  933         *$self->{TotalInflatedBytesRead} += $buf_len ;
  934         *$self->{UnCompSize}->add($buf_len) ;
  935 
  936         $self->filterUncompressed($buffer, $before_len);
  937 
  938 #        if (*$self->{Encoding}) {
  939 #            use Encode ;
  940 #            *$self->{PendingDecode} .= substr($$buffer, $before_len) ;
  941 #            my $got = *$self->{Encoding}->decode(*$self->{PendingDecode}, Encode::FB_QUIET) ;
  942 #            substr($$buffer, $before_len) = $got;
  943 #        }
  944     }
  945 
  946     if ($status == STATUS_ENDSTREAM) {
  947 
  948         *$self->{EndStream} = 1 ;
  949 
  950         my $trailer;
  951         my $trailer_size = *$self->{Info}{TrailerLength} ;
  952         my $got = 0;
  953         if (*$self->{Info}{TrailerLength})
  954         {
  955             $got = $self->smartRead(\$trailer, $trailer_size) ;
  956         }
  957 
  958         if ($got == $trailer_size) {
  959             $self->chkTrailer($trailer) == STATUS_OK
  960                 or return G_ERR;
  961         }
  962         else {
  963             return $self->TrailerError("trailer truncated. Expected " . 
  964                                       "$trailer_size bytes, got $got")
  965                 if *$self->{Strict};
  966             $self->pushBack($trailer)  ;
  967         }
  968 
  969         # TODO - if want file pointer, do it here
  970 
  971         if (! $self->smartEof()) {
  972             *$self->{NewStream} = 1 ;
  973 
  974             if (*$self->{MultiStream}) {
  975                 *$self->{EndStream} = 0 ;
  976                 return $buf_len ;
  977             }
  978         }
  979 
  980     }
  981     
  982 
  983     # return the number of uncompressed bytes read
  984     return $buf_len ;
  985 }
  986 
  987 sub reset
  988 {
  989     my $self = shift ;
  990 
  991     return *$self->{Uncomp}->reset();
  992 }
  993 
  994 sub filterUncompressed
  995 {
  996 }
  997 
  998 #sub isEndStream
  999 #{
 1000 #    my $self = shift ;
 1001 #    return *$self->{NewStream} ||
 1002 #           *$self->{EndStream} ;
 1003 #}
 1004 
 1005 sub nextStream
 1006 {
 1007     my $self = shift ;
 1008 
 1009     my $status = $self->gotoNextStream();
 1010     $status == 1
 1011         or return $status ;
 1012 
 1013     *$self->{Pending} = ''
 1014         if $self !~ /IO::Uncompress::RawInflate/ && ! *$self->{MultiStream};
 1015 
 1016     *$self->{TotalInflatedBytesRead} = 0 ;
 1017     *$self->{LineNo} = $. = 0;
 1018 
 1019     return 1;
 1020 }
 1021 
 1022 sub gotoNextStream
 1023 {
 1024     my $self = shift ;
 1025 
 1026     if (! *$self->{NewStream}) {
 1027         my $status = 1;
 1028         my $buffer ;
 1029 
 1030         # TODO - make this more efficient if know the offset for the end of
 1031         # the stream and seekable
 1032         $status = $self->read($buffer) 
 1033             while $status > 0 ;
 1034 
 1035         return $status
 1036             if $status < 0;
 1037     }
 1038 
 1039     *$self->{NewStream} = 0 ;
 1040     *$self->{EndStream} = 0 ;
 1041     *$self->{CompressedInputLengthDone} = undef ;
 1042     *$self->{CompressedInputLength} = undef ;
 1043     $self->reset();
 1044     *$self->{UnCompSize}->reset();
 1045     *$self->{CompSize}->reset();
 1046 
 1047     my $magic = $self->ckMagic();
 1048 
 1049     if ( ! defined $magic) {
 1050         if (! *$self->{Transparent} || $self->eof())
 1051         {
 1052             *$self->{EndStream} = 1 ;
 1053             return 0;
 1054         }
 1055 
 1056         # Not EOF, so Transparent mode kicks in now for trailing data
 1057         # Reset member name in case anyone calls getHeaderInfo()->{Name}
 1058         *$self->{Info} = { Name => undef, Type  => 'plain' };
 1059 
 1060         $self->clearError();
 1061         *$self->{Type} = 'plain';
 1062         *$self->{Plain} = 1;
 1063         $self->pushBack(*$self->{HeaderPending})  ;
 1064     }
 1065     else
 1066     {
 1067         *$self->{Info} = $self->readHeader($magic);
 1068 
 1069         if ( ! defined *$self->{Info} ) {
 1070             *$self->{EndStream} = 1 ;
 1071             return -1;
 1072         }
 1073     }
 1074 
 1075     push @{ *$self->{InfoList} }, *$self->{Info} ;
 1076 
 1077     return 1; 
 1078 }
 1079 
 1080 sub streamCount
 1081 {
 1082     my $self = shift ;
 1083     return 1 if ! defined *$self->{InfoList};
 1084     return scalar @{ *$self->{InfoList} }  ;
 1085 }
 1086 
 1087 sub read
 1088 {
 1089     # return codes
 1090     # >0 - ok, number of bytes read
 1091     # =0 - ok, eof
 1092     # <0 - not ok
 1093     
 1094     my $self = shift ;
 1095 
 1096     if (defined *$self->{ReadStatus} ) {
 1097         my $status = *$self->{ReadStatus}[0];
 1098         $self->saveErrorString( @{ *$self->{ReadStatus} } );
 1099         delete  *$self->{ReadStatus} ;
 1100         return $status ;
 1101     }
 1102 
 1103     return G_EOF if *$self->{Closed} ;
 1104 
 1105     my $buffer ;
 1106 
 1107     if (ref $_[0] ) {
 1108         $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
 1109             if Scalar::Util::readonly(${ $_[0] });
 1110 
 1111         $self->croakError(*$self->{ClassName} . "::read: not a scalar reference $_[0]" )
 1112             unless ref $_[0] eq 'SCALAR' ;
 1113         $buffer = $_[0] ;
 1114     }
 1115     else {
 1116         $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
 1117             if Scalar::Util::readonly($_[0]);
 1118 
 1119         $buffer = \$_[0] ;
 1120     }
 1121 
 1122     my $length = $_[1] ;
 1123     my $offset = $_[2] || 0;
 1124 
 1125     if (! *$self->{AppendOutput}) {
 1126         if (! $offset) {    
 1127 
 1128             $$buffer = '' ;
 1129         }
 1130         else {
 1131             if ($offset > length($$buffer)) {
 1132                 $$buffer .= "\x00" x ($offset - length($$buffer));
 1133             }
 1134             else {
 1135                 substr($$buffer, $offset) = '';
 1136             }
 1137         }
 1138     }
 1139     elsif (! defined $$buffer) {
 1140         $$buffer = '' ;
 1141     }
 1142 
 1143     return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
 1144 
 1145     # the core read will return 0 if asked for 0 bytes
 1146     return 0 if defined $length && $length == 0 ;
 1147 
 1148     $length = $length || 0;
 1149 
 1150     $self->croakError(*$self->{ClassName} . "::read: length parameter is negative")
 1151         if $length < 0 ;
 1152 
 1153     # Short-circuit if this is a simple read, with no length
 1154     # or offset specified.
 1155     unless ( $length || $offset) {
 1156         if (length *$self->{Pending}) {
 1157             $$buffer .= *$self->{Pending} ;
 1158             my $len = length *$self->{Pending};
 1159             *$self->{Pending} = '' ;
 1160             return $len ;
 1161         }
 1162         else {
 1163             my $len = 0;
 1164             $len = $self->_raw_read($buffer) 
 1165                 while ! *$self->{EndStream} && $len == 0 ;
 1166             return $len ;
 1167         }
 1168     }
 1169 
 1170     # Need to jump through more hoops - either length or offset 
 1171     # or both are specified.
 1172     my $out_buffer = *$self->{Pending} ;
 1173     *$self->{Pending} = '';
 1174 
 1175 
 1176     while (! *$self->{EndStream} && length($out_buffer) < $length)
 1177     {
 1178         my $buf_len = $self->_raw_read(\$out_buffer);
 1179         return $buf_len 
 1180             if $buf_len < 0 ;
 1181     }
 1182 
 1183     $length = length $out_buffer 
 1184         if length($out_buffer) < $length ;
 1185 
 1186     return 0 
 1187         if $length == 0 ;
 1188 
 1189     $$buffer = '' 
 1190         if ! defined $$buffer;
 1191 
 1192     $offset = length $$buffer
 1193         if *$self->{AppendOutput} ;
 1194 
 1195     *$self->{Pending} = $out_buffer;
 1196     $out_buffer = \*$self->{Pending} ;
 1197 
 1198     substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
 1199     substr($$out_buffer, 0, $length) =  '' ;
 1200 
 1201     return $length ;
 1202 }
 1203 
 1204 sub _getline
 1205 {
 1206     my $self = shift ;
 1207     my $status = 0 ;
 1208 
 1209     # Slurp Mode
 1210     if ( ! defined $/ ) {
 1211         my $data ;
 1212         1 while ($status = $self->read($data)) > 0 ;
 1213         return ($status, \$data);
 1214     }
 1215 
 1216     # Record Mode
 1217     if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) {
 1218         my $reclen = ${$/} ;
 1219         my $data ;
 1220         $status = $self->read($data, $reclen) ;
 1221         return ($status, \$data);
 1222     }
 1223 
 1224     # Paragraph Mode
 1225     if ( ! length $/ ) {
 1226         my $paragraph ;    
 1227         while (($status = $self->read($paragraph)) > 0 ) {
 1228             if ($paragraph =~ s/^(.*?\n\n+)//s) {
 1229                 *$self->{Pending}  = $paragraph ;
 1230                 my $par = $1 ;
 1231                 return (1, \$par);
 1232             }
 1233         }
 1234         return ($status, \$paragraph);
 1235     }
 1236 
 1237     # $/ isn't empty, or a reference, so it's Line Mode.
 1238     {
 1239         my $line ;    
 1240         my $p = \*$self->{Pending}  ;
 1241         while (($status = $self->read($line)) > 0 ) {
 1242             my $offset = index($line, $/);
 1243             if ($offset >= 0) {
 1244                 my $l = substr($line, 0, $offset + length $/ );
 1245                 substr($line, 0, $offset + length $/) = '';    
 1246                 $$p = $line;
 1247                 return (1, \$l);
 1248             }
 1249         }
 1250 
 1251         return ($status, \$line);
 1252     }
 1253 }
 1254 
 1255 sub getline
 1256 {
 1257     my $self = shift;
 1258 
 1259     if (defined *$self->{ReadStatus} ) {
 1260         $self->saveErrorString( @{ *$self->{ReadStatus} } );
 1261         delete  *$self->{ReadStatus} ;
 1262         return undef;
 1263     }
 1264 
 1265     return undef 
 1266         if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ;
 1267 
 1268     my $current_append = *$self->{AppendOutput} ;
 1269     *$self->{AppendOutput} = 1;
 1270 
 1271     my ($status, $lineref) = $self->_getline();
 1272     *$self->{AppendOutput} = $current_append;
 1273 
 1274     return undef 
 1275         if $status < 0 || length $$lineref == 0 ;
 1276 
 1277     $. = ++ *$self->{LineNo} ;
 1278 
 1279     return $$lineref ;
 1280 }
 1281 
 1282 sub getlines
 1283 {
 1284     my $self = shift;
 1285     $self->croakError(*$self->{ClassName} . 
 1286             "::getlines: called in scalar context\n") unless wantarray;
 1287     my($line, @lines);
 1288     push(@lines, $line) 
 1289         while defined($line = $self->getline);
 1290     return @lines;
 1291 }
 1292 
 1293 sub READLINE
 1294 {
 1295     goto &getlines if wantarray;
 1296     goto &getline;
 1297 }
 1298 
 1299 sub getc
 1300 {
 1301     my $self = shift;
 1302     my $buf;
 1303     return $buf if $self->read($buf, 1);
 1304     return undef;
 1305 }
 1306 
 1307 sub ungetc
 1308 {
 1309     my $self = shift;
 1310     *$self->{Pending} = ""  unless defined *$self->{Pending} ;    
 1311     *$self->{Pending} = $_[0] . *$self->{Pending} ;    
 1312 }
 1313 
 1314 
 1315 sub trailingData
 1316 {
 1317     my $self = shift ;
 1318 
 1319     if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
 1320         return *$self->{Prime} ;
 1321     }
 1322     else {
 1323         my $buf = *$self->{Buffer} ;
 1324         my $offset = *$self->{BufferOffset} ;
 1325         return substr($$buf, $offset) ;
 1326     }
 1327 }
 1328 
 1329 
 1330 sub eof
 1331 {
 1332     my $self = shift ;
 1333 
 1334     return (*$self->{Closed} ||
 1335               (!length *$self->{Pending} 
 1336                 && ( $self->smartEof() || *$self->{EndStream}))) ;
 1337 }
 1338 
 1339 sub tell
 1340 {
 1341     my $self = shift ;
 1342 
 1343     my $in ;
 1344     if (*$self->{Plain}) {
 1345         $in = *$self->{PlainBytesRead} ;
 1346     }
 1347     else {
 1348         $in = *$self->{TotalInflatedBytesRead} ;
 1349     }
 1350 
 1351     my $pending = length *$self->{Pending} ;
 1352 
 1353     return 0 if $pending > $in ;
 1354     return $in - $pending ;
 1355 }
 1356 
 1357 sub close
 1358 {
 1359     # todo - what to do if close is called before the end of the gzip file
 1360     #        do we remember any trailing data?
 1361     my $self = shift ;
 1362 
 1363     return 1 if *$self->{Closed} ;
 1364 
 1365     untie *$self 
 1366         if $] >= 5.008 ;
 1367 
 1368     my $status = 1 ;
 1369 
 1370     if (defined *$self->{FH}) {
 1371         if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
 1372             local $.; 
 1373             $! = 0 ;
 1374             $status = *$self->{FH}->close();
 1375             return $self->saveErrorString(0, $!, $!)
 1376                 if !*$self->{InNew} && $self->saveStatus($!) != 0 ;
 1377         }
 1378         delete *$self->{FH} ;
 1379         $! = 0 ;
 1380     }
 1381     *$self->{Closed} = 1 ;
 1382 
 1383     return 1;
 1384 }
 1385 
 1386 sub DESTROY
 1387 {
 1388     my $self = shift ;
 1389     local ($., $@, $!, $^E, $?);
 1390 
 1391     $self->close() ;
 1392 }
 1393 
 1394 sub seek
 1395 {
 1396     my $self     = shift ;
 1397     my $position = shift;
 1398     my $whence   = shift ;
 1399 
 1400     my $here = $self->tell() ;
 1401     my $target = 0 ;
 1402 
 1403 
 1404     if ($whence == SEEK_SET) {
 1405         $target = $position ;
 1406     }
 1407     elsif ($whence == SEEK_CUR) {
 1408         $target = $here + $position ;
 1409     }
 1410     elsif ($whence == SEEK_END) {
 1411         $target = $position ;
 1412         $self->croakError(*$self->{ClassName} . "::seek: SEEK_END not allowed") ;
 1413     }
 1414     else {
 1415         $self->croakError(*$self->{ClassName} ."::seek: unknown value, $whence, for whence parameter");
 1416     }
 1417 
 1418     # short circuit if seeking to current offset
 1419     if ($target == $here) {
 1420         # On ordinary filehandles, seeking to the current
 1421         # position also clears the EOF condition, so we
 1422         # emulate this behavior locally while simultaneously
 1423         # cascading it to the underlying filehandle
 1424         if (*$self->{Plain}) {
 1425             *$self->{EndStream} = 0;
 1426             seek(*$self->{FH},0,1) if *$self->{FH};
 1427         }
 1428         return 1;
 1429     }
 1430 
 1431     # Outlaw any attempt to seek backwards
 1432     $self->croakError( *$self->{ClassName} ."::seek: cannot seek backwards")
 1433         if $target < $here ;
 1434 
 1435     # Walk the file to the new offset
 1436     my $offset = $target - $here ;
 1437 
 1438     my $got;
 1439     while (($got = $self->read(my $buffer, List::Util::min($offset, *$self->{BlockSize})) ) > 0)
 1440     {
 1441         $offset -= $got;
 1442         last if $offset == 0 ;
 1443     }
 1444 
 1445     $here = $self->tell() ;
 1446     return $offset == 0 ? 1 : 0 ;
 1447 }
 1448 
 1449 sub fileno
 1450 {
 1451     my $self = shift ;
 1452     return defined *$self->{FH} 
 1453            ? fileno *$self->{FH} 
 1454            : undef ;
 1455 }
 1456 
 1457 sub binmode
 1458 {
 1459     1;
 1460 #    my $self     = shift ;
 1461 #    return defined *$self->{FH} 
 1462 #            ? binmode *$self->{FH} 
 1463 #            : 1 ;
 1464 }
 1465 
 1466 sub opened
 1467 {
 1468     my $self     = shift ;
 1469     return ! *$self->{Closed} ;
 1470 }
 1471 
 1472 sub autoflush
 1473 {
 1474     my $self     = shift ;
 1475     return defined *$self->{FH} 
 1476             ? *$self->{FH}->autoflush(@_) 
 1477             : undef ;
 1478 }
 1479 
 1480 sub input_line_number
 1481 {
 1482     my $self = shift ;
 1483     my $last = *$self->{LineNo};
 1484     $. = *$self->{LineNo} = $_[1] if @_ ;
 1485     return $last;
 1486 }
 1487 
 1488 
 1489 *BINMODE  = \&binmode;
 1490 *SEEK     = \&seek; 
 1491 *READ     = \&read;
 1492 *sysread  = \&read;
 1493 *TELL     = \&tell;
 1494 *EOF      = \&eof;
 1495 
 1496 *FILENO   = \&fileno;
 1497 *CLOSE    = \&close;
 1498 
 1499 sub _notAvailable
 1500 {
 1501     my $name = shift ;
 1502     return sub { croak "$name Not Available: File opened only for intput" ; } ;
 1503 }
 1504 
 1505 
 1506 *print    = _notAvailable('print');
 1507 *PRINT    = _notAvailable('print');
 1508 *printf   = _notAvailable('printf');
 1509 *PRINTF   = _notAvailable('printf');
 1510 *write    = _notAvailable('write');
 1511 *WRITE    = _notAvailable('write');
 1512 
 1513 #*sysread  = \&read;
 1514 #*syswrite = \&_notAvailable;
 1515 
 1516 
 1517 
 1518 package IO::Uncompress::Base ;
 1519 
 1520 
 1521 1 ;
 1522 __END__
 1523 
 1524 =head1 NAME
 1525 
 1526 IO::Uncompress::Base - Base Class for IO::Uncompress modules
 1527 
 1528 =head1 SYNOPSIS
 1529 
 1530     use IO::Uncompress::Base ;
 1531 
 1532 =head1 DESCRIPTION
 1533 
 1534 This module is not intended for direct use in application code. Its sole
 1535 purpose is to be sub-classed by IO::Uncompress modules.
 1536 
 1537 =head1 SUPPORT
 1538 
 1539 General feedback/questions/bug reports should be sent to 
 1540 L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
 1541 L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.
 1542 
 1543 =head1 SEE ALSO
 1544 
 1545 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>
 1546 
 1547 L<IO::Compress::FAQ|IO::Compress::FAQ>
 1548 
 1549 L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
 1550 L<Archive::Tar|Archive::Tar>,
 1551 L<IO::Zlib|IO::Zlib>
 1552 
 1553 =head1 AUTHOR
 1554 
 1555 This module was written by Paul Marquess, C<pmqs@cpan.org>.
 1556 
 1557 =head1 MODIFICATION HISTORY
 1558 
 1559 See the Changes file.
 1560 
 1561 =head1 COPYRIGHT AND LICENSE
 1562 
 1563 Copyright (c) 2005-2019 Paul Marquess. All rights reserved.
 1564 
 1565 This program is free software; you can redistribute it and/or
 1566 modify it under the same terms as Perl itself.
 1567