| Server IP : 164.138.27.172 / Your IP : 216.73.216.143 Web Server : nginx/1.27.4 System : Linux cookingdream 6.8.0-124-generic #124-Ubuntu SMP PREEMPT_DYNAMIC Tue May 26 13:00:45 UTC 2026 x86_64 User : www-adm ( 1001) PHP Version : 8.3.32 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : OFF Directory : /home/jonasn/.cpan/build/IO-Compress-2.201-0/t/ |
Upload File : |
BEGIN {
if ($ENV{PERL_CORE}) {
chdir 't' if -d 't';
@INC = ("../lib", "lib/compress");
}
}
use lib qw(t t/compress);
use strict;
use warnings;
use bytes;
use Test::More ;
use CompTestUtils;
use Data::Dumper;
use IO::Compress::Zip qw($ZipError);
use IO::Uncompress::Unzip qw($UnzipError);
BEGIN {
plan skip_all => "Encode is not available"
if $] < 5.006 ;
eval { require Encode; Encode->import(); };
plan skip_all => "Encode is not available"
if $@ ;
plan skip_all => "Encode not working in perl $]"
if $] >= 5.008 && $] < 5.008004 ;
# use Test::NoWarnings, if available
my $extra = 0 ;
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
plan tests => 28 + $extra;
}
{
title "EFS set in zip: Create a simple zip - language encoding flag set";
my $lex = LexFile->new( my $file1 );
my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}',
'beta \N{GREEK SMALL LETTER BETA}',
'gamma \N{GREEK SMALL LETTER GAMMA}',
'delta \N{GREEK SMALL LETTER DELTA}'
) ;
my @encoded = map { Encode::encode_utf8($_) } @names;
my @n = @names;
my $zip = IO::Compress::Zip->new( $file1,
Name => $names[0], Efs => 1 );
my $content = 'Hello, world!';
ok $zip->print($content), "print";
$zip->newStream(Name => $names[1], Efs => 1);
ok $zip->print($content), "print";
$zip->newStream(Name => $names[2], Efs => 1);
ok $zip->print($content), "print";
$zip->newStream(Name => $names[3], Efs => 1);
ok $zip->print($content), "print";
ok $zip->close(), "closed";
{
my $u = IO::Uncompress::Unzip->new( $file1, Efs => 1 )
or die "Cannot open $file1: $UnzipError";
my $status;
my @efs;
my @unzip_names;
for ($status = 1; $status > 0; $status = $u->nextStream(Efs => 1))
{
push @efs, $u->getHeaderInfo()->{efs};
push @unzip_names, $u->getHeaderInfo()->{Name};
}
die "Error processing $file1: $status $!\n"
if $status < 0;
is_deeply \@efs, [1, 1, 1, 1], "language encoding flag set"
or diag "Got " . Dumper(\@efs);
is_deeply \@unzip_names, [@names], "Names round tripped"
or diag "Got " . Dumper(\@unzip_names);
}
{
my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 )
or die "Cannot open $file1: $UnzipError";
my $status;
my @efs;
my @unzip_names;
for ($status = 1; $status > 0; $status = $u->nextStream(Efs => 0))
{
push @efs, $u->getHeaderInfo()->{efs};
push @unzip_names, $u->getHeaderInfo()->{Name};
}
die "Error processing $file1: $status $!\n"
if $status < 0;
is_deeply \@efs, [1, 1, 1, 1], "language encoding flag set"
or diag "Got " . Dumper(\@efs);
is_deeply \@unzip_names, [@names], "Names round tripped"
or diag "Got " . Dumper(\@unzip_names);
}
}
{
title "Create a simple zip - language encoding flag not set";
my $lex = LexFile->new( my $file1 );
my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}',
'beta \N{GREEK SMALL LETTER BETA}',
'gamma \N{GREEK SMALL LETTER GAMMA}',
'delta \N{GREEK SMALL LETTER DELTA}'
) ;
my @n = @names;
my $zip = IO::Compress::Zip->new( $file1,
Name => $names[0], Efs => 0 );
my $content = 'Hello, world!';
ok $zip->print($content), "print";
$zip->newStream(Name => $names[1], Efs => 0);
ok $zip->print($content), "print";
$zip->newStream(Name => $names[2], Efs => 0);
ok $zip->print($content), "print";
$zip->newStream(Name => $names[3]);
ok $zip->print($content), "print";
ok $zip->close(), "closed";
my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 )
or die "Cannot open $file1: $UnzipError";
my $status;
my @efs;
my @unzip_names;
for ($status = 1; $status > 0; $status = $u->nextStream())
{
push @efs, $u->getHeaderInfo()->{efs};
push @unzip_names, $u->getHeaderInfo()->{Name};
}
die "Error processing $file1: $status $!\n"
if $status < 0;
is_deeply \@efs, [0, 0, 0, 0], "language encoding flag set"
or diag "Got " . Dumper(\@efs);
is_deeply \@unzip_names, [@names], "Names round tripped"
or diag "Got " . Dumper(\@unzip_names);
}
{
title "zip: EFS => 0 filename not valid utf8 - language encoding flag not set";
my $lex = LexFile->new( my $file1 );
# Invalid UTF8
my $name = "a\xFF\x{100}";
my $zip = IO::Compress::Zip->new( $file1,
Name => $name, Efs => 0 );
ok $zip->print("abcd"), "print";
ok $zip->close(), "closed";
my $u = IO::Uncompress::Unzip->new( $file1 )
or die "Cannot open $file1: $UnzipError";
ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename";
}
{
title "unzip: EFS => 0 filename not valid utf8 - language encoding flag set";
my $filename = "t/files/bad-efs.zip" ;
my $name = "\xF0\xA4\xAD";
my $u = IO::Uncompress::Unzip->new( $filename, efs => 0 )
or die "Cannot open $filename: $UnzipError";
ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename";
}
SKIP: {
title "unzip: EFS => 1 filename not valid utf8 - language encoding flag set";
# The name hard-coded into this pre-built file is not illegal UTF-EBCDIC
skip "ASCII-centric test", 1, unless ord "A" == 65;
my $filename = "t/files/bad-efs.zip" ;
eval { my $u = IO::Uncompress::Unzip->new( $filename, efs => 1 )
or die "Cannot open $filename: $UnzipError" };
like $@, qr/Zip Filename not UTF-8/,
" Zip Filename not UTF-8" ;
}
{
title "EFS => 1 - filename not valid utf8 - catch bad content writing to zip";
my $lex = LexFile->new( my $file1 );
# Invalid UTF8
my $name = "a\xFF\x{100}";
eval { my $zip = IO::Compress::Zip->new( $file1,
Name => $name, Efs => 1 ) } ;
like $@, qr/Wide character in zip filename/,
" wide characters in zip filename";
}