Skip to content

Commit

Permalink
Item9109: Improve Util handling of tar/zip files, and be more portabl…
Browse files Browse the repository at this point in the history 
…e to Windows.

git-svn-id: http://svn.foswiki.org/trunk@7657 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
  • Loading branch information
GeorgeClark authored and GeorgeClark committed Jun 7, 2010
1 parent 962e892 commit e91c864
Show file tree
Hide file tree
Showing 2 changed files with 167 additions and 38 deletions.
117 changes: 107 additions & 10 deletions UnitTestContrib/test/unit/ConfigureTests.pm
View file
Expand Up @@ -1310,7 +1310,7 @@ HERE

}

sub test_Util_createArchive {
sub test_Util_createArchive_shellZip {
my $this = shift;

my $file;
Expand All @@ -1325,26 +1325,125 @@ sub test_Util_createArchive {
mkpath("$tempdir/$extbkup");
_makePackage( "$tempdir/$extbkup", $extension );

($file, $rslt) = Foswiki::Configure::Util::createArchive( "$extbkup", "$tempdir", '0', 'tar');
$this->assert( (-f $file), "$file does not appear to exist - Create tar archive");
unlink ($file); # Cleanup for next test
eval
{
my $blah = system("zip --version > null");
#print "zip returns $? ($blah) \n";
die $! unless ($? == 0 );
1;
}
or do {
my $mess = $@;
$this->expect_failure();
$this->annotate(
"CANNOT RUN shell test for zip archive: $mess");
$this->assert(0);
};

($file, $rslt) = Foswiki::Configure::Util::createArchive( "$extbkup", "$tempdir", '0', 'zip');
$this->assert( (-f $file), "$file does not appear to exist - Create zip archive");

unlink "$tempdir/$extbkup"; # Clean up old files if left behind
}

sub test_Util_createArchive_shellTar {
my $this = shift;

my $file;
my $rslt;

my $tempdir = $this->{tempdir} . '/test_Util_createArchive';
rmtree($tempdir); # Clean up old files if left behind

my $extension = "MyPlugin";
my $extbkup = "$extension-backup-20100329-123456";

mkpath("$tempdir/$extbkup");
_makePackage( "$tempdir/$extbkup", $extension );

eval
{
my $blah = system("tar --version > null");
#print "tar returns $? ($blah) \n";
die $! unless ($? == 0 );
1;
}
or do {
my $mess = $@;
$this->expect_failure();
$this->annotate(
"CANNOT RUN shell test for tar archive: $mess");
$this->assert(0);
};

($file, $rslt) = Foswiki::Configure::Util::createArchive( "$extbkup", "$tempdir", '0', 'tar');
$this->assert( (-f $file), "$file does not appear to exist - Create tar archive");
unlink ($file); # Cleanup for next test

}

sub test_Util_createArchive_perlTar {
my $this = shift;

my $file;
my $rslt;

my $tempdir = $this->{tempdir} . '/test_Util_createArchive';
rmtree($tempdir); # Clean up old files if left behind

my $extension = "MyPlugin";
my $extbkup = "$extension-backup-20100329-123456";

mkpath("$tempdir/$extbkup");
_makePackage( "$tempdir/$extbkup", $extension );

eval
'use Archive::Tar;
1;
'
or do {
my $mess = $@;
$mess =~ s/\(\@INC contains:.*$//s;
$this->expect_failure();
$this->annotate(
"CANNOT RUN test for tar archive: $mess");
$this->assert(0);
};

($file, $rslt) = Foswiki::Configure::Util::createArchive( "$extbkup", "$tempdir", '0', 'Ptar');
$this->assert( (-f $file), "$file does not appear to exist - Create Archive::Tar archive");

eval 'use Archive::Zip';
if ($@) {
unlink "$tempdir/$extbkup"; # Clean up old files if left behind
}

sub test_Util_createArchive_perlZip {
my $this = shift;

my $file;
my $rslt;

my $tempdir = $this->{tempdir} . '/test_Util_createArchive';
rmtree($tempdir); # Clean up old files if left behind

my $extension = "MyPlugin";
my $extbkup = "$extension-backup-20100329-123456";

mkpath("$tempdir/$extbkup");
_makePackage( "$tempdir/$extbkup", $extension );

eval
'use Archive::Zip;
1;
'
or do {
my $mess = $@;
$mess =~ s/\(\@INC contains:.*$//s;
$this->expect_failure();
$this->annotate(
"CANNOT RUN test for zip archive: $mess");
$this->assert(0);
}
};

($file, $rslt) = Foswiki::Configure::Util::createArchive( "$extbkup", "$tempdir", '1', 'Pzip');
$this->assert( (-f $file), "$file does not appear to exist - Create Archive::Zip archive");

Expand Down Expand Up @@ -1431,8 +1530,6 @@ sub test_Package_errors{
my $this = shift;
my $root = $this->{rootdir};

print STDERR "### NOTE ###\n This test is expected to generate errors due to invalid tar/zip archives\n";

my $tempdir = $this->{tempdir} . '/test_Package_loadInstaller';
rmtree($tempdir); # Clean up old files if left behind
mkpath($tempdir);
Expand Down Expand Up @@ -1489,7 +1586,7 @@ DONE
Test file data
DONE
$pkg->install();
$this->assert_matches( qr/unzip failed/, $pkg->errors(), 'Unexpected results from failed zip test');
$this->assert_matches( qr/(format error|unzip failed)/, $pkg->errors(), 'Unexpected results from failed zip test');
unlink $tempdir."/MyPlugin.tgz";
$pkg->finish();
undef $pkg;
Expand Down
88 changes: 60 additions & 28 deletions core/lib/Foswiki/Configure/Util.pm
View file
Expand Up @@ -382,13 +382,29 @@ sub unpackArchive {

sub _unzip {
my $archive = shift;

eval 'use Archive::Zip';
unless ($@) {
my $zip = Archive::Zip->new($archive);
unless ($zip) {
return "unzip failed: Could not open zip file $archive\n";
my $usezip = 0; # Set true if shell zip is required
my $error = '';

eval 'use Archive::Zip ();
1;'
or do {
$usezip = 1;
};

my $zip;
unless ($usezip) {
eval {
$zip = Archive::Zip->new($archive);
unless ($zip) {
die "unzip failed: Could not open zip file $archive\n";
}
1;
}
or do {
$error = $@;
};

return $error if ($error);

my @members = $zip->members();
foreach my $member (@members) {
Expand All @@ -404,34 +420,46 @@ sub _unzip {
}
}
else {
my $out = `unzip -n $archive`;

# On certain older versions of perl / unzip it seems the unzip results
# in an illegal seek error. But running the same command again often
# goes well. Seems like the 2nd pass works because the subdirectories
# are then created. A hack but it seems to work.
if ($?) {
`unzip -n $archive`;
if ($?) {
return "unzip failed: $!\n";
eval {
my $out = `unzip -n $archive`;
die "$? - $!" if ($?);
1;
}
}
or do {
$error = "unzip failed $@ \n";
};
}

return;
return $error;
}

sub _untar {
my $archive = shift;

my $compressed = ( $archive =~ /z$/i ) ? 'z' : '';

eval 'use Archive::Tar ()';
unless ($@) {
my $tar = Archive::Tar->new( $archive, $compressed );
unless ($tar) {
return "Could not open tar file $archive\n";
my $usetar = 0;
my $error = '';

eval 'use Archive::Tar ();
1;'
or do {
$usetar = 1;
};

my $tar;
unless ($usetar) {
eval {
$tar = Archive::Tar->new( $archive, $compressed );
unless ($tar) {
die "Could not open tar file $archive\n";
}
1;
}
or do {
$error = $@;
};

return $error if ($error);

my @members = $tar->list_files();
foreach my $file (@members) {
Expand All @@ -443,13 +471,17 @@ sub _untar {
}
}
else {
`tar xvf$compressed $archive`;
if ($?) {
return "tar failed: $? - $!\n";
eval {
`tar xvf$compressed $archive`;
die "$? - $!" if ($?);
1;
}
or do {
$error = "tar failed: $@\n";
}
}

return;
return $error;
}

=begin TML
Expand Down

0 comments on commit e91c864

Please sign in to comment.