Upgrade to Unicode::Normalize 1.01
[p5sagit/p5-mst-13.2.git] / 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