cpan/IO-Compress/t/006zip.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
  16 BEGIN {
  17     # use Test::NoWarnings, if available
  18     my $extra = 0 ;
  19     $extra = 1
  20         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  21
  22     plan tests => 108 + $extra ;
  23
  24     use_ok('IO::Compress::Zip', qw(:all)) ;
  25     use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
  26
  27     eval {
  28            require IO::Compress::Bzip2 ;
  29            import  IO::Compress::Bzip2 2.010 ;
  30            require IO::Uncompress::Bunzip2 ;
  31            import  IO::Uncompress::Bunzip2 2.010 ;
  32          } ;
  33
  34 }
  35
  36
  37 sub getContent
  38 {
  39     my $filename = shift;
  40
  41     my $u = new IO::Uncompress::Unzip $filename, Append => 1, @_
  42         or die "Cannot open $filename: $UnzipError";
  43
  44     isa_ok $u, "IO::Uncompress::Unzip";
  45
  46     my @content;
  47     my $status ;
  48
  49     for ($status = 1; $status > 0 ; $status = $u->nextStream())
  50     {
  51         my $name = $u->getHeaderInfo()->{Name};
  52         #warn "Processing member $name\n" ;
  53
  54         my $buff = '';
  55         1 while ($status = $u->read($buff)) ;
  56
  57         push @content, $buff;
  58         last unless $status == 0;
  59     }
  60
  61     die "Error processing $filename: $status $!\n"
  62         if $status < 0 ;
  63
  64     return @content;
  65 }
  66
  67
  68
  69 {
  70     title "Create a simple zip - All Deflate";
  71
  72     my $lex = new LexFile my $file1;
  73
  74     my @content = (
  75                    'hello',
  76                    '',
  77                    'goodbye ',
  78                    );
  79
  80     my $zip = new IO::Compress::Zip $file1,
  81                     Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
  82     isa_ok $zip, "IO::Compress::Zip";
  83
  84     is $zip->write($content[0]), length($content[0]), "write";
  85     $zip->newStream(Name=> "two", Method => ZIP_CM_DEFLATE);
  86     is $zip->write($content[1]), length($content[1]), "write";
  87     $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
  88     is $zip->write($content[2]), length($content[2]), "write";
  89     ok $zip->close(), "closed";
  90
  91     my @got = getContent($file1);
  92
  93     is $got[0], $content[0], "Got 1st entry";
  94     is $got[1], $content[1], "Got 2nd entry";
  95     is $got[2], $content[2], "Got 3nd entry";
  96 }
  97
  98 SKIP:
  99 {
 100     title "Create a simple zip - All Bzip2";
 101
 102     skip "IO::Compress::Bzip2 not available", 9
 103         unless defined $IO::Compress::Bzip2::VERSION;
 104
 105     my $lex = new LexFile my $file1;
 106
 107     my @content = (
 108                    'hello',
 109                    '',
 110                    'goodbye ',
 111                    );
 112
 113     my $zip = new IO::Compress::Zip $file1,
 114                     Name => "one", Method => ZIP_CM_BZIP2, Stream => 0;
 115     isa_ok $zip, "IO::Compress::Zip";
 116
 117     is $zip->write($content[0]), length($content[0]), "write";
 118     $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
 119     is $zip->write($content[1]), length($content[1]), "write";
 120     $zip->newStream(Name=> "three", Method => ZIP_CM_BZIP2);
 121     is $zip->write($content[2]), length($content[2]), "write";
 122     ok $zip->close(), "closed";
 123
 124     my @got = getContent($file1);
 125
 126     is $got[0], $content[0], "Got 1st entry";
 127     is $got[1], $content[1], "Got 2nd entry";
 128     is $got[2], $content[2], "Got 3nd entry";
 129 }
 130
 131 SKIP:
 132 {
 133     title "Create a simple zip - Deflate + Bzip2";
 134
 135     skip "IO::Compress::Bzip2 not available", 9
 136         unless $IO::Compress::Bzip2::VERSION;
 137
 138     my $lex = new LexFile my $file1;
 139
 140     my @content = (
 141                    'hello',
 142                    'and',
 143                    'goodbye ',
 144                    );
 145
 146     my $zip = new IO::Compress::Zip $file1,
 147                     Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
 148     isa_ok $zip, "IO::Compress::Zip";
 149
 150     is $zip->write($content[0]), length($content[0]), "write";
 151     $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
 152     is $zip->write($content[1]), length($content[1]), "write";
 153     $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
 154     is $zip->write($content[2]), length($content[2]), "write";
 155     ok $zip->close(), "closed";
 156
 157     my @got = getContent($file1);
 158
 159     is $got[0], $content[0], "Got 1st entry";
 160     is $got[1], $content[1], "Got 2nd entry";
 161     is $got[2], $content[2], "Got 3nd entry";
 162 }
 163
 164 {
 165     title "Create a simple zip - All STORE";
 166
 167     my $lex = new LexFile my $file1;
 168
 169     my @content = (
 170                    'hello',
 171                    '',
 172                    'goodbye ',
 173                    );
 174
 175     my $zip = new IO::Compress::Zip $file1,
 176                     Name => "one", Method => ZIP_CM_STORE, Stream => 0;
 177     isa_ok $zip, "IO::Compress::Zip";
 178
 179     is $zip->write($content[0]), length($content[0]), "write";
 180     $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
 181     is $zip->write($content[1]), length($content[1]), "write";
 182     $zip->newStream(Name=> "three", Method => ZIP_CM_STORE);
 183     is $zip->write($content[2]), length($content[2]), "write";
 184     ok $zip->close(), "closed";
 185
 186     my @got = getContent($file1);
 187
 188     is $got[0], $content[0], "Got 1st entry";
 189     is $got[1], $content[1], "Got 2nd entry";
 190     is $got[2], $content[2], "Got 3nd entry";
 191 }
 192
 193 {
 194     title "Create a simple zip - Deflate + STORE";
 195
 196     my $lex = new LexFile my $file1;
 197
 198     my @content = qw(
 199                    hello
 200                        and
 201                    goodbye
 202                    );
 203
 204     my $zip = new IO::Compress::Zip $file1,
 205                     Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
 206     isa_ok $zip, "IO::Compress::Zip";
 207
 208     is $zip->write($content[0]), length($content[0]), "write";
 209     $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
 210     is $zip->write($content[1]), length($content[1]), "write";
 211     $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
 212     is $zip->write($content[2]), length($content[2]), "write";
 213     ok $zip->close(), "closed";
 214
 215     my @got = getContent($file1);
 216
 217     is $got[0], $content[0], "Got 1st entry";
 218     is $got[1], $content[1], "Got 2nd entry";
 219     is $got[2], $content[2], "Got 3nd entry";
 220 }
 221
 222 {
 223     title "Create a simple zip - Deflate + zero length STORE";
 224
 225     my $lex = new LexFile my $file1;
 226
 227     my @content = (
 228                    'hello ',
 229                    '',
 230                    'goodbye ',
 231                    );
 232
 233     my $zip = new IO::Compress::Zip $file1,
 234                     Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
 235     isa_ok $zip, "IO::Compress::Zip";
 236
 237     is $zip->write($content[0]), length($content[0]), "write";
 238     $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
 239     is $zip->write($content[1]), length($content[1]), "write";
 240     $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
 241     is $zip->write($content[2]), length($content[2]), "write";
 242     ok $zip->close(), "closed";
 243
 244     my @got = getContent($file1);
 245
 246     is $got[0], $content[0], "Got 1st entry";
 247     ok $got[1] eq $content[1], "Got 2nd entry";
 248     is $got[2], $content[2], "Got 3nd entry";
 249 }
 250
 251 {
 252     title "RT #72548";
 253
 254     my $lex = new LexFile my $file1;
 255
 256     my $blockSize = 1024 * 16;
 257
 258     my @content = (
 259                    'hello',
 260                    "x" x ($blockSize + 1)
 261                    );
 262
 263     my $zip = new IO::Compress::Zip $file1,
 264                     Name => "one", Method => ZIP_CM_STORE, Stream => 0;
 265     isa_ok $zip, "IO::Compress::Zip";
 266
 267     is $zip->write($content[0]), length($content[0]), "write";
 268
 269     $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
 270     is $zip->write($content[1]), length($content[1]), "write";
 271
 272     ok $zip->close(), "closed";
 273
 274     my @got = getContent($file1, BlockSize => $blockSize);
 275
 276     is $got[0], $content[0], "Got 1st entry";
 277     is $got[1], $content[1], "Got 2nd entry";
 278 }
 279
 280 {
 281     title "Zip file with a single zero-length file";
 282
 283     my $lex = new LexFile my $file1;
 284
 285
 286     my $zip = new IO::Compress::Zip $file1,
 287                     Name => "one", Method => ZIP_CM_STORE, Stream => 0;
 288     isa_ok $zip, "IO::Compress::Zip";
 289
 290     $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
 291     ok $zip->close(), "closed";
 292
 293     my @got = getContent($file1);
 294
 295     is $got[0], "", "no content";
 296     is $got[1], "", "no content";
 297 }
 298
 299 SKIP:
 300 for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2)
 301 {
 302     title "Read a line from zip, Method $method";
 303
 304     skip "IO::Compress::Bzip2 not available", 14
 305         unless defined $IO::Compress::Bzip2::VERSION;
 306
 307     my $content = "a single line\n";
 308     my $zip ;
 309
 310     my $status = zip \$content => \$zip,
 311                     Method => $method,
 312                     Stream => 0,
 313                     Name => "123";
 314     is $status, 1, "  Created a zip file";
 315
 316     my $u = new IO::Uncompress::Unzip \$zip;
 317     isa_ok $u, "IO::Uncompress::Unzip";
 318
 319     is $u->getline, $content, "  Read first line ok";
 320     ok ! $u->getline, "  Second line doesn't exist";
 321
 322
 323 }
 324
 325 {
 326     title "isMethodAvailable" ;
 327
 328     ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available";
 329     ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_DEFLATE), "ZIP_CM_DEFLATE available";
 330     #ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available";
 331
 332     ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available";
 333 }
 334
 335 {
 336     title "Member & Comment 0";
 337
 338     my $lex = new LexFile my $file1;
 339
 340     my $content = 'hello' ;
 341
 342
 343     my $zip = new IO::Compress::Zip $file1,
 344                     Name => "0", Comment => "0" ;
 345     isa_ok $zip, "IO::Compress::Zip";
 346
 347     is $zip->write($content), length($content), "write";
 348
 349     ok $zip->close(), "closed";
 350
 351
 352
 353     my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_
 354         or die "Cannot open $file1: $UnzipError";
 355
 356     isa_ok $u, "IO::Uncompress::Unzip";
 357
 358     my $name = $u->getHeaderInfo()->{Name};
 359
 360     is $u->getHeaderInfo()->{Name}, "0", "Name is '0'";
 361 }
 362
 363
 364 {
 365     title "nexStream regression";
 366     # https://github.com/pmqs/IO-Compress/issues/3
 367
 368     my $lex = new LexFile my $file1;
 369
 370     my $content1 = qq["organisation_path","collection_occasion_key","episode_key"\n] ;
 371
 372     my $zip = new IO::Compress::Zip $file1,
 373                     Name => "one";
 374     isa_ok $zip, "IO::Compress::Zip";
 375
 376     print $zip $content1;
 377
 378     $zip->newStream(Name=> "two");
 379
 380     my $content2 = <<EOM;
 381 "key","value"
 382 "version","2"
 383 "type","PMHC"
 384 EOM
 385     print $zip $content2;
 386
 387     ok $zip->close(), "closed";
 388
 389
 390     my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_
 391         or die "Cannot open $file1: $UnzipError";
 392
 393     isa_ok $u, "IO::Uncompress::Unzip";
 394
 395     my $name = $u->getHeaderInfo()->{Name};
 396
 397     is $u->getHeaderInfo()->{Name}, "one", "Name is 'one'";
 398
 399     ok $u->nextStream(), "nextStream OK";
 400
 401     my $line = <$u>;
 402
 403     is $line, qq["key","value"\n], "got line 1 from second member";
 404 }