cpan/IO-Compress/t/107multi-zip-only.t

   1
   2 use strict;
   3 use warnings;
   4
   5 BEGIN {
   6     if ($ENV{PERL_CORE}) {
   7         chdir 't' if -d 't';
   8         @INC = ("../lib", "lib/compress");
   9     }
  10 }
  11
  12 use lib qw(t t/compress);
  13
  14
  15 use Test::More ;
  16 use CompTestUtils;
  17
  18 BEGIN {
  19     # use Test::NoWarnings, if available
  20     my $extra = 0 ;
  21     $extra = 1
  22         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  23
  24     plan tests => 21 + $extra ;
  25
  26     use_ok('IO::Compress::Zip', qw(zip $ZipError)) ;
  27
  28     use_ok('IO::Uncompress::Unzip', qw($UnzipError)) ;
  29     use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;
  30
  31 }
  32
  33     my @buffers ;
  34     push @buffers, <<EOM ;
  35 hello world
  36 this is a test
  37 some more stuff on this line
  38 ad finally...
  39 EOM
  40
  41     push @buffers, <<EOM ;
  42 some more stuff
  43 line 2
  44 EOM
  45
  46     push @buffers, <<EOM ;
  47 even more stuff
  48 EOM
  49
  50
  51 my $name = "n1";
  52 my $lex = new LexFile my $zipfile ;
  53
  54 my $x = new IO::Compress::Zip($zipfile, Name => $name++, AutoClose => 1);
  55 isa_ok $x, 'IO::Compress::Zip', '  $x' ;
  56
  57
  58 foreach my $buffer (@buffers) {
  59     ok $x->write($buffer), "    Write OK" ;
  60     # this will add an extra "empty" stream
  61     ok $x->newStream(Name => $name ++), "    newStream OK" ;
  62 }
  63 ok $x->close, "  Close ok" ;
  64
  65 push @buffers, undef;
  66
  67 {
  68     open F, ">>$zipfile";
  69     print F "trailing";
  70     close F;
  71 }
  72
  73 my $u = new IO::Uncompress::Unzip $zipfile, Transparent => 1, MultiStream => 0
  74     or die "Cannot open $zipfile: $UnzipError";
  75
  76 my @names ;
  77 my $status;
  78 my $expname = "n1";
  79 my $ix = 0;
  80
  81 for my $ix (1 .. 4)
  82 {
  83     local $/ ;
  84
  85     my $n = $u->getHeaderInfo()->{Name};
  86     is $n, $expname , "name is $expname";
  87     is <$u>, $buffers[$ix-1], "payload ok";
  88     ++ $expname;
  89
  90     $status = $u->nextStream()
  91 }
  92
  93 {
  94     local $/ ;
  95
  96     my $n = $u->getHeaderInfo()->{Name};
  97     is $n, undef , "name is undef";
  98     is <$u>, "trailing", "payload ok";
  99 }
 100
 101 die "Error processing $zipfile: $!\n"
 102     if $status < 0 ;