File Coverage

blib/lib/Test/CheckManifest.pm

Criterion	Covered	Total	%
statement	159	173	91.9
branch	58	86	67.4
condition	33	63	52.3
subroutine	16	16	100.0
pod	1	1	100.0
total	267	339	78.7

package Test::CheckManifest;

# ABSTRACT: Check if your Manifest matches your distro

use strict;
use warnings;

use Cwd;
use Carp;
use File::Spec;
use File::Basename;
use Test::Builder;
use File::Find;

our $VERSION = '1.31';
our $VERBOSE = 1;

my $test      = Test::Builder->new();
my $test_bool = 1;
my $plan      = 0;
my $counter   = 0;

sub import {
    my $self   = shift;
    my $caller = caller;
    my %plan   = @_;

    for my $func ( qw( ok_manifest ) ) {
        no strict 'refs';
        *{$caller."::".$func} = \&$func;
    }

    $test->exported_to($caller);
    $test->plan(%plan);

    $plan = 1 if(exists $plan{tests});
}

sub ok_manifest{
    my ($hashref,$msg) = @_;

    $test->plan(tests => 1) unless $plan;

    my $is_hashref = 1;
    $is_hashref = 0 unless ref($hashref);

    unless ( $is_hashref ) {
        $msg = $hashref;
        $hashref = {};
    }

    my $tmp_path = dirname( File::Spec->rel2abs( $0 ) );

    if ( $hashref->{file} ) {
        $tmp_path = dirname $hashref->{file};
    }
    elsif ( $hashref->{dir} ) {
        $tmp_path = $hashref->{dir};
    }

    my $bool = 1;
    my $home = Cwd::realpath( $tmp_path );
    my $manifest;

    my $counter = 0;
    while ( 1 ) {
        my $manifest_path = File::Spec->catfile( $home . '/MANIFEST' );
        last if -f $manifest_path;

        my $tmp_home = Cwd::realpath( File::Spec->catdir( $home, '..' ) );

        last if !$tmp_home || $tmp_home eq $home || $counter++ == 20;
        $home = $tmp_home;
    }

    eval { $manifest = Cwd::realpath( $home . '/MANIFEST' ); 1; };
    if ( !$manifest ) {
        $test->BAILOUT( 'Cannot find a MANIFEST. Please check!' );
    }

    my $skip;
    my $skip_path = File::Spec->catfile( $home, 'MANIFEST.SKIP' );
    eval { $skip = Cwd::realpath( $skip_path ) if -f $skip_path; 1; };

    my @dup_files     = ();
    my @missing_files = ();
    my @files_plus    = ();
    my $arref         = ['/blib' , '/_build'];
    my $filter        = $is_hashref &&
                        $hashref->{filter} ? $hashref->{filter}  : [];
    my $comb          = $is_hashref &&
                        $hashref->{bool} &&
                        $hashref->{bool} =~ m/^and$/i ?
                               'and' :
                               'or';

    push @$arref, @{$hashref->{exclude}}
        if $is_hashref and exists $hashref->{exclude} and
            ref($hashref->{exclude}) eq 'ARRAY';

    for(@$arref){
        croak 'path in excluded array must be "absolute"' unless m!^/!;
        my $path = $home . $_;
        next unless -e $path;
        $_ = Cwd::realpath($path);
    }

    @$arref = grep { defined }@$arref;

    unless( open my $fh, '<', $manifest ){
        $bool = 0;
        $msg  = "can't open $manifest";
    }
    else{
        { # extra block to use "last"

        my $files_in_skip = _read_skip( $skip, \$msg, \$bool );
        last unless $files_in_skip;

        my @files = _read_file( $fh );
        close $fh;

        chomp @files;

        {
            local $/ = "\r";
            chomp @files;
        }

        for my $tfile(@files){
            $tfile = (split(/\s{2,}/,$tfile,2))[0];
            next unless -e $home . '/' . $tfile;
            $tfile = Cwd::realpath($home . '/' . $tfile);
        }

        my (@dir_files,%files_hash,%excluded);
        @files_hash{@files} = ();

        find({no_chdir => 1,
            wanted   => sub{
                my $file         = $File::Find::name;
                my $is_excluded  = _is_excluded(
                    $file,
                    $arref,
                    $filter,
                    $comb,
                    $files_in_skip,
                    $home,
                );

                push(@dir_files,Cwd::realpath($file)) if -f $file and !$is_excluded;

                $excluded{$file} = 1 if -f $file and $is_excluded
            }
        },$home);

        #use Data::Dumper;
        #print STDERR ">>",++$counter,":",Dumper(\@files,\@dir_files);
        SFILE:
        for my $file(@dir_files){
            for my $check(@files){
                if($file eq $check){
                    delete $files_hash{$check};
                    next SFILE;
                }
            }
            push(@missing_files,$file);
            $bool = 0;
        }

        delete $files_hash{$_} for keys %excluded;
        @files_plus = sort keys %files_hash;
        $bool = 0 if scalar @files_plus > 0;

        my %seen_files = ();
        @dup_files = map { 1==$seen_files{$_}++ ? $_ : () } @files;
        $bool = 0 if scalar @dup_files > 0;

        } # close extra block
    }

    my $diag = 'The following files are not named in the MANIFEST file: '.
               join(', ',@missing_files);
    my $plus = 'The following files are not part of distro but named in the MANIFEST file: '.
               join(', ',@files_plus);
    my $dup  = 'The following files appeared more than once in the MANIFEST file: '.
               join(', ',@dup_files);

    $test->is_num($bool,$test_bool,$msg);
    $test->diag($diag) if scalar @missing_files >= 1 and $test_bool == 1 and $VERBOSE;
    $test->diag($plus) if scalar @files_plus    >= 1 and $test_bool == 1 and $VERBOSE;
    $test->diag($dup)  if scalar @dup_files     >= 1 and $test_bool == 1 and $VERBOSE;
}

sub _read_file {
    my ($fh) = @_;

    my @files;
    my $selftest = 0;

    while( my $fh_line = <$fh> ){
        chomp $fh_line;

        $selftest++ if $fh_line =~ m{# MANIFEST for Test-CheckManifest};

        next if $fh_line =~ m{ \A \s* \# }x;
        next if $selftest && $fh_line =~ m{# selftest};

        my ($file);

        if ( ($file) = $fh_line =~ /^'(\\[\\']|.+)+'\s*(.*)/) {
            $file =~ s/\\([\\'])/$1/g;
        }
        else {
            ($file) = $fh_line =~ /^(\S+)\s*(.*)/;
        }

        next unless $file;

        push @files, $file;
    }

    return @files;
}

sub _not_ok_manifest{
    $test_bool = 0;
    ok_manifest(@_);
    $test_bool = 1;
}

sub _is_excluded{
    my ($file,$dirref,$filter,$bool,$files_in_skip,$home) = @_;
    my @excluded_files = qw(
        pm_to_blib Makefile META.yml Build pod2htmd.tmp
        pod2htmi.tmp Build.bat .cvsignore MYMETA.json MYMETA.yml
    );

    if ( $files_in_skip and 'ARRAY' eq ref $files_in_skip ) {
        (my $local_file = $file) =~ s{\Q$home\E/?}{};
        for my $rx ( @{$files_in_skip} ) {
            my $regex = qr/$rx/;
            return 1 if $local_file =~ $regex;
        }
    }

    my @matches = grep{ $file =~ /$_$/ }@excluded_files;

    if($bool eq 'or'){
        push @matches, $file if grep{ref($_) and ref($_) eq 'Regexp' and $file =~ /$_/}@$filter;
        push @matches, $file if grep{$file =~ /^\Q$_\E/}@$dirref;
    }
    else{
        if(grep{$file =~ /$_/ and ref($_) and ref($_) eq 'Regexp'}@$filter and
           grep{$file =~ /^\Q$_\E/ and not ref($_)}@$dirref){
            push @matches, $file;
        }
    }

    return scalar @matches;
}

sub _read_skip {
    my ($skip, $msg, $bool) = @_;

    return [] unless $skip and -e $skip;

    my @files;
    if( -e $skip and not open my $skip_fh, '<', $skip ) {
        $$bool = 0;
        $$msg  = "can't open $skip";
        return;
    }
    else {
        @files = _read_file( $skip_fh );
    }

    return \@files;
}

1;

__END__