ext/Compress/IO/Zlib/examples/unzip

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