The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;