view release on metacpan or  search on metacpan

lib/Brackup/Test.pm  view on Meta::CPAN

                                        prefix => $prefix,
                                        file   => $backup_file,
                                        );
    ok($restore, "have restore object");
    my $rv = eval { $restore->restore; };
    if ($restore_should_die) {
        ok(! defined $rv, "restore died: $@") 
            or die "restore unexpectedly succeeded";
        return;
    }
    else {
        ok($rv, "did the restore") 
            or die "restore failed: $@";
        return $restore_dir;
    }
}

sub ok_dirs_match {
    my ($after, $before) = @_;

    my $pre_ls  = dir_structure($before);
    my $post_ls = dir_structure($after);

    if ($has_diff) {
        use Data::Dumper;
        my $pre_dump = Dumper($pre_ls);
        my $post_dump = Dumper($post_ls);
        my $diff = Text::Diff::diff(\$pre_dump, \$post_dump);
        is($diff, "", "dirs match");
    } else {
        is_deeply($post_ls, $pre_ls, "dirs match");
    }
}

sub ok_files_match {
    my ($after, $before) = @_;

    my $pre_ls  = file_meta($before);
    my $post_ls = file_meta($after);

    if ($has_diff) {
        use Data::Dumper;
        my $pre_dump = Dumper($pre_ls);
        my $post_dump = Dumper($post_ls);
        my $diff = Text::Diff::diff(\$pre_dump, \$post_dump);
        is($diff, "", "files match");
    } else {
        is_deeply($post_ls, $pre_ls, "files match");
    }
}

sub ok_dir_empty {
    my $dir = shift;
    unless (-d $dir) { ok(0, "not a dir"); return; }
    opendir(my $dh, $dir) or die "failed to opendir: $!";
    is_deeply([ sort readdir($dh) ], ['.', '..'], "dir is empty: $dir");
}

sub file_meta {
    my $path = shift;
    my $st = File::stat::lstat($path);

    my $meta = {};
    $meta->{size} = $st->size unless -d $path;
    $meta->{is_file} = 1 if -f $path;
    $meta->{is_link} = 1 if -l $path;
    if ($meta->{is_link}) {
        $meta->{link} = readlink $path;
    } else {
        # we ignore these for links, since Linux doesn't let us restore anyway,
        # as Linux as no lutimes(2) syscall, as of Linux 2.6.16 at least
        $meta->{atime} = $st->atime if 0; # TODO: make tests work with atimes
        $meta->{mtime} = $st->mtime;
        $meta->{mode}  = sprintf('%#o', $st->mode & 0777);
    }

    # the gpg tests open/close the rings in the root, so
    # mtimes get bumped around or something.  the proper fix
    # is too ugly for what it's worth, so let's just ignore
    # the mtime of top-level
    delete $meta->{mtime} if $path eq ".";

    return $meta;
}

# given a directory, returns a hashref of its contentn
sub dir_structure {
    my $dir = shift;
    my %files;  # "filename" -> {metadata => ...}
    my $cwd = getcwd;
    chdir($dir) or die "Failed to chdir to $dir";

    find({
        no_chdir => 1,
        preprocess => sub { return sort @_ },
        wanted => sub {
            my $path = $_;
            $files{$path} = file_meta($path);
        },
    }, ".");

    chdir($cwd) or die "Failed to chdir back to $cwd";
    return \%files;
}

# add a random number of orphan chunks to $target
sub add_orphan_chunks {
    my ($root, $target, $orphan_chunks_count) = @_;

    for (1..$orphan_chunks_count) {
        # HACK: to avoid worse hacks, we need a pchunk to store an orphan chunk.
        # We use small segments of 'pubring-test.gpg' so that they are different 
        # than all other chunks
        my $pchunk = Brackup::PositionedChunk->new(
            file => Brackup::File->new(root => $root,
                                       path => 'pubring-test.gpg'),
            offset => $_ * 10,
            length => 10,
        );

        # no encryption, copy raw data and store schunk