package Module::CPANTS::Kwalitee::Uses;
use warnings;
use strict;
use File::Spec::Functions qw(catfile);
use Module::ExtractUse;
use Set::Scalar qw();
use Data::Dumper;
use version;
our $VERSION = '0.91';
sub order { 100 }
##################################################################
# Analyse
##################################################################
sub analyse {
my $class=shift;
my $me=shift;
my $distdir=$me->distdir;
my $modules=$me->d->{modules};
my $files=$me->d->{files_array};
# NOTE: all files in xt/ should be ignored because they are
# for authors only and their dependencies may not be (and
# often are not) listed in meta files.
my @tests=grep {m|^t\b.*\.t|} @$files;
$me->d->{test_files} = \@tests;
my @test_modules = map { my $m = $_; $m =~ s|/|::|g; $m =~ s|\.pm$||; $m } grep {m|^t\b.*\.pm$|} @$files;
my %skip=map {$_->{module}=>1 } @$modules;
my %uses;
# used in modules
foreach (@$modules) {
my $p = Module::ExtractUse->new;
my $file = catfile($distdir,$_->{file});
$p->extract_use($file) if -f $file;
$_->{uses} = $p->used;
while (my ($mod,$cnt)=each%{$p->used}) {
next if $skip{$mod};
next if $mod =~ /::$/; # see RT#35092
$uses{$mod}{module} = $mod;
$uses{$mod}{in_code} += $cnt;
$uses{$mod}{evals_in_code} += $p->used_in_eval($mod) || 0;
}
}
# used in tests
foreach my $tf (@tests) {
my $pt=Module::ExtractUse->new;
my $file = catfile($distdir,$tf);
$pt->extract_use($file) if -f $file && -s $file < 1_000_000; # skip very large test files
while (my ($mod,$cnt)=each%{$pt->used}) {
next if $skip{$mod};
if (@test_modules) {
next if grep {/(?:^|::)$mod$/} @test_modules;
}
$uses{$mod}{module} = $mod;
$uses{$mod}{in_tests} += $cnt;
$uses{$mod}{evals_in_tests} += $pt->used_in_eval($mod) || 0;
}
}
# used in Makefile.PL/Build.PL
foreach my $f (grep /\b(?:Makefile|Build)\.PL$/, @{$me->d->{files_array} || []}) {
my $p = Module::ExtractUse->new;
my $file = catfile($distdir,$f);
$p->extract_use($file) if -f $file;
while (my ($mod,$cnt)=each%{$p->used}) {
next if $skip{$mod};
next if $mod =~ /::$/; # see RT#35092
$uses{$mod}{module} = $mod;
$uses{$mod}{in_config} += $cnt;
$uses{$mod}{evals_in_config} += $p->used_in_eval($mod) || 0;
}
}
$me->d->{uses}=\%uses;
return;
}
##################################################################
# Kwalitee Indicators
##################################################################
sub kwalitee_indicators {
return [
{
name=>'use_strict',
error=>q{This distribution does not 'use strict;' in all of its modules.},
remedy=>q{Add 'use strict' to all modules.},
code=>sub {
my $d = shift;
my $modules = $d->{modules};
my $uses = $d->{uses};
return 0 unless $modules && $uses;
# There are lots of acceptable strict alternatives
my $strict_equivalents = Set::Scalar->new->insert(qw(
strict
Any::Moose
Class::Spiffy
Coat
common::sense
Dancer
Mo
Modern::Perl
Mojo::Base
Moo
Moo::Role
Moose
Moose::Role
Moose::Exporter
MooseX::Declare
MooseX::Role::Parameterized
MooseX::Types
Mouse
Mouse::Role
perl5
perl5i::1
perl5i::2
perl5i::latest
Spiffy
strictures
));
my $perl_version_with_implicit_stricture = version->new('5.011');
my @no_strict;
for my $module (@{ $modules }) {
next if grep {/^5\./ && version->parse($_) >= $perl_version_with_implicit_stricture} keys %{$module->{uses}};
push @no_strict, $module->{module} if $strict_equivalents
->intersection(Set::Scalar->new(keys %{ $module->{uses} }))
->is_empty;
}
if (@no_strict) {
$d->{error}{use_strict} = join ", ", @no_strict;
return 0;
}
return 1;
},
details=>sub {
my $d = shift;
return "The following modules don't use strict (or equivalents): " . $d->{error}{use_strict};
},
},
{
name=>'use_warnings',
error=>q{This distribution does not 'use warnings;' in all of its modules.},
is_extra=>1,
remedy=>q{Add 'use warnings' to all modules. (This will require perl > 5.6)},
code=>sub {
my $d = shift;
my $modules = $d->{modules};
my $uses = $d->{uses};
return 0 unless $modules && $uses;
my $warnings_equivalents = Set::Scalar->new->insert(qw(
warnings
Any::Moose
Class::Spiffy
Coat
common::sense
Dancer
Mo
Modern::Perl
Mojo::Base
Moo
Moo::Role
Moose
Moose::Role
Moose::Exporter
MooseX::Declare
MooseX::Types
Mouse
Mouse::Role
perl5
perl5i::1
perl5i::2
perl5i::latest
Spiffy
strictures
));
my @no_warnings;
for my $module (@{ $modules }) {
push @no_warnings, $module->{module} if $warnings_equivalents
->intersection(Set::Scalar->new(keys %{ $module->{uses} }))
->is_empty;
}
if (@no_warnings) {
$d->{error}{use_warnings} = join ", ", @no_warnings;
return 0;
}
return 1;
},
details=>sub {
my $d = shift;
return "The following modules don't use warnings (or equivalents): " . $d->{error}{use_warnings};
},
},
];
}
q{Favourite record of the moment:
Fat Freddys Drop: Based on a true story};
__END__
=encoding UTF-8
=head1 NAME
Module::CPANTS::Kwalitee::Uses - Checks which modules are used
=head1 SYNOPSIS
Check which modules are actually used in the code.
=head1 DESCRIPTION
=head2 Methods
=head3 order
Defines the order in which Kwalitee tests should be run.
Returns C<100>.
=head3 analyse
C<MCK::Uses> uses C<Module::ExtractUse> to find all C<use> statements in code (actual code and tests).
=head3 kwalitee_indicators
Returns the Kwalitee Indicators datastructure.
=over
=item * use_strict
=item * use_warnings
=back
=head1 SEE ALSO
L<Module::CPANTS::Analyse>
=head1 AUTHOR
L<Thomas Klausner|https://metacpan.org/author/domm>
=head1 COPYRIGHT AND LICENSE
Copyright © 2003–2006, 2009 L<Thomas Klausner|https://metacpan.org/author/domm>
You may use and distribute this module according to the same terms
that Perl is distributed under.