File Coverage

blib/lib/Test/DistManifest.pm

Criterion	Covered	Total	%
statement	100	104	96.1
branch	24	26	92.3
condition	15	15	100.0
subroutine	13	13	100.0
pod	1	1	100.0
total	153	159	96.2

package Test::DistManifest; # git description: v1.013-7-g5a494e0
# ABSTRACT: Author test that validates a package MANIFEST
# KEYWORDS: test distribution manifest files upload contents author

our $VERSION = '1.014';

use strict;
use warnings;
use ExtUtils::Manifest;

#pod =head1 EXPORTS
#pod
#pod By default, this module exports the following functions:
#pod
#pod =over
#pod
#pod =item * manifest_ok
#pod
#pod =back
#pod
#pod =cut

# 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 0.07;
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;
}

#pod =head1 DESCRIPTION
#pod
#pod This module provides a simple method of testing that a MANIFEST matches the
#pod distribution.
#pod
#pod It tests three things:
#pod
#pod =for stopwords unsatisfiable
#pod
#pod =over
#pod
#pod =item 1
#pod
#pod Everything in B exists
#pod
#pod =item 2
#pod
#pod Everything in the package is listed in B, or subsequently matches
#pod a regular expression mask in B
#pod
#pod =item 3
#pod
#pod Nothing exists in B that also matches a mask in B,
#pod so as to avoid an unsatisfiable dependency conditions
#pod
#pod =back
#pod
#pod If there is no B included in your distribution, this module
#pod will replicate the toolchain behaviour of using the default system-wide
#pod MANIFEST.SKIP file. To view the contents of this file, use the command:
#pod
#pod   $ perldoc -m ExtUtils::MANIFEST.SKIP
#pod
#pod =head1 SYNOPSIS
#pod
#pod This is the common idiom for author test modules like this, but see
#pod the full example in examples/checkmanifest.t and, more importantly,
#pod Adam Kennedy's article: L
#pod
#pod   use Test::More;
#pod   eval 'use Test::DistManifest';
#pod   if ($@) {
#pod     plan skip_all => 'Test::DistManifest required to test MANIFEST';
#pod   }
#pod
#pod   manifest_ok('MANIFEST', 'MANIFEST.SKIP'); # Default options
#pod
#pod   manifest_ok(); # Functionally equivalent to above
#pod
#pod =head1 FUNCTIONS
#pod
#pod =head2 manifest_ok
#pod
#pod   manifest_ok( $manifest, $skipfile )
#pod
#pod This subroutine checks the manifest list contained in C<$manifest> by using
#pod C to determine the list of files and then checking for the
#pod existence of all such files. Then, it checks if there are any files in the
#pod distribution that were not specified in the C<$manifest> file but do not match
#pod any regular expressions provided in the C<$skipfile> exclusion file.
#pod
#pod If your MANIFEST file is generated by a module installation toolchain system
#pod such as L, L or L, then
#pod you shouldn't have any problems with these files. It's just a helpful test
#pod to remind you to update these files, using:
#pod
#pod   $ make manifest # For ExtUtils::MakeMaker
#pod   $ ./Build manifest # For Module::Build
#pod
#pod =head1 NON-FATAL ERRORS
#pod
#pod By default, errors in the B or B files are treated
#pod as fatal, which really is the purpose of using C as part
#pod of your author test suite.
#pod
#pod In some cases this is not desirable behaviour, such as with the Debian Perl
#pod Group, which runs all tests - including author tests - as part of its module
#pod packaging process. This wreaks havoc because Debian adds its control files
#pod in C downstream, and that directory or its files are generally not
#pod in B.
#pod
#pod By setting the environment variable B to a true value,
#pod errors will be non-fatal - they show up as diagnostic messages only, but all
#pod tests pass from the perspective of C.
#pod
#pod This can be used in a test script as:
#pod
#pod   $ENV{MANIFEST_WARN_ONLY} = 1;
#pod
#pod or from other shell scripts as:
#pod
#pod   export MANIFEST_WARN_ONLY=1
#pod
#pod Note that parsing errors in B and circular dependencies will
#pod always be considered fatal. The author is not aware of any cases where
#pod other behaviour would be useful.
#pod
#pod =cut

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;
}

#pod =head1 GUTS
#pod
#pod This module internally plans four tests:
#pod
#pod =over
#pod
#pod =item 1
#pod
#pod B can be parsed by C
#pod
#pod =item 2
#pod
#pod Check which files exist in the distribution directory that do not match an
#pod existing regular expression in B and not listed in the
#pod B file. These files should either be excluded from the test by
#pod addition of a mask in MANIFEST.SKIP (in the case of temporary development
#pod or test files) or should be included in the MANIFEST.
#pod
#pod =item 3
#pod
#pod Check which files are specified in B but do not exist on the disk.
#pod This usually occurs when one deletes a test or similar script from the
#pod distribution, or accidentally moves it.
#pod
#pod =item 4
#pod
#pod Check which files are specified in both B and B.
#pod This is clearly an unsatisfiable condition, since the file in question
#pod cannot be expected to be included while also simultaneously ignored.
#pod
#pod =back
#pod
#pod If you want to run tests on multiple different MANIFEST files, you can
#pod simply pass 'no_plan' to the import function, like so:
#pod
#pod   use Test::DistManifest 'no_plan';
#pod
#pod   # Multiple tests work properly now
#pod   manifest_ok('MANIFEST', 'MANIFEST.SKIP');
#pod   manifest_ok();
#pod   manifest_ok('MANIFEST.OTHER', 'MANIFEST.SKIP');
#pod
#pod I doubt this will be useful to users of this module. However, this is used
#pod internally for testing and it might be helpful to you. You can also plan
#pod more tests, but keep in mind that the idea of "3 internal tests" may change
#pod in the future.
#pod
#pod Example code:
#pod
#pod   use Test::DistManifest tests => 5;
#pod   manifest_ok(); # 4 tests
#pod   ok(1, 'is 1 true?');
#pod
#pod =head1 ACKNOWLEDGEMENTS
#pod
#pod =over
#pod
#pod =item *
#pod
#pod Thanks to Adam Kennedy for developing L, which provides
#pod much of the core functionality for these tests.
#pod
#pod =item *
#pod
#pod Thanks to Apocalypse [e-mail], for helping me track down
#pod an obscure bug caused by circular dependencies: when files are expected by
#pod MANIFEST but explicitly skipped by MANIFEST.SKIP.
#pod
#pod =back
#pod
#pod =head1 SEE ALSO
#pod
#pod =over
#pod
#pod =item *
#pod L, a module providing similar functionality
#pod
#pod =item *
#pod L
#pod
#pod =item *
#pod L
#pod
#pod =item *
#pod L
#pod
#pod =back
#pod
#pod =head1 CAVEATS
#pod
#pod =over
#pod
#pod =item *
#pod
#pod There is currently no way to test a MANIFEST/MANIFEST.SKIP without having the
#pod files actually exist on disk. I am planning for this to change in the future.
#pod
#pod =item *
#pod
#pod This module has not been tested very thoroughly with Unicode.
#pod
#pod =item *
#pod
#pod This module does not produce any useful diagnostic messages in terms of how
#pod to correct the situation. Hopefully this will be obvious for anybody using
#pod the module; the emphasis should be on generating helpful error messages.
#pod
#pod =back
#pod
#pod =cut

1;

__END__