use strict;
use Test::More tests => 9+14+28;
use Cwd;
use File::Spec;
use File::Temp qw/tempdir/;
use File::Copy qw/copy/;
use File::Basename qw/basename/;
BEGIN {
use_ok('Archive::Rar::Passthrough');
}
sub test_passthrough_extraction {
my $rar = shift;
my $archive = shift;
my $files = shift;
# temp dir for extraction test
my $tmpdir = tempdir( CLEANUP => 1 );
copy($archive, $tmpdir) or die "Copying of test archive failed: $!";
my $olddir = cwd();
local $SIG{__DIE__} = sub { chdir($olddir); die @_;};
chdir($tmpdir);
my $localarchive = basename($archive);
ok(-f $localarchive, "temporary copy of archive exists");
my $errcode = $rar->run(
command => 'e',
archive => $localarchive,
);
ok(!$errcode, 'rar extract succeeded');
my $out = $rar->get_stdout();
ok(defined $out, 'get_stdout() return value defined');
my $err = $rar->get_stderr();
ok(defined $err, 'get_stderr() return value defined');
$rar->clear_buffers();
is($rar->get_stdout(), '', 'clear_buffers() erased stdout');
is($rar->get_stderr(), '', 'clear_buffers() erased stderr');
check_files_exist($files);
delete_files($files);
# check that specific extraction path works
$errcode = $rar->run(
command => 'e',
archive => $localarchive,
path => '.',
);
ok(!$errcode, 'rar extract succeeded');
check_files_exist($files);
# check that overwrite works
overwrite_files_with_garbage($files);
my $ages = get_file_ages($files);
sleep 1;
$errcode = $rar->run(
command => 'e',
archive => $localarchive,
switches => ['-y', '-o+'],
path => '.',
);
ok(!$errcode, 'rar extract succeeded');
check_files_exist($files);
my $new_ages = get_file_ages($files);
foreach (0..@$new_ages-1) {
my $old = $ages->[$_];
my $new = $new_ages->[$_];
my $eps = 1e-15;
ok($new+$eps < $old || $new-$eps > $old, "File " . ($_+1) . " was overwritten.");
}
chdir($olddir);
return;
}
sub check_files_exist {
my $files = shift;
my @filescopy = @$files;
while (@filescopy) {
my $name = shift @filescopy;
my $size = shift @filescopy;
ok(-f $name, "$name was extracted");
is(-s $name, $size, "$name has right size"); # is this different on windows?
}
}
sub delete_files {
my $files = shift;
my @filescopy = @$files;
while (@filescopy) {
my $name = shift @filescopy;
my $size = shift @filescopy;
unlink($name) or die "Could not delete file '$name': $!";
ok(!-f $name, "$name was deleted");
}
}
sub get_file_ages {
my $files = shift;
my @filescopy = @$files;
my @ages;
while (@filescopy) {
my $name = shift @filescopy;
my $size = shift @filescopy;
ok(-f $name, "File $name exists.");
push @ages, -M $name;
}
return \@ages;
}
sub overwrite_files_with_garbage {
my $files = shift;
my @filescopy = @$files;
while (@filescopy) {
my $name = shift @filescopy;
my $size = shift @filescopy;
open my $fh, '>', $name or die $!;
print $fh "OVERWRITTEN\n";
close $fh;
}
}
my $datadir = File::Spec->catdir("t", "data");
my @datafilenames = ('test.rar', 'funny.rar');
my @datafilecontents = (
[qw/COPYRIGHT 183 README 890/],
['funny file name(blah).txt', '28'],
);
foreach my $datafileno (0..$#datafilenames) {
my $datafilename = $datafilenames[$datafileno];
my $datafilecontent = $datafilecontents[$datafileno];
my $datafile = File::Spec->catfile($datadir, $datafilename);
if (not -f $datafile) {
$datadir = 'data';
$datafile = File::Spec->catfile($datadir, $datafilename);
}
ok(-f $datafile, "Test archive found");
my $rar = Archive::Rar::Passthrough->new();
isa_ok($rar, 'Archive::Rar::Passthrough');
test_passthrough_extraction(
$rar, $datafile, $datafilecontent
);
}
1;