cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm

   1 package IO::Uncompress::Adapter::Identity;
   2
   3 use warnings;
   4 use strict;
   5 use bytes;
   6
   7 use IO::Compress::Base::Common  2.057 qw(:Status);
   8 use IO::Compress::Zip::Constants ;
   9
  10 our ($VERSION);
  11
  12 $VERSION = '2.057';
  13
  14 use Compress::Raw::Zlib  2.057 ();
  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}   = 0;
 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__