view release on metacpan or  search on metacpan

t/lib-Archive-Tar-Builder.t  view on Meta::CPAN

    eval { $archive->finish(); };

    is( $@ => '', '$archive->finish() does not die when writing to handle' );

    close $in;
    waitpid( $pid, 0 );

    is( ( $? >> 8 ) => 0, 'tar exited with a zero status' );

    # Need to do this otherwise the atexit() handler File::Temp sets up won't work
    chdir($oldpwd) or die("Unable to chdir() to $oldpwd: $!");
}

# Test inclusion
{
    my $archive = Archive::Tar::Builder->new;

    my ( $fh, $file ) = File::Temp::tempfile();
    print {$fh} "feh\n";
    print {$fh} "moo/*\n";
    close $fh;

    $archive->include('cats/*');
    $archive->include_from_file($file);

    my %TESTS = (
        'foo/bar/baz/foo/cats' => 0,
        'cats/meow'            => 1,
        'bleh/poo'             => 0,
        'thing/feh'            => 0,
        'feh/thing'            => 1,
        'hrm/moo'              => 0,
        'moo/hrm'              => 1
    );

    foreach my $path ( sort keys %TESTS ) {
        my $should_be_included = $TESTS{$path};

        if ($should_be_included) {
            ok( !$archive->is_excluded($path), "Path '$path' is included" );
        }
        else {
            ok( $archive->is_excluded($path), "Path '$path' is included" );
        }
    }
}

# Test exclusions
{
    my $archive = Archive::Tar::Builder->new;

    eval { $archive->exclude('excluded'); };

    is( $@ => '', '$archive->exclude() does not die' );

    my $badfile = '/dev/null/impossible';
    my ( $fh, $file ) = File::Temp::tempfile();
    print {$fh} "skipped\n";
    print {$fh} "unwanted\n";
    print {$fh} "ignored\n";
    print {$fh} "backup-[!_]*_[!-]*-[!-]*-[!_]*_foo*\n";
    close $fh;

    eval { $archive->exclude_from_file($file); };

    is( $@ => '', '$archive->exclude_from_file() does not die when given a good file' );

    eval { $archive->exclude_from_file($badfile); };

    like( $@ => qr/Cannot add items to exclusion list from file $badfile:/, '$archive->exclude_from_file() dies when unable to read file' );

    my %TESTS = (
        'foo/bar/baz'                                    => 1,
        'cats/meow'                                      => 1,
        'this/is/allowed'                                => 1,
        'meow/excluded/really'                           => 0,
        'meow/excluded'                                  => 0,
        'poop/skipped/meow'                              => 0,
        'poop/skipped'                                   => 0,
        'bleh/unwanted'                                  => 0,
        'bleh/ignored/meow'                              => 0,
        'bleh/ignored'                                   => 0,
        '/home/backup-4.5.2012_12-10-36_foo.tar.gz/cats' => 0,
        '/home/backup-4.5.2012_12-10-36_foo.tar.gz'      => 0,
        '/home/backu-4.5.2012_12-10-36_foo.tar.gz'       => 1
    );

    print '# Excluding: "excluded", "skipped", "unwanted", "ignored"' . "\n";

    foreach my $test ( sort keys %TESTS ) {
        my $expected = $TESTS{$test};

        if ( $archive->is_excluded($test) ) {
            ok( !$expected, "Path '$test' is excluded" );
        }
        else {
            ok( $expected, "Path '$test' is NOT excluded" );
        }
    }

    unlink($file);
}

# Further test inclusions
{
    my $archive = Archive::Tar::Builder->new;

    print '# Using "foo", "bar", "baz" and "meow" as inclusions' . "\n";

    my $badfile = '/dev/null/impossible';
    my ( $fh, $file ) = File::Temp::tempfile();
    print {$fh} "foo\n";
    print {$fh} "bar\n";
    print {$fh} "baz\n";
    close $fh;

    eval { $archive->include('meow'); };

    is( $@ => '', '$archive->include() does not die when adding inclusion pattern' );

    eval { $archive->include_from_file($badfile); };

    like( $@ => qr/^Cannot add items to inclusion list from file $badfile:/, '$archive->include_from_file() dies on invalid file' );

    eval { $archive->include_from_file($file); };

    is( $@ => '', '$archive->include_from_file() does not die when adding include patterns from file' );

    my %TESTS = (
        'foo'          => 1,
        'bar/poo'      => 1,
        'baz/poo'      => 1,
        'meow/cats'    => 1,
        'haz/meow/poo' => 0,
        'haz/poo/meow' => 0,
        'bleh'         => 0
    );

    foreach my $path ( sort keys %TESTS ) {
        my $should_be_included = $TESTS{$path};

        if ($should_be_included) {
            ok( !$archive->is_excluded($path), "'$path' is included" );
        }