Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Account for modules in the no_index section of META.yml #4

Merged
merged 3 commits into from
Apr 29, 2013
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions dist.ini
Original file line number Diff line number Diff line change
Expand Up @@ -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
86 changes: 86 additions & 0 deletions lib/Test/Kwalitee/Extra.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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
{
Expand Down Expand Up @@ -112,9 +116,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};
Expand All @@ -131,6 +145,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;
Expand Down
121 changes: 121 additions & 0 deletions t/08-_get_packages_not_indexed.t
Original file line number Diff line number Diff line change
@@ -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));
}
3 changes: 3 additions & 0 deletions t/08-_get_packages_not_indexed/LocalTest.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
package LocalTest;

1;
3 changes: 3 additions & 0 deletions t/08-_get_packages_not_indexed/LocalTest/Test.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
package LocalTest::Test;

1;