package Test::CheckManifest; # ABSTRACT: Check if your Manifest matches your distro use strict; use warnings; use 5.008; use Cwd; use Carp; use File::Spec; use File::Basename; use Test::Builder; use File::Find; use Scalar::Util qw(blessed); our $VERSION = '1.43'; our $VERBOSE = 1; our $HOME; our $test_bool = 1; my $test = Test::Builder->new(); my $plan = 0; my $counter = 0; my @excluded_files = qw( pm_to_blib Makefile META.yml Build pod2htmd.tmp META.json pod2htmi.tmp Build.bat .cvsignore MYMETA.json MYMETA.yml ); sub import { my $self = shift; my $caller = caller; my %plan = @_; for my $func ( qw( ok_manifest ) ) { no strict 'refs'; ## no critic *{$caller."::".$func} = \&$func; } $test->exported_to($caller); $test->plan(%plan); $plan = 1 if(exists $plan{tests}); } sub _validate_args { my ($hashref, $msg) = @_; my $ref = ref $hashref; if ( !$ref || 'HASH' ne $ref ) { $msg = $hashref if !$ref; $hashref = {}; } my $ref_filter = ref $hashref->{filter}; $hashref->{filter} = [] if !$ref_filter || 'ARRAY' ne $ref_filter; $hashref->{filter} = [ grep{ blessed $_ && $_->isa('Regexp') } @{ $hashref->{filter} } ]; my $ref_exclude = ref $hashref->{exclude}; $hashref->{exclude} = [] if !$ref_exclude || 'ARRAY' ne $ref_exclude; push @{$hashref->{exclude}}, qw!/blib /_blib! if $test_bool; for my $excluded_path ( @{ $hashref->{exclude} } ) { croak 'path in excluded array must be "absolute"' if $excluded_path !~ m!^/!; } my $bool = lc( $hashref->{bool} || '' ); $hashref->{bool} = $bool && $bool eq 'and' ? 'and' : 'or'; return $hashref, $msg; } sub _check_excludes { my ($hashref, $home) = @_; my @excluded; EXCLUDED_PATH: for my $excluded_path ( @{ $hashref->{exclude} } ) { next EXCLUDED_PATH if !defined $excluded_path; next EXCLUDED_PATH if !length $excluded_path; my $path = File::Spec->catdir($home, $excluded_path); $path = File::Spec->rel2abs( $path ) if !File::Spec->file_name_is_absolute( $path ); next if !-e $path; push @excluded, $path; } return \@excluded; } sub _find_home { my ($params) = @_; my $tmp_path = File::Spec->rel2abs( $0 ); my ($home, $volume, $dirs, $file, @dirs); if ( $params->{file} ) { $tmp_path = $params->{file}; } elsif ( $params->{dir} ) { $tmp_path = File::Spec->catfile( $params->{dir}, 'test' ); } ($volume,$dirs,$file) = File::Spec->splitpath($tmp_path); $home = File::Spec->catdir($volume, $dirs); my $counter = 0; while ( 1 ) { last if -f File::Spec->catfile( $home, 'MANIFEST' ); my $tmp_home = Cwd::realpath( File::Spec->catdir( $home, '..' ) ); last if !$tmp_home || $counter++ == 5; $home = $tmp_home; } return $HOME if $HOME; return $home; } sub _manifest_files { my ($home, $manifest) = @_; my @files = _read_file( $manifest ); for my $tfile ( @files ) { $tfile = ( split /\s{2,}/, $tfile, 2 )[0]; next if !-e $home . '/' . $tfile; $tfile = File::Spec->rel2abs($home . '/' . $tfile); } return @files; } sub ok_manifest { my ($hashref,$msg) = _validate_args( @_ ); $test->plan(tests => 1) if !$plan; my $home = _find_home( $hashref ); my $manifest = File::Spec->catfile( $home, 'MANIFEST' ); if ( !-f $manifest ) { $test->BAILOUT( 'Cannot find a MANIFEST. Please check!' ); } my @files = _manifest_files( $home, $manifest ); if ( !@files ) { $test->diag( "No files in MANIFEST found (is it readable?)" ); return; } my $skip_path = File::Spec->catfile( $home, 'MANIFEST.SKIP' ); my @skip_files = _read_file( $skip_path ); my @skip_rx = map{ qr/$_/ }@skip_files; my $excluded = _check_excludes( $hashref, $home ); my (@dir_files, %excluded); find({ no_chdir => 1, follow => 0, wanted => sub { my $file = $File::Find::name; return if !-f $file; my $is_excluded = _is_excluded( $file, $excluded, $hashref->{filter}, $hashref->{bool}, \@skip_rx, $home, ); my $abs = File::Spec->rel2abs($file); $is_excluded ? ( $excluded{$abs} = 1 ) : ( push @dir_files, $abs ); } },$home); my $success = _check_manifest( \@dir_files, \@files, \%excluded, $msg, $manifest ); return $success; } sub _check_manifest { my ($existing_files, $manifest_files, $excluded, $msg, $manifest) = @_; my @existing = @{ $existing_files || [] }; my @manifest = @{ $manifest_files || [] }; my $bool = 1; my %files_hash; @files_hash{@manifest} = (); my %missing_files; SFILE: for my $file ( @existing ) { for my $check ( @manifest ) { if ( $file eq $check ) { delete $files_hash{$check}; next SFILE; } } $missing_files{$file} = 1; } my @dup_files = (); my @files_plus = (); delete @files_hash{ keys %{$excluded || {}} }; delete @missing_files{ keys %{$excluded || {}} }; @files_plus = sort keys %files_hash; $bool = 0 if scalar @files_plus > 0; $bool = 0 if %missing_files; my %seen_files = (); @dup_files = map { $seen_files{$_}++ ? $_ : () } @manifest; $bool = 0 if scalar @dup_files > 0; my $diag = 'The following files are not named in the MANIFEST file: '. join(', ', sort keys %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); my $success; if ( !$ENV{NO_MANIFEST_CHECK} ) { $success = $test->is_num($bool,$test_bool,$msg); } else { $success = $bool == $test_bool; } $test->diag($diag) if keys %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; $test->diag( "MANIFEST: $manifest" ) if !$success; return $success; } sub _read_file { my ($path) = @_; return if !-r $path; my @files; open my $fh, '<', $path; while( my $fh_line = <$fh> ){ chomp $fh_line; next if $fh_line =~ m{ \A \s* \# }x; my ($file); if ( ($file) = $fh_line =~ /^'(\\[\\']|.+)+'\s*/) { $file =~ s/\\([\\'])/$1/g; } else { ($file) = $fh_line =~ /^(\S+)\s*/; } next unless $file; push @files, $file; } close $fh; chomp @files; { local $/ = "\r"; chomp @files; } 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) = @_; $home = '' if !defined $home; return 0 if $files_in_skip and 'ARRAY' ne ref $files_in_skip; if ( $files_in_skip ) { # $home is usually given without trailing slash, # the $files_in_skip is taken from MANIFEST.SKIP which usually contain regexes # for files relative the $home. Therefore the remaining leading slashes in $localfile my $separator = $^O eq 'MSWin32' ? '[/\\\\]' : '/'; (my $local_file = $file) =~ s{\Q$home\E$separator*}{}; for my $rx ( @{$files_in_skip} ) { return 1 if $local_file =~ $rx; } } my $basename = basename $file; my @matches = grep{ $basename eq $_ }@excluded_files; return 1 if @matches; my $is_in_dir = _is_in_dir( $file, $dirref ); $bool ||= 'or'; if ( $bool eq 'or' ) { push @matches, $file if grep{ $file =~ /$_/ }@$filter; push @matches, $file if $is_in_dir; } else{ if( grep{ $file =~ /$_/ }@$filter and $is_in_dir ) { push @matches, $file; } } return scalar @matches; } sub _is_in_dir { my ($file, $excludes) = @_; return if !defined $file; return if !length $file; my (undef, $path) = File::Spec->splitpath( $file ); my @file_parts = File::Spec->splitdir( $path ); my $is_in_dir; EXCLUDE: for my $exclude ( @{ $excludes || [] } ) { next EXCLUDE if !defined $exclude; next EXCLUDE if !length $exclude; my (undef, $exclude_dir, $efile) = File::Spec->splitpath( $exclude ); my @exclude_parts = File::Spec->splitdir( $exclude_dir . $efile ); pop @exclude_parts if $exclude_parts[-1] eq ''; next EXCLUDE if @exclude_parts > @file_parts; my @subparts = @file_parts[ 0 .. $#exclude_parts ]; my $exclude_join = join '/', @exclude_parts; my $sub_join = join '/', @subparts; next EXCLUDE if $exclude_join ne $sub_join; $is_in_dir = 1; last EXCLUDE; } return $is_in_dir; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test::CheckManifest - Check if your Manifest matches your distro =head1 VERSION version 1.43 =head1 SYNOPSIS use Test::CheckManifest; ok_manifest(); =head2 EXPORT There is only one method exported: C =head1 METHODS =head2 ok_manifest [{exclude => $arref}][$msg] checks whether the Manifest file matches the distro or not. To match a distro the Manifest has to name all files that come along with the distribution. To check the Manifest file, this module searches for a file named C. To exclude some directories from this test, you can specify these dirs in the hashref. ok_manifest({exclude => ['/var/test/']}); is ok if the files in C are not named in the C file. That means that the paths in the exclude array must be "pseudo-absolute" (absolute to your distribution). To use a "filter" you can use the key "filter" ok_manifest({filter => [qr/\.svn/]}); With that you can exclude all files with an '.svn' in the filename or in the path from the test. These files would be excluded (as examples): =over 4 =item * /dist/var/.svn/test =item * /dist/lib/test.svn =back You can also combine "filter" and "exclude" with 'and' or 'or' default is 'or': ok_manifest({exclude => ['/var/test'], filter => [qr/\.svn/], bool => 'and'}); These files have to be named in the C: =over 4 =item * /var/foo/.svn/any.file =item * /dist/t/file.svn =item * /var/test/test.txt =back These files not: =over 4 =item * /var/test/.svn/* =item * /var/test/file.svn =back By default, C will look for the file C in the current working directory (which is how tests are traditionally run). If you wish to specify a different directory, you may pass the C or C parameters, for example: ok_manifest({dir => '/path/to/my/dist/'}); =head1 EXCLUDING FILES Beside C and C there is another way to exclude files: C. This is a file with filenames that should be excluded: t/my_very_own.t file_to.skip =head1 REPLACE THIS MODULE You can replace the test scripts using C with this one using L. use Test::More tests => 2; use ExtUtils::Manifest; is_deeply [ ExtUtils::Manifest::manicheck() ], [], 'missing'; is_deeply [ ExtUtils::Manifest::filecheck() ], [], 'extra'; (L). =head1 ACKNOWLEDGEMENT Great thanks to Christopher H. Laco, who did a lot of testing stuff for me and he reported some bugs to RT. =head1 AUTHOR Renee Baecker =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2018 by Renee Baecker. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) =cut