view release on metacpan or  search on metacpan

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

use strict;
use warnings;

use ExtUtils::testlib;
use FindBin;

use Cwd        ();
use File::Temp ();
use File::Path ();
use IPC::Open3 ();
use Symbol     ();
use Errno;

use Archive::Tar::Builder ();

use Test::More tests => 74;
use Test::Exception;

sub find_tar {
    my @PATH     = qw( /usr/local/bin /usr/bin /bin );
    my @PROGRAMS = qw( gtar ustar star bsdtar tar );

    foreach my $program (@PROGRAMS) {
        foreach my $dir (@PATH) {
            my $name = "$dir/$program";

            return $name if -x $name;
        }
    }

    die('Could not locate a tar binary');
}

sub is_bsd_tar {
    my ($tar) = @_;
    my $is_bsd_tar = 0;

    open( my $in,  '<', '/dev/null' ) or die("Unable to open /dev/null for reading: $!");
    open( my $out, '>', '/dev/null' ) or die("Unable to open /dev/null for writing: $!");

    my $err = Symbol::gensym();

    my $pid = IPC::Open3::open3( $in, $out, $err, $tar, '--help' );

    close $in;
    close $out;

    while ( my $line = readline($err) ) {
        chomp $line;
        $is_bsd_tar = 1 if $line =~ /^usage: tar .*crtux/;
    }

    close $err;

    waitpid( $pid, 0 ) or die("Unable to waitpid() on $pid: $!");

    return $is_bsd_tar;
}

sub find_unused_ids {
    my ( $uid, $gid );

    for ( $uid = 99999; getpwuid($uid); $uid-- ) { }
    for ( $gid = 99999; getgrgid($gid); $gid-- ) { }

    return ( $uid, $gid );
}

sub build_tree {
    my $tmpdir = File::Temp::tempdir( 'CLEANUP' => 1 );
    my $file   = "$tmpdir/foo/exclude.txt";

    File::Path::mkpath("$tmpdir/foo/bar/baz/foo/cats");
    File::Path::mkpath("$tmpdir/foo/poop");
    File::Path::mkpath("$tmpdir/foo/cats/meow");
    File::Path::mkpath("$tmpdir/home/prrr/1327342027.M926735P26547V000000000000FD00I0000000001888287_0.one.two.threefour.five.S=2486:2.");

    open( my $fh, '>', $file ) or die("Unable to open $file for writing: $!");
    print {$fh} "cats\n";
    close $fh;

    my $long   = 'bleh' x 50;
    my $subdir = "$tmpdir/$long/$long";
    $file = "$subdir/thingie.txt";

    File::Path::mkpath($subdir);

    open( $fh, '>', $file ) or die("Unable to open $file for writing: $!");
    print {$fh} "Meow\n";
    close $fh;

    return $tmpdir;
}

my $badfile = '/dev/null/impossible';
my $tar     = find_tar();

{
    my $builder = Archive::Tar::Builder->new;

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

    like( $@ => qr/No paths to archive specified/, '$builder->archive() dies if no paths are specified' );

    eval { $builder->archive('foo'); };

    like( $@ => qr/No file handle set/, '$builder->archive() dies if no file handle is set' );

    eval { $builder->archive_as( 'foo' => 'bar' ); };

    like( $@ => qr/No file handle set/, '$builder->archive_as() dies if no file handle is set' );
}

SKIP: {
    skip( 'Cannot test permissions failures as root', 2 ) if $< == 0;

    my $tmp = File::Temp::tempdir( 'CLEANUP' => 1 );
    my $dir = "$tmp/foo";

    mkdir( $dir, 0000 );

    my $builder = Archive::Tar::Builder->new( 'quiet' => 1 );

    open( my $fh, '>', '/dev/null' ) or die("Unable to open /dev/null: $!");

    $builder->set_handle($fh);