File Coverage

blib/lib/Test2/Util/DistFiles.pm

Criterion	Covered	Total	%
statement	61	63	96.8
branch	13	24	54.1
condition	15	38	39.4
subroutine	14	14	100.0
pod	2	2	100.0
total	105	141	74.4

package Test2::Util::DistFiles;

# ABSTRACT: Gather a list of files in a distribution

use v5.14;
use warnings;

use Carp                    qw( croak );
use Cwd::Guard              qw( cwd_guard );
use Exporter 5.57           qw( import );
use ExtUtils::Manifest 1.68 qw( manifind maniread maniskip );
use File::Basename          qw( basename );
use File::Spec;
use IO::File;
use Ref::Util qw( is_plain_hashref );

# RECOMMEND PREREQ: Ref::Util::XS

our @EXPORT_OK = qw( manifest_files is_perl_file );

our $VERSION = 'v0.2.1';


sub manifest_files {

    my $options = {};
    $options = shift if is_plain_hashref( $_[0] );

    state $nop = sub { 1 };

    my $filter = shift || $nop;

    my $guard;
    if ( my $dir = $options->{dir} ) {
        $guard = cwd_guard($dir) or croak "Cannot chdir to ${dir}: $Cwd::Guard::Error";
    }

    $options->{use_default} //= 1;

    my $default = $options->{use_default}
      ? sub {
        my ($file) = @_;
        my $name = basename($file);
        return
          if $file =~ m{^\.\w+/}                  # .git, .svn, .build, .mite ...
          || $file =~ m{^blib/}                   #
          || $file =~ m{^local/}                  # Carton
          || $name =~ m{^\.}                      #
          || $name =~ m{~$}
          || $name =~ m{^#.*#$}                   #
          || $name =~ m{\.(?:old|bak|backup)$}i
          || $file eq "Build";
        return 1;
      }
      : $nop;

    my $found;

    my $mfile = $ExtUtils::Manifest::MANIFEST;
    if ( -e $mfile ) {
        $found = maniread($mfile);
    }
    else {
        $found = manifind;
    }

    my $skip = maniskip;

    $guard = undef;

    my @files = grep { !$skip->($_) && $default->($_) && $filter->($_) } sort keys %{$found};
    return File::Spec->no_upwards(@files);
}


sub is_perl_file {
    my ($file) = @_;
    my $name = basename($file);
    return   if $file =~ m{^(inc|local)/};
    return 1 if $name =~ /\.(?:PL|p[lm]|psgi|t)$/;
    return   if $name =~ /\.\w+$/ && $name !~ /\.bat$/;
    my $fh    = IO::File->new( $file, "r" ) or return;
    my $first = $fh->getline;
    return 1 if $first && ( $first =~ /^#!.*perl\b/ || $first =~ /--[*]-Perl-[*]--/ );
    return;
}


1;

__END__