1BEGIN {
2    if ($ENV{PERL_CORE}) {
3        chdir 't' if -d 't';
4        @INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use CompTestUtils;
15use Data::Dumper;
16
17use IO::Compress::Zip     qw($ZipError);
18use IO::Uncompress::Unzip qw($UnzipError);
19
20BEGIN {
21    plan skip_all => "Encode is not available"
22        if $] < 5.006 ;
23
24    eval { require Encode; Encode->import(); };
25
26    plan skip_all => "Encode is not available"
27        if $@ ;
28
29    plan skip_all => "Encode not working in perl $]"
30        if $] >= 5.008 && $] < 5.008004 ;
31
32    # use Test::NoWarnings, if available
33    my $extra = 0 ;
34    $extra = 1
35        if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
36
37    plan tests => 28 + $extra;
38}
39
40{
41    title "EFS set in zip: Create a simple zip - language encoding flag set";
42
43    my $lex = LexFile->new( my $file1 );
44
45    my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}',
46                  'beta \N{GREEK SMALL LETTER BETA}',
47                  'gamma \N{GREEK SMALL LETTER GAMMA}',
48                  'delta \N{GREEK SMALL LETTER DELTA}'
49                ) ;
50
51    my @encoded = map { Encode::encode_utf8($_) } @names;
52
53    my @n = @names;
54
55    my $zip = IO::Compress::Zip->new( $file1,
56                    Name =>  $names[0], Efs => 1 );
57
58    my $content = 'Hello, world!';
59    ok $zip->print($content), "print";
60    $zip->newStream(Name => $names[1], Efs => 1);
61    ok $zip->print($content), "print";
62    $zip->newStream(Name => $names[2], Efs => 1);
63    ok $zip->print($content), "print";
64    $zip->newStream(Name => $names[3], Efs => 1);
65    ok $zip->print($content), "print";
66    ok $zip->close(), "closed";
67
68    {
69        my $u = IO::Uncompress::Unzip->new( $file1, Efs => 1 )
70            or die "Cannot open $file1: $UnzipError";
71
72        my $status;
73        my @efs;
74        my @unzip_names;
75        for ($status = 1; $status > 0; $status = $u->nextStream(Efs => 1))
76        {
77            push @efs, $u->getHeaderInfo()->{efs};
78            push @unzip_names, $u->getHeaderInfo()->{Name};
79        }
80
81        die "Error processing $file1: $status $!\n"
82            if $status < 0;
83
84        is_deeply \@efs, [1, 1, 1, 1], "language encoding flag set"
85            or diag "Got " . Dumper(\@efs);
86        is_deeply \@unzip_names, [@names], "Names round tripped"
87            or diag "Got " . Dumper(\@unzip_names);
88    }
89
90    {
91        my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 )
92            or die "Cannot open $file1: $UnzipError";
93
94        my $status;
95        my @efs;
96        my @unzip_names;
97        for ($status = 1; $status > 0; $status = $u->nextStream(Efs => 0))
98        {
99            push @efs, $u->getHeaderInfo()->{efs};
100            push @unzip_names, $u->getHeaderInfo()->{Name};
101        }
102
103        die "Error processing $file1: $status $!\n"
104            if $status < 0;
105
106        is_deeply \@efs, [1, 1, 1, 1], "language encoding flag set"
107            or diag "Got " . Dumper(\@efs);
108        is_deeply \@unzip_names, [@names], "Names round tripped"
109            or diag "Got " . Dumper(\@unzip_names);
110    }
111}
112
113
114{
115    title "Create a simple zip - language encoding flag not set";
116
117    my $lex = LexFile->new( my $file1 );
118
119    my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}',
120                  'beta \N{GREEK SMALL LETTER BETA}',
121                  'gamma \N{GREEK SMALL LETTER GAMMA}',
122                  'delta \N{GREEK SMALL LETTER DELTA}'
123                ) ;
124
125    my @n = @names;
126
127    my $zip = IO::Compress::Zip->new( $file1,
128                    Name =>  $names[0], Efs => 0 );
129
130    my $content = 'Hello, world!';
131    ok $zip->print($content), "print";
132    $zip->newStream(Name => $names[1], Efs => 0);
133    ok $zip->print($content), "print";
134    $zip->newStream(Name => $names[2], Efs => 0);
135    ok $zip->print($content), "print";
136    $zip->newStream(Name => $names[3]);
137    ok $zip->print($content), "print";
138    ok $zip->close(), "closed";
139
140    my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 )
141        or die "Cannot open $file1: $UnzipError";
142
143    my $status;
144    my @efs;
145    my @unzip_names;
146    for ($status = 1; $status > 0; $status = $u->nextStream())
147    {
148        push @efs, $u->getHeaderInfo()->{efs};
149        push @unzip_names, $u->getHeaderInfo()->{Name};
150    }
151
152    die "Error processing $file1: $status $!\n"
153        if $status < 0;
154
155    is_deeply \@efs, [0, 0, 0, 0], "language encoding flag set"
156        or diag "Got " . Dumper(\@efs);
157    is_deeply \@unzip_names, [@names], "Names round tripped"
158        or diag "Got " . Dumper(\@unzip_names);
159}
160
161{
162    title "zip: EFS => 0 filename not valid utf8 - language encoding flag not set";
163
164    my $lex = LexFile->new( my $file1 );
165
166    # Invalid UTF8
167    my $name = "a\xFF\x{100}";
168
169    my $zip = IO::Compress::Zip->new( $file1,
170                    Name =>  $name, Efs => 0 );
171
172    ok $zip->print("abcd"), "print";
173    ok $zip->close(), "closed";
174
175    my $u = IO::Uncompress::Unzip->new( $file1 )
176        or die "Cannot open $file1: $UnzipError";
177
178    ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename";
179}
180
181{
182    title "unzip: EFS => 0 filename not valid utf8 - language encoding flag set";
183
184    my $filename = "t/files/bad-efs.zip" ;
185    my $name = "\xF0\xA4\xAD";
186
187    my $u = IO::Uncompress::Unzip->new( $filename, efs => 0 )
188        or die "Cannot open $filename: $UnzipError";
189
190    ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename";
191}
192
193SKIP: {
194    title "unzip: EFS => 1 filename not valid utf8 - language encoding flag set";
195
196    # The name hard-coded into this pre-built file is not illegal UTF-EBCDIC
197    skip "ASCII-centric test", 1, unless ord "A" == 65;
198
199    my $filename = "t/files/bad-efs.zip" ;
200
201    eval { my $u = IO::Uncompress::Unzip->new( $filename, efs => 1 )
202        or die "Cannot open $filename: $UnzipError" };
203
204    like $@, qr/Zip Filename not UTF-8/,
205            "  Zip Filename not UTF-8" ;
206
207}
208
209{
210    title "EFS => 1 - filename not valid utf8 - catch bad content writing to zip";
211
212    my $lex = LexFile->new( my $file1 );
213
214    # Invalid UTF8
215    my $name = "a\xFF\x{100}";
216
217    eval { my $zip = IO::Compress::Zip->new( $file1,
218                    Name =>  $name, Efs => 1 ) } ;
219
220    like $@,  qr/Wide character in zip filename/,
221                 "  wide characters in zip filename";
222}