ext/IO_Compress_Zlib/examples/unzip

   1
   2 use strict;
   3 use warnings;
   4
   5 use File::Path;
   6 use File::Basename;
   7 use IO::File;
   8 use IO::Uncompress::RawInflate qw(:all);
   9
  10
  11 die "Usage: zipcat file\n"
  12     if @ARGV != 1 ;
  13
  14 my $file = $ARGV[0] ;
  15
  16 my $fh = new IO::File "<$file"
  17             or die "Cannot open '$file': $!\n";
  18
  19 while ()
  20 {
  21     my $FIXED_HEADER_LENGTH  = 30 ;
  22     my $sig;
  23     my $buffer;
  24
  25     my $x ;
  26     ($x = $fh->read($buffer, $FIXED_HEADER_LENGTH)) == $FIXED_HEADER_LENGTH
  27         or die "Truncated file top: $x $!\n";
  28
  29     my $signature = unpack ("V", substr($buffer, 0, 4));
  30
  31     last unless $signature == 0x04034b50;
  32
  33     my $compressedMethod   = unpack ("v", substr($buffer, 8, 2));
  34     my $compressedLength   = unpack ("V", substr($buffer, 18, 4));
  35    #my $uncompressedLength = unpack ("V", substr($buffer, 22, 4));
  36     my $filename_length    = unpack ("v", substr($buffer, 26, 2));
  37     my $extra_length       = unpack ("v", substr($buffer, 28, 2));
  38
  39     warn "Compressed Length $compressedLength\n";
  40     my $filename ;
  41     $fh->read($filename, $filename_length) == $filename_length
  42         or die "Truncated file\n";
  43
  44     $fh->read($buffer, $extra_length) == $extra_length
  45         or die "Truncated file\n";
  46
  47     if ($compressedMethod != 8 && $compressedMethod != 0)
  48     {
  49         warn "Skipping file '$filename' - not deflated $compressedMethod\n";
  50         $fh->read($buffer, $compressedLength) == $compressedLength
  51             or die "Truncated file\n";
  52         next;
  53     }
  54
  55     next if $compressedLength == 0;
  56
  57     warn "Writing file '$filename' $compressedMethod\n";
  58
  59     #mkpath dirname $filename;
  60
  61     #rawinflate $fh  => $filename,
  62     rawinflate $fh  => '-',
  63         Transparent => 1,
  64         InputLength => $compressedLength
  65       or die "Error uncompressing $file [$filename]: $RawInflateError\n"  ;
  66 }
  67
  68 sub decodeLocalFileHeader
  69 {
  70     my $buffer = shift ;
  71 }
  72
  73