File Coverage

blib/lib/File/ShareDir/Tarball.pm

Criterion	Covered	Total	%
statement	37	44	84.0
branch	5	12	41.6
condition			n/a
subroutine	10	11	90.9
pod	2	2	100.0
total	54	69	78.2

package File::ShareDir::Tarball;
BEGIN {
  $File::ShareDir::Tarball::AUTHORITY = 'cpan:YANICK';
}
{
  $File::ShareDir::Tarball::VERSION = '0.2.2';
}
# ABSTRACT: Deal transparently with shared files distributed as tarballs


use strict;
use warnings;

use parent qw/ Exporter /;

use Carp;

use File::ShareDir;
use Archive::Tar;
use File::Temp qw/ tempdir /;
use File::chdir;

our @EXPORT_OK   = qw{
    dist_dir dist_file
};
our %EXPORT_TAGS = (
    all => [ @EXPORT_OK ],
);

my $shared_files_tarball = 'shared-files.tar.gz';

# we don't want to extract the same dirs again and
# again within a single program
my %DIR_CACHE;

sub dist_dir {
    my $dist = shift;

    return $DIR_CACHE{$dist} if $DIR_CACHE{$dist};

    my $dir = File::ShareDir::dist_dir($dist);

    # no tarball? Assume regular shared dir
    return $DIR_CACHE{$dist} = $dir
        unless -f "$dir/$shared_files_tarball";

    my $archive = Archive::Tar->new;
    $archive->read("$dir/$shared_files_tarball");

    # because that would be a veeery bad idea
    croak "archive '$shared_files_tarball' contains files with absolute path, aborting"
        if grep { m#^/# } $archive->list_files;

    my $tmpdir = tempdir( CLEANUP => 1 );
    local $CWD = $tmpdir;

    $archive->extract;

    return $DIR_CACHE{$dist} = $tmpdir;
}

sub dist_file {
    my $dist = File::ShareDir::_DIST(shift);
    my $file = File::ShareDir::_FILE(shift);

    my $path = dist_dir($dist).'/'.$file;

	return undef unless -e $path;

    croak("Found dist_file '$path', but not a file")
        unless -f $path;

    croak("File '$path', no read permissions")
        unless -r $path;

	return $path;
}


1;

__END__