File Coverage

blib/lib/Path/Tiny/Archive/Tar.pm

Criterion	Covered	Total	%
statement	46	49	93.8
branch	12	20	60.0
condition			n/a
subroutine	10	12	83.3
pod	4	4	100.0
total	72	85	84.7

package Path::Tiny::Archive::Tar;

# ABSTRACT: Tar/untar add-on for file path utility

use strict;
use warnings;

use Archive::Tar ();
use Compress::Raw::Zlib ();
use Exporter qw( import );
use Path::Tiny qw( path );


our $VERSION = '0.003';

our %EXPORT_TAGS = ( const =>[qw(
    COMPRESSION_NONE
    COMPRESSION_GZIP
    COMPRESSION_GZIP_DEFAULT
    COMPRESSION_GZIP_NONE
    COMPRESSION_GZIP_FASTEST
    COMPRESSION_GZIP_BEST
    COMPRESSION_BZIP2
)] );
our @EXPORT_OK = @{ $EXPORT_TAGS{const} };


BEGIN {
    push(@Path::Tiny::ISA, __PACKAGE__);
}

use constant {
    COMPRESSION_NONE         => undef,
    # Hack for Archive::Tar: true so don't use default compression and pass
    # this level to IO::Zlib. And hack for Compress::Zlib: not digit so use
    # default compression (letters may specify other compression modes).
    COMPRESSION_GZIP         => '-',
    COMPRESSION_GZIP_DEFAULT => '-',
    # Hack for Archive::Tar: zero but true so pass 0 level to IO::Zlib.
    COMPRESSION_GZIP_NONE    => '00',
    COMPRESSION_GZIP_FASTEST => Compress::Raw::Zlib::Z_BEST_SPEED,
    COMPRESSION_GZIP_BEST    => Compress::Raw::Zlib::Z_BEST_COMPRESSION,
    COMPRESSION_BZIP2        => Archive::Tar::COMPRESS_BZIP,
};


sub tar {
    my ($self, $dest, $level) = @_;

    $dest = path($dest);

    my $tar = Archive::Tar->new;

    if ($self->is_file) {
        my $file = Archive::Tar::File->new(file => $self->stringify());

        return unless $file;

        $file->name($self->basename);
        $file->prefix('');

        $tar->add_files($file) or return;
    }
    elsif ($self->is_dir) {
        my $paths = $self->iterator({ recurse => 1 });

        while (my $path = $paths->()) {
            my $file = Archive::Tar::File->new(file => $path->stringify());

            return unless $file;

            $file->rename($path->relative($self));

            $tar->add_files($file) or return;
        }
    }
    else {
        return;
    }

    $tar->write($dest->stringify(), defined $level ? $level : ()) or return;

    return $dest;
}


sub tgz {
    return $_[0]->tar($_[1], COMPRESSION_GZIP);
}


sub tbz2 {
    return $_[0]->tar($_[1], COMPRESSION_BZIP2);
}


sub untar {
    my ($self, $dest) = @_;

    $dest = path($dest);

    my $files = Archive::Tar->iter($self->stringify());

    return unless $files;

    while (my $file = $files->()) {
        $file->extract($dest->child($file->full_path)->stringify()) or return;
    }

    return $dest;
}


1;

__END__