1 2use strict; 3use warnings; 4 5BEGIN { 6 if ($ENV{PERL_CORE}) { 7 chdir 't' if -d 't'; 8 @INC = ("../lib", "lib/compress"); 9 } 10} 11 12use lib qw(t t/compress); 13 14 15use Test::More ; 16use CompTestUtils; 17 18BEGIN { 19 # use Test::NoWarnings, if available 20 my $extra = 0 ; 21 $extra = 1 22 if eval { require Test::NoWarnings ; Test::NoWarnings->import; 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 ; 35hello world 36this is a test 37some more stuff on this line 38ad finally... 39EOM 40 41 push @buffers, <<EOM ; 42some more stuff 43line 2 44EOM 45 46 push @buffers, <<EOM ; 47even more stuff 48EOM 49 50 51my $name = "n1"; 52my $lex = LexFile->new( my $zipfile ); 53 54my $x = IO::Compress::Zip->new($zipfile, Name => $name++, AutoClose => 1); 55isa_ok $x, 'IO::Compress::Zip', ' $x' ; 56 57 58foreach 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} 63ok $x->close, " Close ok" ; 64 65push @buffers, undef; 66 67{ 68 open F, ">>$zipfile"; 69 print F "trailing"; 70 close F; 71} 72 73my $u = IO::Uncompress::Unzip->new( $zipfile, Transparent => 1, MultiStream => 0 ) 74 or die "Cannot open $zipfile: $UnzipError"; 75 76my @names ; 77my $status; 78my $expname = "n1"; 79my $ix = 0; 80 81for 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 101die "Error processing $zipfile: $!\n" 102 if $status < 0 ;