cpan/IO-Compress/t/112utf8-zip.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  15 use Data::Dumper;
  16
  17 use IO::Compress::Zip     qw($ZipError);
  18 use IO::Uncompress::Unzip qw($UnzipError);
  19
  20 BEGIN {
  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 woking 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 ;  import Test::NoWarnings; 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 = new LexFile 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 = new IO::Compress::Zip $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 = new IO::Uncompress::Unzip $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 = new IO::Uncompress::Unzip $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 = new LexFile 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 = new IO::Compress::Zip $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 = new IO::Uncompress::Unzip $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 = new LexFile my $file1;
 165
 166     # Invalid UTF8
 167     my $name = "a\xFF\x{100}";
 168
 169     my $zip = new IO::Compress::Zip $file1,
 170                     Name =>  $name, Efs => 0  ;
 171
 172     ok $zip->print("abcd"), "print";
 173     ok $zip->close(), "closed";
 174
 175     my $u = new IO::Uncompress::Unzip $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 = new IO::Uncompress::Unzip $filename, efs => 0
 188         or die "Cannot open $filename: $UnzipError";
 189
 190     ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename";
 191 }
 192
 193 {
 194     title "unzip: EFS => 1 filename not valid utf8 - language encoding flag set";
 195
 196     my $filename = "t/files/bad-efs.zip" ;
 197     my $name = "\xF0\xA4\xAD";
 198
 199     eval { my $u = new IO::Uncompress::Unzip $filename, efs => 1
 200         or die "Cannot open $filename: $UnzipError" };
 201
 202     like $@, qr/Zip Filename not UTF-8/,
 203             "  Zip Filename not UTF-8" ;
 204
 205 }
 206
 207 {
 208     title "EFS => 1 - filename not valid utf8 - catch bad content writing to zip";
 209
 210     my $lex = new LexFile my $file1;
 211
 212     # Invalid UTF8
 213     my $name = "a\xFF\x{100}";
 214
 215     eval { my $zip = new IO::Compress::Zip $file1,
 216                     Name =>  $name, Efs => 1 } ;
 217
 218     like $@,  qr/Wide character in zip filename/,
 219                  "  wide characters in zip filename";
 220 }