view release on metacpan or  search on metacpan

t/moved.t  view on Meta::CPAN

# (X)Emacs mode: -*- cperl -*-

use strict;

=head1 Unit Test Package for Archive::Par

This package tests the handling of pars with corrupt source files of
Archive::Par.

=cut

use Fatal                    1.02 qw( chmod unlink );
use File::Compare          1.1002 qw( cmp );
use File::Copy               2.03 qw( cp mv );
use File::Spec::Functions         qw( catfile rel2abs );
use FindBin                  1.42 qw( $Bin );
use Test                     1.13 qw( ok plan skip );

use lib $Bin;

use test qw( DATA_DIR REF_DIR
             evcheck );

use constant TESTPAR1 => 'miffy.par';

BEGIN {
  # 1 for compilation test,
  plan tests  => 51,
       todo   => [],
}

use Archive::Par;

=head2 Test 1: compilation

This test confirms that the test script and the modules it calls compiled
successfully.

=cut

ok 1, 1, 'compilation';

=head2 Tests 2--3: Archive::Par Creation

Create a new Archive::Par object, referring to DATA_DIR/test.par

(1) Test no exception thrown
(2) Test fn component matches

=cut

my $fn = catfile DATA_DIR, TESTPAR1;
my $par;
ok(evcheck(sub{ $par = Archive::Par->new($fn); }, 'Archive::Par Creation (1)'),
	 1, 'Archive::Par Creation (1)');
ok rel2abs($par->fn), rel2abs($fn), 'Archive::Par Creation (2)';

# -------------------------------------

=head2 Tests 4--9: Files in par

Check that each file in the par is as expected

(1) There are 5 files found
(2--8) The files are each as expected (looking through the return value of 
files)

=cut

$par->check;

my @files = sort $par->files;

t/moved.t  view on Meta::CPAN

(1) miffy.2
(2) miffy.3
(4) miffy.4

=cut

ok $par->file_recoverable('miffy.2');
ok $par->file_recoverable('miffy.3');
ok $par->file_recoverable('miffy.4');

# -------------------------------------

=head2 Test 34--51: Restore File

Attempts to restore from the par file

(1) Check no exception thrown
(2--6) Check that all files are now ok (as per par instance)
(7--18) For each of miffy.{2,3,4}
  (a) Check that file really exists
  (b) Check that file matches that in testref
  (c) Check that miffy-moved.whatever does not exist
  (d) Check that file.bad does not exist

=cut

my $skip = ! -w DATA_DIR;

unless ( $skip ) {
  for (grep ! $skip, map "miffy.$_", 1,3..5) {
    cp catfile(DATA_DIR, $_), $_
      or die sprintf "Failed to move %s -> %s: $!", catfile(DATA_DIR, $_), $_;
  }
}

skip $skip, evcheck(sub { $par->restore(1) }, 'Restore File (1)'),
   1, 'Restore File (1)';

skip $skip, $par->file_ok(sprintf "miffy.%d", $_)
  for (1..5);

for (2..4) {
  my $recover = catfile DATA_DIR, "miffy.$_";
  my $checkfn = catfile REF_DIR,  "miffy.$_";
  my $old1    = catfile DATA_DIR, "miffy-moved.$_";
  my $old2    = catfile DATA_DIR, "miffy.$_.bad";
  skip $skip, -e $recover;
  skip $skip, cmp($recover, $checkfn), 0, sprintf('Restore File (%d)', $_*3+2);
  skip $skip, ! -e $_
    for $old1, $old2;
}

unless ( $skip ) {
  for (2,4) {
    mv catfile(DATA_DIR, "miffy.$_"), catfile(DATA_DIR, "miffy-moved.$_");
  }
  for (map "miffy.$_", 1,3..5) {
    my $stat = (stat($_))[2] & 0777;
    my $target = catfile(DATA_DIR, $_);
    chmod 0600, $target
      if -e $target; # #4 should be gone
    cp $_, $target
      or die sprintf "Failed to move %s -> %s: $!", $_, $target;
    chmod $stat, $target;
  }
}

# -------------------------------------