"Fossies" - the Fresh Open Source Software Archive

Member "IO-Compress-2.093/lib/IO/Uncompress/Adapter/Identity.pm" (7 Dec 2019, 4586 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 "Identity.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 package IO::Uncompress::Adapter::Identity;
    2 
    3 use warnings;
    4 use strict;
    5 use bytes;
    6 
    7 use IO::Compress::Base::Common  2.093 qw(:Status);
    8 use IO::Compress::Zip::Constants ;
    9 
   10 our ($VERSION);
   11 
   12 $VERSION = '2.093';
   13 
   14 use Compress::Raw::Zlib  2.093 ();
   15 
   16 sub mkUncompObject
   17 {
   18     my $streaming = shift;
   19     my $zip64 = shift;
   20 
   21     my $crc32 = 1; #shift ;
   22     my $adler32 = shift;
   23 
   24     bless { 'CompSize'   => new U64 , # 0,
   25             'UnCompSize' => 0,
   26             'wantCRC32'  => $crc32,
   27             'CRC32'      => Compress::Raw::Zlib::crc32(''),
   28             'wantADLER32'=> $adler32,
   29             'ADLER32'    => Compress::Raw::Zlib::adler32(''),
   30             'ConsumesInput' => 1,
   31             'Streaming'  => $streaming,
   32             'Zip64'      => $zip64,
   33             'DataHdrSize'  => $zip64 ? 24 :  16,
   34             'Pending'   => '',
   35 
   36           } ;
   37 }
   38 
   39 
   40 sub uncompr
   41 {
   42     my $self = shift;
   43     my $in = $_[0];
   44     my $eof = $_[2];
   45 
   46     my $len = length $$in;
   47     my $remainder = '';
   48 
   49     if (defined $$in && $len) {
   50 
   51         if ($self->{Streaming}) {
   52 
   53             if (length $self->{Pending}) {
   54                 $$in = $self->{Pending} . $$in ;
   55                 $len = length $$in;
   56                 $self->{Pending} = '';
   57             }
   58 
   59             my $ind = index($$in, "\x50\x4b\x07\x08");
   60 
   61             if ($ind < 0) {
   62                 $len = length $$in;
   63                 if ($len >= 3 && substr($$in, -3) eq "\x50\x4b\x07") {
   64                     $ind = $len - 3 ;
   65                 }
   66                 elsif ($len >= 2 && substr($$in, -2) eq "\x50\x4b") {
   67                     $ind = $len - 2 ;
   68                 }
   69                 elsif ($len >= 1 && substr($$in, -1) eq "\x50") {
   70                     $ind = $len - 1 ;
   71                 }
   72             }
   73            
   74             if ($ind >= 0) {
   75                 $remainder = substr($$in, $ind) ;
   76                 substr($$in, $ind) = '' ;
   77             }
   78         }
   79 
   80         if (length $remainder && length $remainder < $self->{DataHdrSize}) {
   81             $self->{Pending} = $remainder ;
   82             $remainder = '';
   83         }
   84         elsif (length $remainder >= $self->{DataHdrSize}) {
   85             my $crc = unpack "V", substr($remainder, 4);
   86             if ($crc == Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})) {
   87                 my ($l1, $l2) ;
   88 
   89                 if ($self->{Zip64}) {
   90                     $l1 = U64::newUnpack_V64(substr($remainder, 8));
   91                     $l2 = U64::newUnpack_V64(substr($remainder, 16));
   92                 }
   93                 else {
   94                     $l1 = U64::newUnpack_V32(substr($remainder, 8));
   95                     $l2 = U64::newUnpack_V32(substr($remainder, 12));
   96                 }
   97                     
   98                 my $newLen = $self->{CompSize}->clone();
   99                 $newLen->add(length $$in);
  100                 if ($l1->equal($l2) && $l1->equal($newLen) ) {
  101                     $eof = 1;
  102                 }
  103                 else {
  104                     $$in .= substr($remainder, 0, 4) ;
  105                     $remainder       = substr($remainder, 4);
  106                     #$self->{Pending} = substr($remainder, 4);
  107                     #$remainder = '';
  108                     $eof = 0;
  109                 }
  110             }
  111             else {
  112                 $$in .= substr($remainder, 0, 4) ;
  113                 $remainder       = substr($remainder, 4);
  114                 #$self->{Pending} = substr($remainder, 4);
  115                 #$remainder = '';
  116                 $eof = 0;
  117             }
  118         }
  119 
  120         if (length $$in) {
  121             $self->{CompSize}->add(length $$in) ;
  122 
  123             $self->{CRC32} = Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})
  124                 if $self->{wantCRC32};
  125 
  126             $self->{ADLER32} = Compress::Zlib::adler32($$in,  $self->{ADLER32})
  127                 if $self->{wantADLER32};
  128         }
  129 
  130         ${ $_[1] } .= $$in;
  131         $$in  = $remainder;
  132     }
  133 
  134     return STATUS_ENDSTREAM if $eof;
  135     return STATUS_OK ;
  136 }
  137 
  138 sub reset
  139 {
  140     my $self = shift;
  141 
  142     $self->{CompSize}->reset();
  143     $self->{UnCompSize} = 0;
  144     $self->{CRC32}      = Compress::Raw::Zlib::crc32('');
  145     $self->{ADLER32}    = Compress::Raw::Zlib::adler32('');      
  146 
  147     return STATUS_OK ;
  148 }
  149 
  150 #sub count
  151 #{
  152 #    my $self = shift ;
  153 #    return $self->{UnCompSize} ;
  154 #}
  155 
  156 sub compressedBytes
  157 {
  158     my $self = shift ;
  159     return $self->{CompSize} ;
  160 }
  161 
  162 sub uncompressedBytes
  163 {
  164     my $self = shift ;
  165     return $self->{CompSize} ;
  166 }
  167 
  168 sub sync
  169 {
  170     return STATUS_OK ;
  171 }
  172 
  173 sub crc32
  174 {
  175     my $self = shift ;
  176     return $self->{CRC32};
  177 }
  178 
  179 sub adler32
  180 {
  181     my $self = shift ;
  182     return $self->{ADLER32};
  183 }
  184 
  185 
  186 1;
  187 
  188 __END__