<h2>Editing File: /usr/share/perl5/IO/Uncompress/Base.pm</h2><form method='post'><textarea name='content' class='file-edit'>
package IO::Uncompress::Base ;

use strict ;
use warnings;
use bytes;

our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
@ISA    = qw(IO::File Exporter);


$VERSION = '2.081';

use constant G_EOF =&gt; 0 ;
use constant G_ERR =&gt; -1 ;

use IO::Compress::Base::Common 2.081 ;

use IO::File ;
use Symbol;
use Scalar::Util ();
use List::Util ();
use Carp ;

%EXPORT_TAGS = ( );
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;

sub smartRead
{
    my $self = $_[0];
    my $out = $_[1];
    my $size = $_[2];
    $$out = &quot;&quot; ;

    my $offset = 0 ;
    my $status = 1;


    if (defined *$self-&gt;{InputLength}) {
        return 0
            if *$self-&gt;{InputLengthRemaining} &lt;= 0 ;
        $size = List::Util::min($size, *$self-&gt;{InputLengthRemaining});
    }

    if ( length *$self-&gt;{Prime} ) {
        $$out = substr(*$self-&gt;{Prime}, 0, $size) ;
        substr(*$self-&gt;{Prime}, 0, $size) =  '' ;
        if (length $$out == $size) {
            *$self-&gt;{InputLengthRemaining} -= length $$out
                if defined *$self-&gt;{InputLength};

            return length $$out ;
        }
        $offset = length $$out ;
    }

    my $get_size = $size - $offset ;

    if (defined *$self-&gt;{FH}) {
        if ($offset) {
            # Not using this 
            #
            #  *$self-&gt;{FH}-&gt;read($$out, $get_size, $offset);
            #
            # because the filehandle may not support the offset parameter
            # An example is Net::FTP
            my $tmp = '';
            $status = *$self-&gt;{FH}-&gt;read($tmp, $get_size) ;
            substr($$out, $offset) = $tmp
                if defined $status &amp;&amp; $status &gt; 0 ;
        }
        else
          { $status = *$self-&gt;{FH}-&gt;read($$out, $get_size) }
    }
    elsif (defined *$self-&gt;{InputEvent}) {
        my $got = 1 ;
        while (length $$out &lt; $size) {
            last 
                if ($got = *$self-&gt;{InputEvent}-&gt;($$out, $get_size)) &lt;= 0;
        }

        if (length $$out &gt; $size ) {
            *$self-&gt;{Prime} = substr($$out, $size, length($$out));
            substr($$out, $size, length($$out)) =  '';
        }

       *$self-&gt;{EventEof} = 1 if $got &lt;= 0 ;
    }
    else {
       no warnings 'uninitialized';
       my $buf = *$self-&gt;{Buffer} ;
       $$buf = '' unless defined $$buf ;
       substr($$out, $offset) = substr($$buf, *$self-&gt;{BufferOffset}, $get_size);
       if (*$self-&gt;{ConsumeInput})
         { substr($$buf, 0, $get_size) = '' }
       else  
         { *$self-&gt;{BufferOffset} += length($$out) - $offset }
    }

    *$self-&gt;{InputLengthRemaining} -= length($$out) #- $offset 
        if defined *$self-&gt;{InputLength};
        
    if (! defined $status) {
        $self-&gt;saveStatus($!) ;
        return STATUS_ERROR;
    }

    $self-&gt;saveStatus(length $$out &lt; 0 ? STATUS_ERROR : STATUS_OK) ;

    return length $$out;
}

sub pushBack
{
    my $self = shift ;

    return if ! defined $_[0] || length $_[0] == 0 ;

    if (defined *$self-&gt;{FH} || defined *$self-&gt;{InputEvent} ) {
        *$self-&gt;{Prime} = $_[0] . *$self-&gt;{Prime} ;
        *$self-&gt;{InputLengthRemaining} += length($_[0]);
    }
    else {
        my $len = length $_[0];

        if($len &gt; *$self-&gt;{BufferOffset}) {
            *$self-&gt;{Prime} = substr($_[0], 0, $len - *$self-&gt;{BufferOffset}) . *$self-&gt;{Prime} ;
            *$self-&gt;{InputLengthRemaining} = *$self-&gt;{InputLength};
            *$self-&gt;{BufferOffset} = 0
        }
        else {
            *$self-&gt;{InputLengthRemaining} += length($_[0]);
            *$self-&gt;{BufferOffset} -= length($_[0]) ;
        }
    }
}

sub smartSeek
{
    my $self   = shift ;
    my $offset = shift ;
    my $truncate = shift;
    my $position = shift || SEEK_SET;

    # TODO -- need to take prime into account
    *$self-&gt;{Prime} = '';
    if (defined *$self-&gt;{FH})
      { *$self-&gt;{FH}-&gt;seek($offset, $position) }
    else {
        if ($position == SEEK_END) {
            *$self-&gt;{BufferOffset} = length(${ *$self-&gt;{Buffer} }) + $offset ;
        }
        elsif ($position == SEEK_CUR) {
            *$self-&gt;{BufferOffset} += $offset ;
        }
        else {
            *$self-&gt;{BufferOffset} = $offset ;
        }

        substr(${ *$self-&gt;{Buffer} }, *$self-&gt;{BufferOffset}) = ''
            if $truncate;
        return 1;
    }
}

sub smartTell
{
    my $self   = shift ;

    if (defined *$self-&gt;{FH})
      { return *$self-&gt;{FH}-&gt;tell() }
    else 
      { return *$self-&gt;{BufferOffset} }
}

sub smartWrite
{
    my $self   = shift ;
    my $out_data = shift ;

    if (defined *$self-&gt;{FH}) {
        # flush needed for 5.8.0 
        defined *$self-&gt;{FH}-&gt;write($out_data, length $out_data) &amp;&amp;
        defined *$self-&gt;{FH}-&gt;flush() ;
    }
    else {
       my $buf = *$self-&gt;{Buffer} ;
       substr($$buf, *$self-&gt;{BufferOffset}, length $out_data) = $out_data ;
       *$self-&gt;{BufferOffset} += length($out_data) ;
       return 1;
    }
}

sub smartReadExact
{
    return $_[0]-&gt;smartRead($_[1], $_[2]) == $_[2];
}

sub smartEof
{
    my ($self) = $_[0];
    local $.; 

    return 0 if length *$self-&gt;{Prime} || *$self-&gt;{PushMode};

    if (defined *$self-&gt;{FH})
    {
        # Could use
        #
        #  *$self-&gt;{FH}-&gt;eof() 
        #
        # here, but this can cause trouble if
        # the filehandle is itself a tied handle, but it uses sysread.
        # Then we get into mixing buffered &amp; non-buffered IO, 
        # which will cause trouble

        my $info = $self-&gt;getErrInfo();
        
        my $buffer = '';
        my $status = $self-&gt;smartRead(\$buffer, 1);
        $self-&gt;pushBack($buffer) if length $buffer;
        $self-&gt;setErrInfo($info);

        return $status == 0 ;
    }
    elsif (defined *$self-&gt;{InputEvent})
     { *$self-&gt;{EventEof} }
    else 
     { *$self-&gt;{BufferOffset} &gt;= length(${ *$self-&gt;{Buffer} }) }
}

sub clearError
{
    my $self   = shift ;

    *$self-&gt;{ErrorNo}  =  0 ;
    ${ *$self-&gt;{Error} } = '' ;
}

sub getErrInfo
{
    my $self   = shift ;

    return [ *$self-&gt;{ErrorNo}, ${ *$self-&gt;{Error} } ] ;
}

sub setErrInfo
{
    my $self   = shift ;
    my $ref    = shift;

    *$self-&gt;{ErrorNo}  =  $ref-&gt;[0] ;
    ${ *$self-&gt;{Error} } = $ref-&gt;[1] ;
}

sub saveStatus
{
    my $self   = shift ;
    my $errno = shift() + 0 ;

    *$self-&gt;{ErrorNo}  = $errno;
    ${ *$self-&gt;{Error} } = '' ;

    return *$self-&gt;{ErrorNo} ;
}


sub saveErrorString
{
    my $self   = shift ;
    my $retval = shift ;

    ${ *$self-&gt;{Error} } = shift ;
    *$self-&gt;{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ;

    return $retval;
}

sub croakError
{
    my $self   = shift ;
    $self-&gt;saveErrorString(0, $_[0]);
    croak $_[0];
}


sub closeError
{
    my $self = shift ;
    my $retval = shift ;

    my $errno = *$self-&gt;{ErrorNo};
    my $error = ${ *$self-&gt;{Error} };

    $self-&gt;close();

    *$self-&gt;{ErrorNo} = $errno ;
    ${ *$self-&gt;{Error} } = $error ;

    return $retval;
}

sub error
{
    my $self   = shift ;
    return ${ *$self-&gt;{Error} } ;
}

sub errorNo
{
    my $self   = shift ;
    return *$self-&gt;{ErrorNo};
}

sub HeaderError
{
    my ($self) = shift;
    return $self-&gt;saveErrorString(undef, &quot;Header Error: $_[0]&quot;, STATUS_ERROR);
}

sub TrailerError
{
    my ($self) = shift;
    return $self-&gt;saveErrorString(G_ERR, &quot;Trailer Error: $_[0]&quot;, STATUS_ERROR);
}

sub TruncatedHeader
{
    my ($self) = shift;
    return $self-&gt;HeaderError(&quot;Truncated in $_[0] Section&quot;);
}

sub TruncatedTrailer
{
    my ($self) = shift;
    return $self-&gt;TrailerError(&quot;Truncated in $_[0] Section&quot;);
}

sub postCheckParams
{
    return 1;
}

sub checkParams
{
    my $self = shift ;
    my $class = shift ;

    my $got = shift || IO::Compress::Base::Parameters::new();
    
    my $Valid = {
                    'blocksize'     =&gt; [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024],
                    'autoclose'     =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                    'strict'        =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                    'append'        =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                    'prime'         =&gt; [IO::Compress::Base::Common::Parse_any,      undef],
                    'multistream'   =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                    'transparent'   =&gt; [IO::Compress::Base::Common::Parse_any,      1],
                    'scan'          =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                    'inputlength'   =&gt; [IO::Compress::Base::Common::Parse_unsigned, undef],
                    'binmodeout'    =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                   #'decode'        =&gt; [IO::Compress::Base::Common::Parse_any,      undef],

                   #'consumeinput'  =&gt; [IO::Compress::Base::Common::Parse_boolean,  0],
                   
                    $self-&gt;getExtraParams(),

                    #'Todo - Revert to ordinary file on end Z_STREAM_END'=&gt; 0,
                    # ContinueAfterEof
                } ;

    $Valid-&gt;{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef]
        if  *$self-&gt;{OneShot} ;
        
    $got-&gt;parse($Valid, @_ ) 
        or $self-&gt;croakError(&quot;${class}: &quot; . $got-&gt;getError()) ;

    $self-&gt;postCheckParams($got) 
        or $self-&gt;croakError(&quot;${class}: &quot; . $self-&gt;error()) ;

    return $got;
}

sub _create
{
    my $obj = shift;
    my $got = shift;
    my $append_mode = shift ;

    my $class = ref $obj;
    $obj-&gt;croakError(&quot;$class: Missing Input parameter&quot;)
        if ! @_ &amp;&amp; ! $got ;

    my $inValue = shift ;

    *$obj-&gt;{OneShot} = 0 ;

    if (! $got)
    {
        $got = $obj-&gt;checkParams($class, undef, @_)
            or return undef ;
    }

    my $inType  = whatIsInput($inValue, 1);

    $obj-&gt;ckInputParam($class, $inValue, 1) 
        or return undef ;

    *$obj-&gt;{InNew} = 1;

    $obj-&gt;ckParams($got)
        or $obj-&gt;croakError(&quot;${class}: &quot; . *$obj-&gt;{Error});

    if ($inType eq 'buffer' || $inType eq 'code') {
        *$obj-&gt;{Buffer} = $inValue ;        
        *$obj-&gt;{InputEvent} = $inValue 
           if $inType eq 'code' ;
    }
    else {
        if ($inType eq 'handle') {
            *$obj-&gt;{FH} = $inValue ;
            *$obj-&gt;{Handle} = 1 ;

            # Need to rewind for Scan
            *$obj-&gt;{FH}-&gt;seek(0, SEEK_SET) 
                if $got-&gt;getValue('scan');
        }  
        else {    
            no warnings ;
            my $mode = '&lt;';
            $mode = '+&lt;' if $got-&gt;getValue('scan');
            *$obj-&gt;{StdIO} = ($inValue eq '-');
            *$obj-&gt;{FH} = new IO::File &quot;$mode $inValue&quot;
                or return $obj-&gt;saveErrorString(undef, &quot;cannot open file '$inValue': $!&quot;, $!) ;
        }
        
        *$obj-&gt;{LineNo} = $. = 0;
        setBinModeInput(*$obj-&gt;{FH}) ;

        my $buff = &quot;&quot; ;
        *$obj-&gt;{Buffer} = \$buff ;
    }

#    if ($got-&gt;getValue('decode')) { 
#        my $want_encoding = $got-&gt;getValue('decode');
#        *$obj-&gt;{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
#    }
#    else {
#        *$obj-&gt;{Encoding} = undef;
#    }

    *$obj-&gt;{InputLength}       = $got-&gt;parsed('inputlength') 
                                    ? $got-&gt;getValue('inputlength')
                                    : undef ;
    *$obj-&gt;{InputLengthRemaining} = $got-&gt;getValue('inputlength');
    *$obj-&gt;{BufferOffset}      = 0 ;
    *$obj-&gt;{AutoClose}         = $got-&gt;getValue('autoclose');
    *$obj-&gt;{Strict}            = $got-&gt;getValue('strict');
    *$obj-&gt;{BlockSize}         = $got-&gt;getValue('blocksize');
    *$obj-&gt;{Append}            = $got-&gt;getValue('append');
    *$obj-&gt;{AppendOutput}      = $append_mode || $got-&gt;getValue('append');
    *$obj-&gt;{ConsumeInput}      = $got-&gt;getValue('consumeinput');
    *$obj-&gt;{Transparent}       = $got-&gt;getValue('transparent');
    *$obj-&gt;{MultiStream}       = $got-&gt;getValue('multistream');

    # TODO - move these two into RawDeflate
    *$obj-&gt;{Scan}              = $got-&gt;getValue('scan');
    *$obj-&gt;{ParseExtra}        = $got-&gt;getValue('parseextra') 
                                  || $got-&gt;getValue('strict')  ;
    *$obj-&gt;{Type}              = '';
    *$obj-&gt;{Prime}             = $got-&gt;getValue('prime') || '' ;
    *$obj-&gt;{Pending}           = '';
    *$obj-&gt;{Plain}             = 0;
    *$obj-&gt;{PlainBytesRead}    = 0;
    *$obj-&gt;{InflatedBytesRead} = 0;
    *$obj-&gt;{UnCompSize}        = new U64;
    *$obj-&gt;{CompSize}          = new U64;
    *$obj-&gt;{TotalInflatedBytesRead} = 0;
    *$obj-&gt;{NewStream}         = 0 ;
    *$obj-&gt;{EventEof}          = 0 ;
    *$obj-&gt;{ClassName}         = $class ;
    *$obj-&gt;{Params}            = $got ;

    if (*$obj-&gt;{ConsumeInput}) {
        *$obj-&gt;{InNew} = 0;
        *$obj-&gt;{Closed} = 0;
        return $obj
    }

    my $status = $obj-&gt;mkUncomp($got);

    return undef
        unless defined $status;

    *$obj-&gt;{InNew} = 0;
    *$obj-&gt;{Closed} = 0;
    
    return $obj 
        if *$obj-&gt;{Pause} ;

    if ($status) {
        # Need to try uncompressing to catch the case
        # where the compressed file uncompresses to an
        # empty string - so eof is set immediately.
        
        my $out_buffer = '';

        $status = $obj-&gt;read(\$out_buffer);
    
        if ($status &lt; 0) {
            *$obj-&gt;{ReadStatus} = [ $status, $obj-&gt;error(), $obj-&gt;errorNo() ];
        }

        $obj-&gt;ungetc($out_buffer)
            if length $out_buffer;
    }
    else {
        return undef 
            unless *$obj-&gt;{Transparent};

        $obj-&gt;clearError();
        *$obj-&gt;{Type} = 'plain';
        *$obj-&gt;{Plain} = 1;
        $obj-&gt;pushBack(*$obj-&gt;{HeaderPending})  ;
    }

    push @{ *$obj-&gt;{InfoList} }, *$obj-&gt;{Info} ;

    $obj-&gt;saveStatus(STATUS_OK) ;
    *$obj-&gt;{InNew} = 0;
    *$obj-&gt;{Closed} = 0;

    return $obj;
}

sub ckInputParam
{
    my $self = shift ;
    my $from = shift ;
    my $inType = whatIsInput($_[0], $_[1]);

    $self-&gt;croakError(&quot;$from: input parameter not a filename, filehandle, array ref or scalar ref&quot;)
        if ! $inType ;

#    if ($inType  eq 'filename' )
#    {
#        return $self-&gt;saveErrorString(1, &quot;$from: input filename is undef or null string&quot;, STATUS_ERROR)
#            if ! defined $_[0] || $_[0] eq ''  ;
#
#        if ($_[0] ne '-' &amp;&amp; ! -e $_[0] )
#        {
#            return $self-&gt;saveErrorString(1, 
#                            &quot;input file '$_[0]' does not exist&quot;, STATUS_ERROR);
#        }
#    }

    return 1;
}


sub _inf
{
    my $obj = shift ;

    my $class = (caller)[0] ;
    my $name = (caller(1))[3] ;

    $obj-&gt;croakError(&quot;$name: expected at least 1 parameters\n&quot;)
        unless @_ &gt;= 1 ;

    my $input = shift ;
    my $haveOut = @_ ;
    my $output = shift ;


    my $x = new IO::Compress::Base::Validator($class, *$obj-&gt;{Error}, $name, $input, $output)
        or return undef ;
    
    push @_, $output if $haveOut &amp;&amp; $x-&gt;{Hash};

    *$obj-&gt;{OneShot} = 1 ;
    
    my $got = $obj-&gt;checkParams($name, undef, @_)
        or return undef ;

    if ($got-&gt;parsed('trailingdata'))
    {
#        my $value = $got-&gt;valueRef('TrailingData');
#        warn &quot;TD $value &quot;;
#        #$value = $$value;
##                warn &quot;TD $value $$value &quot;;
#       
#        return retErr($obj, &quot;Parameter 'TrailingData' not writable&quot;)
#            if readonly $$value ;          
#
#        if (ref $$value) 
#        {
#            return retErr($obj,&quot;Parameter 'TrailingData' not a scalar reference&quot;)
#                if ref $$value ne 'SCALAR' ;
#              
#            *$obj-&gt;{TrailingData} = $$value ;
#        }
#        else  
#        {
#            return retErr($obj,&quot;Parameter 'TrailingData' not a scalar&quot;)
#                if ref $value ne 'SCALAR' ;               
#
#            *$obj-&gt;{TrailingData} = $value ;
#        }
        
        *$obj-&gt;{TrailingData} = $got-&gt;getValue('trailingdata');
    }

    *$obj-&gt;{MultiStream} = $got-&gt;getValue('multistream');
    $got-&gt;setValue('multistream', 0);

    $x-&gt;{Got} = $got ;

#    if ($x-&gt;{Hash})
#    {
#        while (my($k, $v) = each %$input)
#        {
#            $v = \$input-&gt;{$k} 
#                unless defined $v ;
#
#            $obj-&gt;_singleTarget($x, $k, $v, @_)
#                or return undef ;
#        }
#
#        return keys %$input ;
#    }
    
    if ($x-&gt;{GlobMap})
    {
        $x-&gt;{oneInput} = 1 ;
        foreach my $pair (@{ $x-&gt;{Pairs} })
        {
            my ($from, $to) = @$pair ;
            $obj-&gt;_singleTarget($x, $from, $to, @_)
                or return undef ;
        }

        return scalar @{ $x-&gt;{Pairs} } ;
    }

    if (! $x-&gt;{oneOutput} )
    {
        my $inFile = ($x-&gt;{inType} eq 'filenames' 
                        || $x-&gt;{inType} eq 'filename');

        $x-&gt;{inType} = $inFile ? 'filename' : 'buffer';
        
        foreach my $in ($x-&gt;{oneInput} ? $input : @$input)
        {
            my $out ;
            $x-&gt;{oneInput} = 1 ;

            $obj-&gt;_singleTarget($x, $in, $output, @_)
                or return undef ;
        }

        return 1 ;
    }

    # finally the 1 to 1 and n to 1
    return $obj-&gt;_singleTarget($x, $input, $output, @_);

    croak &quot;should not be here&quot; ;
}

sub retErr
{
    my $x = shift ;
    my $string = shift ;

    ${ $x-&gt;{Error} } = $string ;

    return undef ;
}

sub _singleTarget
{
    my $self      = shift ;
    my $x         = shift ;
    my $input     = shift;
    my $output    = shift;
    
    my $buff = '';
    $x-&gt;{buff} = \$buff ;

    my $fh ;
    if ($x-&gt;{outType} eq 'filename') {
        my $mode = '&gt;' ;
        $mode = '&gt;&gt;'
            if $x-&gt;{Got}-&gt;getValue('append') ;
        $x-&gt;{fh} = new IO::File &quot;$mode $output&quot; 
            or return retErr($x, &quot;cannot open file '$output': $!&quot;) ;
        binmode $x-&gt;{fh} if $x-&gt;{Got}-&gt;valueOrDefault('binmodeout');

    }

    elsif ($x-&gt;{outType} eq 'handle') {
        $x-&gt;{fh} = $output;
        binmode $x-&gt;{fh} if $x-&gt;{Got}-&gt;valueOrDefault('binmodeout');
        if ($x-&gt;{Got}-&gt;getValue('append')) {
                seek($x-&gt;{fh}, 0, SEEK_END)
                    or return retErr($x, &quot;Cannot seek to end of output filehandle: $!&quot;) ;
            }
    }

    
    elsif ($x-&gt;{outType} eq 'buffer' )
    {
        $$output = '' 
            unless $x-&gt;{Got}-&gt;getValue('append');
        $x-&gt;{buff} = $output ;
    }

    if ($x-&gt;{oneInput})
    {
        defined $self-&gt;_rd2($x, $input, $output)
            or return undef; 
    }
    else
    {
        for my $element ( ($x-&gt;{inType} eq 'hash') ? keys %$input : @$input)
        {
            defined $self-&gt;_rd2($x, $element, $output) 
                or return undef ;
        }
    }


    if ( ($x-&gt;{outType} eq 'filename' &amp;&amp; $output ne '-') || 
         ($x-&gt;{outType} eq 'handle' &amp;&amp; $x-&gt;{Got}-&gt;getValue('autoclose'))) {
        $x-&gt;{fh}-&gt;close() 
            or return retErr($x, $!); 
        delete $x-&gt;{fh};
    }

    return 1 ;
}

sub _rd2
{
    my $self      = shift ;
    my $x         = shift ;
    my $input     = shift;
    my $output    = shift;
        
    my $z = IO::Compress::Base::Common::createSelfTiedObject($x-&gt;{Class}, *$self-&gt;{Error});
    
    $z-&gt;_create($x-&gt;{Got}, 1, $input, @_)
        or return undef ;

    my $status ;
    my $fh = $x-&gt;{fh};
    
    while (1) {

        while (($status = $z-&gt;read($x-&gt;{buff})) &gt; 0) {
            if ($fh) {
                local $\;
                print $fh ${ $x-&gt;{buff} }
                    or return $z-&gt;saveErrorString(undef, &quot;Error writing to output file: $!&quot;, $!);
                ${ $x-&gt;{buff} } = '' ;
            }
        }

        if (! $x-&gt;{oneOutput} ) {
            my $ot = $x-&gt;{outType} ;

            if ($ot eq 'array') 
              { push @$output, $x-&gt;{buff} }
            elsif ($ot eq 'hash') 
              { $output-&gt;{$input} = $x-&gt;{buff} }

            my $buff = '';
            $x-&gt;{buff} = \$buff;
        }

        last if $status &lt; 0 || $z-&gt;smartEof();

        last 
            unless *$self-&gt;{MultiStream};

        $status = $z-&gt;nextStream();

        last 
            unless $status == 1 ;
    }

    return $z-&gt;closeError(undef)
        if $status &lt; 0 ;

    ${ *$self-&gt;{TrailingData} } = $z-&gt;trailingData()
        if defined *$self-&gt;{TrailingData} ;

    $z-&gt;close() 
        or return undef ;

    return 1 ;
}

sub TIEHANDLE
{
    return $_[0] if ref($_[0]);
    die &quot;OOPS\n&quot; ;

}
  
sub UNTIE
{
    my $self = shift ;
}


sub getHeaderInfo
{
    my $self = shift ;
    wantarray ? @{ *$self-&gt;{InfoList} } : *$self-&gt;{Info};
}

sub readBlock
{
    my $self = shift ;
    my $buff = shift ;
    my $size = shift ;

    if (defined *$self-&gt;{CompressedInputLength}) {
        if (*$self-&gt;{CompressedInputLengthRemaining} == 0) {
            delete *$self-&gt;{CompressedInputLength};
            *$self-&gt;{CompressedInputLengthDone} = 1;
            return STATUS_OK ;
        }
        $size = List::Util::min($size, *$self-&gt;{CompressedInputLengthRemaining} );
        *$self-&gt;{CompressedInputLengthRemaining} -= $size ;
    }
    
    my $status = $self-&gt;smartRead($buff, $size) ;
    return $self-&gt;saveErrorString(STATUS_ERROR, &quot;Error Reading Data: $!&quot;, $!)
        if $status == STATUS_ERROR  ;

    if ($status == 0 ) {
        *$self-&gt;{Closed} = 1 ;
        *$self-&gt;{EndStream} = 1 ;
        return $self-&gt;saveErrorString(STATUS_ERROR, &quot;unexpected end of file&quot;, STATUS_ERROR);
    }

    return STATUS_OK;
}

sub postBlockChk
{
    return STATUS_OK;
}

sub _raw_read
{
    # return codes
    # &gt;0 - ok, number of bytes read
    # =0 - ok, eof
    # &lt;0 - not ok
    
    my $self = shift ;

    return G_EOF if *$self-&gt;{Closed} ;
    return G_EOF if *$self-&gt;{EndStream} ;

    my $buffer = shift ;
    my $scan_mode = shift ;

    if (*$self-&gt;{Plain}) {
        my $tmp_buff ;
        my $len = $self-&gt;smartRead(\$tmp_buff, *$self-&gt;{BlockSize}) ;
        
        return $self-&gt;saveErrorString(G_ERR, &quot;Error reading data: $!&quot;, $!) 
                if $len == STATUS_ERROR ;

        if ($len == 0 ) {
            *$self-&gt;{EndStream} = 1 ;
        }
        else {
            *$self-&gt;{PlainBytesRead} += $len ;
            $$buffer .= $tmp_buff;
        }

        return $len ;
    }

    if (*$self-&gt;{NewStream}) {

        $self-&gt;gotoNextStream() &gt; 0
            or return G_ERR;

        # For the headers that actually uncompressed data, put the
        # uncompressed data into the output buffer.
        $$buffer .=  *$self-&gt;{Pending} ;
        my $len = length  *$self-&gt;{Pending} ;
        *$self-&gt;{Pending} = '';
        return $len; 
    }

    my $temp_buf = '';
    my $outSize = 0;
    my $status = $self-&gt;readBlock(\$temp_buf, *$self-&gt;{BlockSize}, $outSize) ;
    
    return G_ERR
        if $status == STATUS_ERROR  ;

    my $buf_len = 0;
    if ($status == STATUS_OK) {
        my $beforeC_len = length $temp_buf;
        my $before_len = defined $$buffer ? length $$buffer : 0 ;
        $status = *$self-&gt;{Uncomp}-&gt;uncompr(\$temp_buf, $buffer,
                                    defined *$self-&gt;{CompressedInputLengthDone} ||
                                                $self-&gt;smartEof(), $outSize);
                                                
        # Remember the input buffer if it wasn't consumed completely
        $self-&gt;pushBack($temp_buf) if *$self-&gt;{Uncomp}{ConsumesInput};

        return $self-&gt;saveErrorString(G_ERR, *$self-&gt;{Uncomp}{Error}, *$self-&gt;{Uncomp}{ErrorNo})
            if $self-&gt;saveStatus($status) == STATUS_ERROR;    

        $self-&gt;postBlockChk($buffer, $before_len) == STATUS_OK
            or return G_ERR;

        $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0;
    
        *$self-&gt;{CompSize}-&gt;add($beforeC_len - length $temp_buf) ;

        *$self-&gt;{InflatedBytesRead} += $buf_len ;
        *$self-&gt;{TotalInflatedBytesRead} += $buf_len ;
        *$self-&gt;{UnCompSize}-&gt;add($buf_len) ;

        $self-&gt;filterUncompressed($buffer, $before_len);

#        if (*$self-&gt;{Encoding}) {
#            use Encode ;
#            *$self-&gt;{PendingDecode} .= substr($$buffer, $before_len) ;
#            my $got = *$self-&gt;{Encoding}-&gt;decode(*$self-&gt;{PendingDecode}, Encode::FB_QUIET) ;
#            substr($$buffer, $before_len) = $got;
#        }
    }

    if ($status == STATUS_ENDSTREAM) {

        *$self-&gt;{EndStream} = 1 ;

        my $trailer;
        my $trailer_size = *$self-&gt;{Info}{TrailerLength} ;
        my $got = 0;
        if (*$self-&gt;{Info}{TrailerLength})
        {
            $got = $self-&gt;smartRead(\$trailer, $trailer_size) ;
        }

        if ($got == $trailer_size) {
            $self-&gt;chkTrailer($trailer) == STATUS_OK
                or return G_ERR;
        }
        else {
            return $self-&gt;TrailerError(&quot;trailer truncated. Expected &quot; . 
                                      &quot;$trailer_size bytes, got $got&quot;)
                if *$self-&gt;{Strict};
            $self-&gt;pushBack($trailer)  ;
        }

        # TODO - if want file pointer, do it here

        if (! $self-&gt;smartEof()) {
            *$self-&gt;{NewStream} = 1 ;

            if (*$self-&gt;{MultiStream}) {
                *$self-&gt;{EndStream} = 0 ;
                return $buf_len ;
            }
        }

    }
    

    # return the number of uncompressed bytes read
    return $buf_len ;
}

sub reset
{
    my $self = shift ;

    return *$self-&gt;{Uncomp}-&gt;reset();
}

sub filterUncompressed
{
}

#sub isEndStream
#{
#    my $self = shift ;
#    return *$self-&gt;{NewStream} ||
#           *$self-&gt;{EndStream} ;
#}

sub nextStream
{
    my $self = shift ;

    my $status = $self-&gt;gotoNextStream();
    $status == 1
        or return $status ;

    *$self-&gt;{TotalInflatedBytesRead} = 0 ;
    *$self-&gt;{LineNo} = $. = 0;

    return 1;
}

sub gotoNextStream
{
    my $self = shift ;

    if (! *$self-&gt;{NewStream}) {
        my $status = 1;
        my $buffer ;

        # TODO - make this more efficient if know the offset for the end of
        # the stream and seekable
        $status = $self-&gt;read($buffer) 
            while $status &gt; 0 ;

        return $status
            if $status &lt; 0;
    }

    *$self-&gt;{NewStream} = 0 ;
    *$self-&gt;{EndStream} = 0 ;
    *$self-&gt;{CompressedInputLengthDone} = undef ;
    *$self-&gt;{CompressedInputLength} = undef ;
    $self-&gt;reset();
    *$self-&gt;{UnCompSize}-&gt;reset();
    *$self-&gt;{CompSize}-&gt;reset();

    my $magic = $self-&gt;ckMagic();

    if ( ! defined $magic) {
        if (! *$self-&gt;{Transparent} || $self-&gt;eof())
        {
            *$self-&gt;{EndStream} = 1 ;
            return 0;
        }

        $self-&gt;clearError();
        *$self-&gt;{Type} = 'plain';
        *$self-&gt;{Plain} = 1;
        $self-&gt;pushBack(*$self-&gt;{HeaderPending})  ;
    }
    else
    {
        *$self-&gt;{Info} = $self-&gt;readHeader($magic);

        if ( ! defined *$self-&gt;{Info} ) {
            *$self-&gt;{EndStream} = 1 ;
            return -1;
        }
    }

    push @{ *$self-&gt;{InfoList} }, *$self-&gt;{Info} ;

    return 1; 
}

sub streamCount
{
    my $self = shift ;
    return 1 if ! defined *$self-&gt;{InfoList};
    return scalar @{ *$self-&gt;{InfoList} }  ;
}

#sub read
#{
#    my $status = myRead(@_);
#    return undef if $status &lt; 0;
#    return $status;
#}

sub read
{
    # return codes
    # &gt;0 - ok, number of bytes read
    # =0 - ok, eof
    # &lt;0 - not ok
    
    my $self = shift ;

    if (defined *$self-&gt;{ReadStatus} ) {
        my $status = *$self-&gt;{ReadStatus}[0];
        $self-&gt;saveErrorString( @{ *$self-&gt;{ReadStatus} } );
        delete  *$self-&gt;{ReadStatus} ;
        return $status ;
    }

    return G_EOF if *$self-&gt;{Closed} ;

    my $buffer ;

    if (ref $_[0] ) {
        $self-&gt;croakError(*$self-&gt;{ClassName} . &quot;::read: buffer parameter is read-only&quot;)
            if Scalar::Util::readonly(${ $_[0] });

        $self-&gt;croakError(*$self-&gt;{ClassName} . &quot;::read: not a scalar reference $_[0]&quot; )
            unless ref $_[0] eq 'SCALAR' ;
        $buffer = $_[0] ;
    }
    else {
        $self-&gt;croakError(*$self-&gt;{ClassName} . &quot;::read: buffer parameter is read-only&quot;)
            if Scalar::Util::readonly($_[0]);

        $buffer = \$_[0] ;
    }

    my $length = $_[1] ;
    my $offset = $_[2] || 0;

    if (! *$self-&gt;{AppendOutput}) {
        if (! $offset) {    

            $$buffer = '' ;
        }
        else {
            if ($offset &gt; length($$buffer)) {
                $$buffer .= &quot;\x00&quot; x ($offset - length($$buffer));
            }
            else {
                substr($$buffer, $offset) = '';
            }
        }
    }
    elsif (! defined $$buffer) {
        $$buffer = '' ;
    }

    return G_EOF if !length *$self-&gt;{Pending} &amp;&amp; *$self-&gt;{EndStream} ;

    # the core read will return 0 if asked for 0 bytes
    return 0 if defined $length &amp;&amp; $length == 0 ;

    $length = $length || 0;

    $self-&gt;croakError(*$self-&gt;{ClassName} . &quot;::read: length parameter is negative&quot;)
        if $length &lt; 0 ;

    # Short-circuit if this is a simple read, with no length
    # or offset specified.
    unless ( $length || $offset) {
        if (length *$self-&gt;{Pending}) {
            $$buffer .= *$self-&gt;{Pending} ;
            my $len = length *$self-&gt;{Pending};
            *$self-&gt;{Pending} = '' ;
            return $len ;
        }
        else {
            my $len = 0;
            $len = $self-&gt;_raw_read($buffer) 
                while ! *$self-&gt;{EndStream} &amp;&amp; $len == 0 ;
            return $len ;
        }
    }

    # Need to jump through more hoops - either length or offset 
    # or both are specified.
    my $out_buffer = *$self-&gt;{Pending} ;
    *$self-&gt;{Pending} = '';


    while (! *$self-&gt;{EndStream} &amp;&amp; length($out_buffer) &lt; $length)
    {
        my $buf_len = $self-&gt;_raw_read(\$out_buffer);
        return $buf_len 
            if $buf_len &lt; 0 ;
    }

    $length = length $out_buffer 
        if length($out_buffer) &lt; $length ;

    return 0 
        if $length == 0 ;

    $$buffer = '' 
        if ! defined $$buffer;

    $offset = length $$buffer
        if *$self-&gt;{AppendOutput} ;

    *$self-&gt;{Pending} = $out_buffer;
    $out_buffer = \*$self-&gt;{Pending} ;

    substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
    substr($$out_buffer, 0, $length) =  '' ;

    return $length ;
}

sub _getline
{
    my $self = shift ;
    my $status = 0 ;

    # Slurp Mode
    if ( ! defined $/ ) {
        my $data ;
        1 while ($status = $self-&gt;read($data)) &gt; 0 ;
        return ($status, \$data);
    }

    # Record Mode
    if ( ref $/ eq 'SCALAR' &amp;&amp; ${$/} =~ /^\d+$/ &amp;&amp; ${$/} &gt; 0) {
        my $reclen = ${$/} ;
        my $data ;
        $status = $self-&gt;read($data, $reclen) ;
        return ($status, \$data);
    }

    # Paragraph Mode
    if ( ! length $/ ) {
        my $paragraph ;    
        while (($status = $self-&gt;read($paragraph)) &gt; 0 ) {
            if ($paragraph =~ s/^(.*?\n\n+)//s) {
                *$self-&gt;{Pending}  = $paragraph ;
                my $par = $1 ;
                return (1, \$par);
            }
        }
        return ($status, \$paragraph);
    }

    # $/ isn't empty, or a reference, so it's Line Mode.
    {
        my $line ;    
        my $p = \*$self-&gt;{Pending}  ;
        while (($status = $self-&gt;read($line)) &gt; 0 ) {
            my $offset = index($line, $/);
            if ($offset &gt;= 0) {
                my $l = substr($line, 0, $offset + length $/ );
                substr($line, 0, $offset + length $/) = '';    
                $$p = $line;
                return (1, \$l);
            }
        }

        return ($status, \$line);
    }
}

sub getline
{
    my $self = shift;

    if (defined *$self-&gt;{ReadStatus} ) {
        $self-&gt;saveErrorString( @{ *$self-&gt;{ReadStatus} } );
        delete  *$self-&gt;{ReadStatus} ;
        return undef;
    }

    return undef 
        if *$self-&gt;{Closed} || (!length *$self-&gt;{Pending} &amp;&amp; *$self-&gt;{EndStream}) ;

    my $current_append = *$self-&gt;{AppendOutput} ;
    *$self-&gt;{AppendOutput} = 1;

    my ($status, $lineref) = $self-&gt;_getline();
    *$self-&gt;{AppendOutput} = $current_append;

    return undef 
        if $status &lt; 0 || length $$lineref == 0 ;

    $. = ++ *$self-&gt;{LineNo} ;

    return $$lineref ;
}

sub getlines
{
    my $self = shift;
    $self-&gt;croakError(*$self-&gt;{ClassName} . 
            &quot;::getlines: called in scalar context\n&quot;) unless wantarray;
    my($line, @lines);
    push(@lines, $line) 
        while defined($line = $self-&gt;getline);
    return @lines;
}

sub READLINE
{
    goto &amp;getlines if wantarray;
    goto &amp;getline;
}

sub getc
{
    my $self = shift;
    my $buf;
    return $buf if $self-&gt;read($buf, 1);
    return undef;
}

sub ungetc
{
    my $self = shift;
    *$self-&gt;{Pending} = &quot;&quot;  unless defined *$self-&gt;{Pending} ;    
    *$self-&gt;{Pending} = $_[0] . *$self-&gt;{Pending} ;    
}


sub trailingData
{
    my $self = shift ;

    if (defined *$self-&gt;{FH} || defined *$self-&gt;{InputEvent} ) {
        return *$self-&gt;{Prime} ;
    }
    else {
        my $buf = *$self-&gt;{Buffer} ;
        my $offset = *$self-&gt;{BufferOffset} ;
        return substr($$buf, $offset) ;
    }
}


sub eof
{
    my $self = shift ;

    return (*$self-&gt;{Closed} ||
              (!length *$self-&gt;{Pending} 
                &amp;&amp; ( $self-&gt;smartEof() || *$self-&gt;{EndStream}))) ;
}

sub tell
{
    my $self = shift ;

    my $in ;
    if (*$self-&gt;{Plain}) {
        $in = *$self-&gt;{PlainBytesRead} ;
    }
    else {
        $in = *$self-&gt;{TotalInflatedBytesRead} ;
    }

    my $pending = length *$self-&gt;{Pending} ;

    return 0 if $pending &gt; $in ;
    return $in - $pending ;
}

sub close
{
    # todo - what to do if close is called before the end of the gzip file
    #        do we remember any trailing data?
    my $self = shift ;

    return 1 if *$self-&gt;{Closed} ;

    untie *$self 
        if $] &gt;= 5.008 ;

    my $status = 1 ;

    if (defined *$self-&gt;{FH}) {
        if ((! *$self-&gt;{Handle} || *$self-&gt;{AutoClose}) &amp;&amp; ! *$self-&gt;{StdIO}) {
            local $.; 
            $! = 0 ;
            $status = *$self-&gt;{FH}-&gt;close();
            return $self-&gt;saveErrorString(0, $!, $!)
                if !*$self-&gt;{InNew} &amp;&amp; $self-&gt;saveStatus($!) != 0 ;
        }
        delete *$self-&gt;{FH} ;
        $! = 0 ;
    }
    *$self-&gt;{Closed} = 1 ;

    return 1;
}

sub DESTROY
{
    my $self = shift ;
    local ($., $@, $!, $^E, $?);

    $self-&gt;close() ;
}

sub seek
{
    my $self     = shift ;
    my $position = shift;
    my $whence   = shift ;

    my $here = $self-&gt;tell() ;
    my $target = 0 ;


    if ($whence == SEEK_SET) {
        $target = $position ;
    }
    elsif ($whence == SEEK_CUR) {
        $target = $here + $position ;
    }
    elsif ($whence == SEEK_END) {
        $target = $position ;
        $self-&gt;croakError(*$self-&gt;{ClassName} . &quot;::seek: SEEK_END not allowed&quot;) ;
    }
    else {
        $self-&gt;croakError(*$self-&gt;{ClassName} .&quot;::seek: unknown value, $whence, for whence parameter&quot;);
    }

    # short circuit if seeking to current offset
    if ($target == $here) {
        # On ordinary filehandles, seeking to the current
        # position also clears the EOF condition, so we
        # emulate this behavior locally while simultaneously
        # cascading it to the underlying filehandle
        if (*$self-&gt;{Plain}) {
            *$self-&gt;{EndStream} = 0;
            seek(*$self-&gt;{FH},0,1) if *$self-&gt;{FH};
        }
        return 1;
    }

    # Outlaw any attempt to seek backwards
    $self-&gt;croakError( *$self-&gt;{ClassName} .&quot;::seek: cannot seek backwards&quot;)
        if $target &lt; $here ;

    # Walk the file to the new offset
    my $offset = $target - $here ;

    my $got;
    while (($got = $self-&gt;read(my $buffer, List::Util::min($offset, *$self-&gt;{BlockSize})) ) &gt; 0)
    {
        $offset -= $got;
        last if $offset == 0 ;
    }

    $here = $self-&gt;tell() ;
    return $offset == 0 ? 1 : 0 ;
}

sub fileno
{
    my $self = shift ;
    return defined *$self-&gt;{FH} 
           ? fileno *$self-&gt;{FH} 
           : undef ;
}

sub binmode
{
    1;
#    my $self     = shift ;
#    return defined *$self-&gt;{FH} 
#            ? binmode *$self-&gt;{FH} 
#            : 1 ;
}

sub opened
{
    my $self     = shift ;
    return ! *$self-&gt;{Closed} ;
}

sub autoflush
{
    my $self     = shift ;
    return defined *$self-&gt;{FH} 
            ? *$self-&gt;{FH}-&gt;autoflush(@_) 
            : undef ;
}

sub input_line_number
{
    my $self = shift ;
    my $last = *$self-&gt;{LineNo};
    $. = *$self-&gt;{LineNo} = $_[1] if @_ ;
    return $last;
}


*BINMODE  = \&amp;binmode;
*SEEK     = \&amp;seek; 
*READ     = \&amp;read;
*sysread  = \&amp;read;
*TELL     = \&amp;tell;
*EOF      = \&amp;eof;

*FILENO   = \&amp;fileno;
*CLOSE    = \&amp;close;

sub _notAvailable
{
    my $name = shift ;
    return sub { croak &quot;$name Not Available: File opened only for intput&quot; ; } ;
}


*print    = _notAvailable('print');
*PRINT    = _notAvailable('print');
*printf   = _notAvailable('printf');
*PRINTF   = _notAvailable('printf');
*write    = _notAvailable('write');
*WRITE    = _notAvailable('write');

#*sysread  = \&amp;read;
#*syswrite = \&amp;_notAvailable;


package IO::Uncompress::Base ;


1 ;
__END__

=head1 NAME

IO::Uncompress::Base - Base Class for IO::Uncompress modules

=head1 SYNOPSIS

    use IO::Uncompress::Base ;

=head1 DESCRIPTION

This module is not intended for direct use in application code. Its sole
purpose is to be sub-classed by IO::Uncompress modules.

=head1 SEE ALSO

L&lt;Compress::Zlib&gt;, L&lt;IO::Compress::Gzip&gt;, L&lt;IO::Uncompress::Gunzip&gt;, L&lt;IO::Compress::Deflate&gt;, L&lt;IO::Uncompress::Inflate&gt;, L&lt;IO::Compress::RawDeflate&gt;, L&lt;IO::Uncompress::RawInflate&gt;, L&lt;IO::Compress::Bzip2&gt;, L&lt;IO::Uncompress::Bunzip2&gt;, L&lt;IO::Compress::Lzma&gt;, L&lt;IO::Uncompress::UnLzma&gt;, L&lt;IO::Compress::Xz&gt;, L&lt;IO::Uncompress::UnXz&gt;, L&lt;IO::Compress::Lzop&gt;, L&lt;IO::Uncompress::UnLzop&gt;, L&lt;IO::Compress::Lzf&gt;, L&lt;IO::Uncompress::UnLzf&gt;, L&lt;IO::Uncompress::AnyInflate&gt;, L&lt;IO::Uncompress::AnyUncompress&gt;

L&lt;IO::Compress::FAQ|IO::Compress::FAQ&gt;

L&lt;File::GlobMapper|File::GlobMapper&gt;, L&lt;Archive::Zip|Archive::Zip&gt;,
L&lt;Archive::Tar|Archive::Tar&gt;,
L&lt;IO::Zlib|IO::Zlib&gt;

=head1 AUTHOR

This module was written by Paul Marquess, C&lt;pmqs@cpan.org&gt;.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2018 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Fshare%2Fperl5%2FIO%2FUncompress'>Back to Directory</a>