File Coverage

blib/lib/Test/DistManifest.pm

Criterion	Covered	Total	%
statement	97	107	90.6
branch	22	26	84.6
condition	15	15	100.0
subroutine	14	14	100.0
pod	1	1	100.0
total	149	163	91.4

package Test::DistManifest;
{
  $Test::DistManifest::VERSION = '1.012';
}
# ABSTRACT: Author test that validates a package MANIFEST

use strict;
use warnings;
use Carp ();
use ExtUtils::Manifest;


# File management commands
use Cwd ();
use File::Spec; # Portability
use File::Spec::Unix; # To get UNIX-style paths
use File::Find (); # Traverse the filesystem tree

use Module::Manifest;
use Test::Builder;

my $test = Test::Builder->new;

my @EXPORTS = (
  'manifest_ok',
);

# These platforms were copied from File::Spec
my %platforms = (
  MacOS   => 1,
  MSWin32 => 1,
  os2     => 1,
  VMS     => 1,
  epoc    => 1,
  NetWare => 1,
  symbian => 1,
  dos     => 1,
  cygwin  => 1,
);

# Looking at other Test modules this seems to be an ad-hoc standard
sub import {
  my ($self, @plan) = @_;
  my $caller = caller;

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

  $test->exported_to($caller);
  $test->plan(@plan);
  return;
}


sub manifest_ok {
  my $warn_only = $ENV{MANIFEST_WARN_ONLY} || 0;

  my $manifile = shift || 'MANIFEST';
  my $skipfile = shift || 'MANIFEST.SKIP';

  my $root = Cwd::getcwd(); # this is Build.PL's Cwd
  my $manifest = Module::Manifest->new;

  unless ($test->has_plan) {
    $test->plan(tests => 4);
  }

  # Try to parse the MANIFEST and MANIFEST.SKIP files
  eval {
    $manifest->open(manifest => $manifile);
  };
  if ($@) {
    $test->diag($!);
  }
  $test->ok(!$@, 'Parse MANIFEST or equivalent');

  eval {
    $manifest->open(skip => $skipfile);
  };
  if ($@) {
    $test->diag('Unable to parse MANIFEST.SKIP file:');
    $test->diag($!);
    $test->diag('Using default skip data from ExtUtils::Manifest ' . ExtUtils::Manifest->VERSION);

    open my $fh, '<', $ExtUtils::Manifest::DEFAULT_MSKIP
        or die "Cannot open $ExtUtils::Manifest::DEFAULT_MSKIP: $!";
    chomp(my @manifest_content = <$fh>);
    $manifest->parse( skip => \@manifest_content );
  }

  my @files;
  # Callback function called by File::Find
  my $closure = sub {
    # Trim off the package root to determine the relative path.
    my $path = File::Spec->abs2rel($File::Find::name, $root);

    # Portably deal with different OSes
    if ($platforms{$^O}) { # Check if we are on a non-Unix platform
      # Get path info from File::Spec, split apart
      my (undef, $dir, $file) = File::Spec->splitpath($path);
      my @dir = File::Spec->splitdir($dir);

      # Reconstruct the path in Unix-style
      $dir = File::Spec::Unix->catdir(@dir);
      $path = File::Spec::Unix->catpath(undef, $dir, $file);
    }

    # Test that the path is a file and then make sure it's not skipped
    if (-f $path && !$manifest->skipped($path)) {
      push @files, $path;
    }
    return;
  };

  # Traverse the directory recursively
  File::Find::find({
    wanted            => $closure,
    untaint           => 1,
    no_chdir          => 1,
  }, $root);

  # The two arrays have no duplicates. Thus we loop through them and
  # add the result to a hash.
  my %seen;
  # Allocate buckets for the hash
  keys(%seen) = 2 * scalar(@files);
  foreach my $path (@files, $manifest->files) {
    $seen{$path}++;
  }

  my $flag = 1;
  foreach my $path (@files) {
    # Skip the path if it was seen twice (the expected condition)
    next if ($seen{$path} == 2);

    # Oh no, we have files in @files not in $manifest->files
    if ($flag == 1) {
      $test->diag('Distribution files are missing in MANIFEST:');
      $flag = 0;
    }
    $test->diag($path);
  }
  $test->ok($warn_only || $flag, 'All files are listed in MANIFEST or ' .
    'skipped');

  # Reset the flag and test $manifest->files now
  $flag = 1;
  my @circular = (); # for detecting circular logic
  foreach my $path ($manifest->files) {
    # Skip the path if it was seen twice (the expected condition)
    next if ($seen{$path} == 2);

    # If the file should exist but is passed by MANIFEST.SKIP, we have
    # a strange circular logic condition.
    if ($manifest->skipped($path)) {
      push (@circular, $path);
      next;
    }

    # Oh no, we have files in $manifest->files not in @files
    if ($flag == 1) {
      $test->diag('MANIFEST lists the following missing files:');
      $flag = 0;
    }
    $test->diag($path);
  }
  $test->ok($warn_only || $flag, 'All files listed in MANIFEST exist ' .
    'on disk');

  # Test for circular dependencies
  $flag = (scalar @circular == 0) ? 1 : 0;
  if (not $flag) {
    $test->diag('MANIFEST and MANIFEST.SKIP have circular dependencies:');
    foreach my $path (@circular) {
      $test->diag($path);
    }
  }
  $test->ok($flag, 'No files are in both MANIFEST and MANIFEST.SKIP');

  return;
}


1;

__END__