Merge pull request #4 from guillaumeaubert/master

Account for modules in the no_index section of META.yml

dist.ini

@@ -45,3 +45,6 @@ version = 0.77
 Test::Builder::Tester = 0
 ; Core from v5.8.9
 Module::CoreList = 0
+
+[MetaNoIndex]
+directory = t/08-_get_packages_not_indexed

lib/Test/Kwalitee/Extra.pm

@@ -9,11 +9,15 @@ use warnings;
 use version 0.77;
 use Cwd;
 use Carp;
+use File::Find;
+use File::Spec;
 use Test::Builder;
 use MetaCPAN::API::Tiny;
 use Module::CPANTS::Analyse;
 use Module::CPANTS::Kwalitee::Prereq;
 use Module::CoreList;
+use Module::Extract::Namespaces;
+
 
 sub _init
 {
@@ -109,9 +113,19 @@ sub _do_test_pmu
 		$prereq{$result->{distribution}} = 1 if $val->{is_prereq} || $val->{is_optional_prereq};
 		$build_prereq{$result->{distribution}} = 1 if $val->{is_prereq} || $val->{is_build_prereq} || $val->{is_optional_prereq};
 	}
+
+	# Look at META.yml to determine if the author specified modules provided
+	# by the distribution that should not be indexed by CPAN.
+	my $packages_not_indexed = _get_packages_not_indexed(
+		d       => $analyser->d,
+		distdir => $analyser->distdir,
+	);
+
 	my (@missing, @bmissing);
 	while(my ($key, $val) = each %{$analyser->d->{uses}}) {
 		next if version::is_lax($key);
+		# Skip packages provided by the distribution but not indexed by CPAN.
+		next if scalar( grep {$key eq $_} @$packages_not_indexed ) != 0;
 		next if _is_core($key, $minperlver);
 		my $result = $mcpan->module($key);
 		croak 'Query to MetaCPAN failed for $val->{requires}' if ! exists $result->{distribution};
@@ -128,6 +142,78 @@ sub _do_test_pmu
 	return @ret;
 }
 
+# Look at META.yml to determine if the author specified modules provided
+# by the distribution that should not be indexed by CPAN.
+sub _get_packages_not_indexed
+{
+	my (%args) = @_;
+	my $d = delete $args{'d'};
+	my $distdir = delete $args{'distdir'};
+
+	# Check if no_index exists in META.yml
+	my $meta_yml = $d->{'meta_yml'};
+	return [] if !defined $meta_yml;
+	my $no_index = $meta_yml->{'no_index'};
+	return [] if !defined $no_index;
+
+	# Get the uses, to determine which ones are no-index internals.
+	my $uses = $d->{'uses'};
+	return [] if !defined $uses;
+
+	my $packages_not_indexed = {};
+
+	# Find all the files corresponding to the 'file' and 'directory'
+	# sections of 'no_index'.
+	my @files = ();
+
+	if (defined $no_index->{'file'}) {
+		push @files, map { File::Spec->catdir($distdir, $_) } @{$no_index->{'file'}};
+	}
+
+	if (defined $no_index->{'directory'}) {
+		my $filter_pm_files = sub {
+			return if $File::Find::name !~ /\.pm$/;
+			push(@files, $File::Find::name);
+		};
+
+		foreach my $directory (@{$no_index->{'directory'}}) {
+			File::Find::find(
+				$filter_pm_files,
+				File::Spec->catdir($distdir, $directory),
+			);
+		}
+	}
+
+	# Extract the namespaces from those files.
+	foreach my $file (@files) {
+		my @namespaces = Module::Extract::Namespaces->from_file($file);
+		foreach my $namespace (@namespaces) {
+			next if !exists $uses->{$namespace};
+			$packages_not_indexed->{$namespace} = undef;
+		}
+	}
+
+	# 'package' section of no_index.
+	if (defined $no_index->{'package'}) {
+		foreach my $package (@{$no_index->{'package'}}) {
+			next if !exists $uses->{$package};
+			$packages_not_indexed->{$package} = undef;
+		}
+	}
+
+	# 'namespace' section of no_index.
+	if (defined $no_index->{'namespace'}) {
+		foreach my $use (keys %$uses) {
+			foreach my $namespace (@{$no_index->{'namespace'}}) {
+				next if $use !~ /^\Q$namespace\E(?:::|$)/;
+				$packages_not_indexed->{$use} = undef;
+			}
+		}
+	}
+
+	return [sort keys %$packages_not_indexed];
+}
+
 sub _do_test
 {
 	local $Test::Builder::Level = $Test::Builder::Level + 1;

t/08-_get_packages_not_indexed.t

@@ -0,0 +1,121 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Kwalitee::Extra qw();
+
+
+# List of tests to run.
+my $tests =
+[
+	{
+		name     => '"file" section.',
+		distdir  => 't/08-_get_packages_not_indexed/',
+		no_index => {
+			'file' =>
+			[
+				'LocalTest.pm'
+			]
+		},
+		expected =>
+		[
+			'LocalTest',
+		]
+	},
+	{
+		name     => '"directory" section.',
+		distdir  => 't/08-_get_packages_not_indexed/',
+		no_index =>
+		{
+			'directory' =>
+			[
+				'LocalTest'
+			]
+		},
+		expected =>
+		[
+			'LocalTest::Test',
+		]
+	},
+	{
+		name     => '"package" section.',
+		distdir  => 't/08-_get_packages_not_indexed/',
+		no_index =>
+		{
+			'package' =>
+			[
+				'LocalTest'
+			]
+		},
+		expected =>
+		[
+			'LocalTest',
+		]
+	},
+	{
+		name     => '"namespace" section.',
+		distdir  => 't/08-_get_packages_not_indexed/',
+		no_index =>
+		{
+			'namespace' =>
+			[
+				'LocalTest',
+			]
+		},
+		expected =>
+		[
+			'LocalTest',
+			'LocalTest::Test',
+		]
+	},
+];
+
+plan(tests => scalar(@$tests)+1);
+
+use_ok('Module::CPANTS::Analyse');
+
+foreach my $test (@$tests) {
+	# Prepare the Module::CPANTS::Analyse with the specific no_index information
+	# for this test.
+	my $d = bless(
+		{
+			'meta_yml' =>
+			{
+				'no_index' => $test->{'no_index'},
+			},
+			'uses' =>
+			{
+				'File::Spec' => {
+					'in_code' => 1,
+					'in_tests' => 0,
+					'module' => 'File::Spec'
+				},
+				'LocalTest' => {
+					'in_code' => 0,
+					'in_tests' => 1,
+					'module' => 'LocalTest'
+				},
+				'LocalTest::Test' => {
+					'in_code' => 0,
+					'in_tests' => 1,
+					'module' => 'LocalTest::Test'
+				},
+			},
+		},
+		'Module::CPANTS::Analyse',
+	);
+
+	# Retrieve a list of packages used by the distribution but not indexed
+	# according to META.yml.
+	my $packages_not_indexed = Test::Kwalitee::Extra::_get_packages_not_indexed(
+		d       => $d,
+		distdir => $test->{'distdir'},
+	);
+
+	# Make sure the function identified the packages not indexed correctly.
+	is_deeply(
+		$packages_not_indexed,
+		$test->{'expected'},
+		$test->{'name'},
+	) || diag(explain('Expected: ', $test->{'expected'}, 'Found: ', $packages_not_indexed));
+}

t/08-_get_packages_not_indexed/LocalTest.pm

@@ -0,0 +1,3 @@
+package LocalTest;
+
+1;

t/08-_get_packages_not_indexed/LocalTest/Test.pm

@@ -0,0 +1,3 @@
+package LocalTest::Test;
+
+1;