Initial Commit
This commit is contained in:
Riley Schneider
303
database/perl/lib/Module/CPANTS/Analyse.pm
Normal file
303
database/perl/lib/Module/CPANTS/Analyse.pm
Normal file
@@ -0,0 +1,303 @@
|
||||
package Module::CPANTS::Analyse;
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Class::Accessor::Fast);
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Spec::Functions qw(catfile catdir splitpath);
|
||||
use File::Copy;
|
||||
use File::stat;
|
||||
use Archive::Any::Lite;
|
||||
use Carp;
|
||||
use CPAN::DistnameInfo;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
__PACKAGE__->mk_accessors(qw(dist opts tarball distdir d mck));
|
||||
__PACKAGE__->mk_accessors(qw(_testdir _dont_cleanup _tarball _x_opts));
|
||||
|
||||
sub import {
|
||||
my $class = shift;
|
||||
require Module::CPANTS::Kwalitee;
|
||||
Module::CPANTS::Kwalitee->import(@_);
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $opts = shift || {};
|
||||
$opts->{d} = {};
|
||||
$opts->{opts} ||= {};
|
||||
my $me = bless $opts, $class;
|
||||
Carp::croak("need a dist") if not defined $opts->{dist};
|
||||
|
||||
$me->mck(Module::CPANTS::Kwalitee->new);
|
||||
|
||||
# For Test::Kwalitee and friends
|
||||
$me->d->{is_local_distribution} = 1 if -d $opts->{dist};
|
||||
|
||||
return $me;
|
||||
}
|
||||
|
||||
sub run {
|
||||
my $me = shift;
|
||||
$me->unpack unless $me->d->{is_local_distribution};
|
||||
$me->analyse;
|
||||
$me->calc_kwalitee;
|
||||
$me->d;
|
||||
}
|
||||
|
||||
sub unpack {
|
||||
my $me = shift;
|
||||
return 'cant find dist' unless $me->dist;
|
||||
|
||||
my $di = CPAN::DistnameInfo->new($me->dist);
|
||||
my $ext = $di->extension || 'unknown';
|
||||
|
||||
$me->d->{package} = $di->filename;
|
||||
$me->d->{vname} = $di->distvname;
|
||||
$me->d->{extension} = $ext;
|
||||
$me->d->{version} = $di->version;
|
||||
$me->d->{dist} = $di->dist;
|
||||
$me->d->{author} = $di->cpanid;
|
||||
$me->d->{released} = stat($me->dist)->mtime;
|
||||
$me->d->{size_packed} = -s $me->dist;
|
||||
|
||||
unless($me->d->{package}) {
|
||||
$me->d->{package} = $me->tarball;
|
||||
}
|
||||
|
||||
copy($me->dist, $me->testfile);
|
||||
|
||||
my @pax_headers;
|
||||
eval {
|
||||
my $archive = Archive::Any::Lite->new($me->testfile);
|
||||
$archive->extract($me->testdir, {tar_filter_cb => sub {
|
||||
my $entry = shift;
|
||||
if ($entry->name eq Archive::Tar::Constant::PAX_HEADER() or $entry->type eq 'x' or $entry->type eq 'g') {
|
||||
push @pax_headers, $entry->name;
|
||||
return;
|
||||
}
|
||||
return 1;
|
||||
}});
|
||||
};
|
||||
if (@pax_headers) {
|
||||
$me->d->{no_pax_headers} = 0;
|
||||
$me->d->{error}{no_pax_headers} = join ',', @pax_headers;
|
||||
} else {
|
||||
$me->d->{no_pax_headers} = 1;
|
||||
}
|
||||
|
||||
if (my $error = $@) {
|
||||
$me->d->{extractable} = 0;
|
||||
$me->d->{error}{extractable} = $error;
|
||||
$me->d->{kwalitee}{extractable} = 0;
|
||||
my ($vol, $dir, $name) = splitpath($me->dist);
|
||||
$name =~ s/\..*$//;
|
||||
$name =~ s/\-[\d\.]+$//;
|
||||
$name =~ s/\-TRIAL[0-9]*//;
|
||||
$me->d->{dist} = $name;
|
||||
return $error;
|
||||
}
|
||||
|
||||
$me->d->{extractable} = 1;
|
||||
unlink($me->testfile);
|
||||
|
||||
opendir(my $fh_testdir, $me->testdir) or die "Cannot open ".$me->testdir.": $!";
|
||||
my @stuff = grep {/\w/} readdir($fh_testdir);
|
||||
|
||||
if (@stuff == 1) {
|
||||
$me->distdir(catdir($me->testdir, $stuff[0]));
|
||||
if (-d $me->distdir) {
|
||||
|
||||
my $vname = $di->distvname;
|
||||
$vname =~ s/\-TRIAL[0-9]*//;
|
||||
|
||||
$me->d->{extracts_nicely} = 1;
|
||||
if ($vname ne $stuff[0]) {
|
||||
$me->d->{error}{extracts_nicely} = "expected $vname but got $stuff[0]";
|
||||
}
|
||||
} else {
|
||||
$me->distdir($me->testdir);
|
||||
$me->d->{extracts_nicely} = 0;
|
||||
$me->d->{error}{extracts_nicely} = join ",", @stuff;
|
||||
}
|
||||
} else {
|
||||
$me->distdir($me->testdir);
|
||||
$me->d->{extracts_nicely} = 0;
|
||||
$me->d->{error}{extracts_nicely} = join ",", @stuff;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub analyse {
|
||||
my $me = shift;
|
||||
|
||||
foreach my $mod (@{$me->mck->generators}) {
|
||||
$mod->analyse($me);
|
||||
}
|
||||
}
|
||||
|
||||
sub calc_kwalitee {
|
||||
my $me = shift;
|
||||
|
||||
my $kwalitee = 0;
|
||||
$me->d->{kwalitee} = {};
|
||||
my %x_ignore = %{$me->x_opts->{ignore} || {}};
|
||||
foreach my $i ($me->mck->get_indicators) {
|
||||
next if $i->{needs_db};
|
||||
my $rv = $i->{code}($me->d, $i);
|
||||
$me->d->{kwalitee}{$i->{name}} = $rv;
|
||||
if ($x_ignore{$i->{name}} && $i->{ignorable}) {
|
||||
$me->d->{kwalitee}{$i->{name}} = 1;
|
||||
if ($me->d->{error}{$i->{name}}) {
|
||||
$me->d->{error}{$i->{name}} .= ' [ignored]';
|
||||
}
|
||||
}
|
||||
$kwalitee += $rv;
|
||||
}
|
||||
|
||||
$me->d->{'kwalitee'}{'kwalitee'} = $kwalitee;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------
|
||||
# helper methods
|
||||
#----------------------------------------------------------------
|
||||
|
||||
sub testdir {
|
||||
my $me = shift;
|
||||
return $me->_testdir if $me->_testdir;
|
||||
if ($me->_dont_cleanup) {
|
||||
return $me->_testdir(tempdir());
|
||||
} else {
|
||||
return $me->_testdir(tempdir(CLEANUP => 1));
|
||||
}
|
||||
}
|
||||
|
||||
sub testfile {
|
||||
my $me = shift;
|
||||
return catfile($me->testdir, $me->tarball);
|
||||
}
|
||||
|
||||
sub tarball {
|
||||
my $me = shift;
|
||||
return $me->_tarball if $me->_tarball;
|
||||
my (undef, undef, $tb) = splitpath($me->dist);
|
||||
return $me->_tarball($tb);
|
||||
}
|
||||
|
||||
sub x_opts {
|
||||
my $me = shift;
|
||||
return $me->_x_opts if $me->_x_opts;
|
||||
my %opts;
|
||||
if (my $x_cpants = $me->d->{meta_yml}{x_cpants}) {
|
||||
if (my $ignore = $x_cpants->{ignore}) {
|
||||
if (ref $ignore eq ref {}) {
|
||||
$opts{ignore} = $ignore;
|
||||
}
|
||||
else {
|
||||
$me->d->{error}{x_cpants} = "x_cpants ignore should be a hash reference (key: metric, value: reason to ignore)";
|
||||
}
|
||||
}
|
||||
}
|
||||
$me->_x_opts(\%opts);
|
||||
}
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Jahcoozi: Pure Breed Mongrel};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Analyse - Generate Kwalitee ratings for a distribution
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Module::CPANTS::Analyse;
|
||||
|
||||
my $analyser = Module::CPANTS::Analyse->new({
|
||||
dist => 'path/to/Foo-Bar-1.42.tgz',
|
||||
});
|
||||
$analyser->run;
|
||||
# results are in $analyser->d;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 new
|
||||
|
||||
my $analyser = Module::CPANTS::Analyse->new({dist => 'path/to/file'});
|
||||
|
||||
Plain old constructor.
|
||||
|
||||
=head3 unpack
|
||||
|
||||
Unpack the distribution into a temporary directory.
|
||||
|
||||
Returns an error if something went wrong, C<undef> if all went well.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Run all analysers (defined in C<Module::CPANTS::Kwalitee::*> on the dist.
|
||||
|
||||
=head3 calc_kwalitee
|
||||
|
||||
Check if the dist conforms to the Kwalitee indicators.
|
||||
|
||||
=head3 run
|
||||
|
||||
Unpacks, analyses, and calculates kwalitee, and returns a resulting stash.
|
||||
|
||||
=head2 Helper Methods
|
||||
|
||||
=head3 testdir
|
||||
|
||||
Returns the path to the unique temp directory.
|
||||
|
||||
=head3 testfile
|
||||
|
||||
Returns the location of the unextracted tarball.
|
||||
|
||||
=head3 tarball
|
||||
|
||||
Returns the filename of the tarball.
|
||||
|
||||
=head3 x_opts
|
||||
|
||||
Returns a hash reference that holds normalized information set in the "x_cpants" custom META field.
|
||||
|
||||
=head1 WEBSITE
|
||||
|
||||
L<https://cpants.cpanauthors.org/>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Please report any bugs or feature requests, or send any patches, to
|
||||
C<bug-module-cpants-analyse at rt.cpan.org>, or through the web interface at
|
||||
L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Module-CPANTS-Analyse>.
|
||||
I will be notified, and then you'll automatically be notified of progress
|
||||
on your bug as I make changes.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Please use the C<perl-qa> mailing list for discussing all things CPANTS:
|
||||
L<https://lists.perl.org/list/perl-qa.html>
|
||||
|
||||
Based on work by L<Léon Brocard|https://metacpan.org/author/lbrocard> and the
|
||||
original idea proposed by
|
||||
L<Michael G. Schwern|https://metacpan.org/author/schwern>.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This code is Copyright © 2003–2006
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>.
|
||||
All rights reserved.
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
199
database/perl/lib/Module/CPANTS/Kwalitee.pm
Normal file
199
database/perl/lib/Module/CPANTS/Kwalitee.pm
Normal file
@@ -0,0 +1,199 @@
|
||||
package Module::CPANTS::Kwalitee;
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Class::Accessor::Fast);
|
||||
use Carp;
|
||||
use Module::Find qw(usesub);
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
__PACKAGE__->mk_accessors(qw(_available _total));
|
||||
|
||||
my @Plugins;
|
||||
my @SearchPaths = ('Module::CPANTS::Kwalitee');
|
||||
my @Indicators;
|
||||
my %IndicatorHash;
|
||||
my $Total;
|
||||
my $Available;
|
||||
|
||||
sub import {
|
||||
my ($class, @search_paths) = @_;
|
||||
for my $path (@search_paths) {
|
||||
next unless $path =~ /^[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*$/;
|
||||
push @SearchPaths, $path =~ /^Module::CPANTS::/ ? $path : "Module::CPANTS::$path";
|
||||
|
||||
my %seen;
|
||||
@SearchPaths = grep {!$seen{$_}++} @SearchPaths;
|
||||
}
|
||||
}
|
||||
|
||||
sub _load_plugins {
|
||||
my $class = shift;
|
||||
unless (@Plugins) {
|
||||
my %seen;
|
||||
@Plugins = sort {$a->order <=> $b->order or $a cmp $b}
|
||||
grep {!$seen{$_}++}
|
||||
map {usesub $_} @SearchPaths;
|
||||
$class->_cache_indicators;
|
||||
}
|
||||
}
|
||||
|
||||
# I suppose nobody wants to change the generators dynamically though
|
||||
sub _cache_indicators {
|
||||
my $class = shift;
|
||||
@Indicators = ();
|
||||
$Total = $Available = 0;
|
||||
for my $plugin (@Plugins) {
|
||||
for my $indicator (@{$plugin->kwalitee_indicators}) {
|
||||
$indicator->{defined_in} = $plugin;
|
||||
$indicator->{is_core} = 1 if !$indicator->{is_extra} and !$indicator->{is_experimental};
|
||||
push @Indicators, $indicator;
|
||||
$Total++ unless $indicator->{is_experimental};
|
||||
$Available++ if $indicator->{is_core};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub plugins { @Plugins }
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class->_load_plugins;
|
||||
bless {}, $class;
|
||||
}
|
||||
|
||||
sub generators {
|
||||
my $self = shift;
|
||||
return \@Plugins unless @_;
|
||||
@Plugins = @{$_[0]};
|
||||
$self->_cache_indicators;
|
||||
\@Plugins;
|
||||
}
|
||||
|
||||
sub get_indicators {
|
||||
my ($self, $type) = @_;
|
||||
unless ($type) { # almost always true
|
||||
return wantarray ? @Indicators : \@Indicators;
|
||||
}
|
||||
|
||||
$type = 'is_core' if $type eq 'core';
|
||||
$type = 'is_extra' if $type eq 'optional';
|
||||
$type = 'is_experimental' if $type eq 'experimental';
|
||||
|
||||
my @indicators;
|
||||
for my $indicator (@Indicators) {
|
||||
next if !$indicator->{$type};
|
||||
push @indicators, $indicator;
|
||||
}
|
||||
|
||||
return wantarray ? @indicators : \@indicators;
|
||||
}
|
||||
|
||||
sub get_indicators_hash {
|
||||
my $self = shift;
|
||||
return \%IndicatorHash if %IndicatorHash;
|
||||
|
||||
foreach my $ind (@Indicators) {
|
||||
$IndicatorHash{$ind->{name}} = $ind;
|
||||
}
|
||||
return \%IndicatorHash;
|
||||
}
|
||||
|
||||
sub available_kwalitee { $Available }
|
||||
|
||||
sub total_kwalitee { $Total }
|
||||
|
||||
sub _indicator_names {
|
||||
my ($self, $coderef) = @_;
|
||||
my @names = map { $_->{name} } grep {$coderef->($_)} $self->get_indicators;
|
||||
return wantarray ? @names : \@names;
|
||||
}
|
||||
|
||||
sub all_indicator_names { shift->_indicator_names(sub {1}) }
|
||||
|
||||
sub core_indicator_names {
|
||||
shift->_indicator_names(sub {$_->{is_core}});
|
||||
}
|
||||
|
||||
sub optional_indicator_names {
|
||||
shift->_indicator_names(sub {$_->{is_extra}});
|
||||
}
|
||||
|
||||
sub experimental_indicator_names {
|
||||
shift->_indicator_names(sub {$_->{is_experimental}});
|
||||
}
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Jahcoozi: Pure Breed Mongrel};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee - Interface to Kwalitee generators
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $mck = Module::CPANTS::Kwalitee->new;
|
||||
my @generators = $mck->generators;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 new
|
||||
|
||||
Plain old constructor.
|
||||
|
||||
Loads all Plugins.
|
||||
|
||||
=head3 get_indicators
|
||||
|
||||
Get the list of all Kwalitee indicators, either as an ARRAY or ARRAYREF.
|
||||
|
||||
=head3 get_indicators_hash
|
||||
|
||||
Get the list of all Kwalitee indicators as an HASHREF.
|
||||
|
||||
=head3 core_indicator_names
|
||||
|
||||
Get a list of core indicator names (NOT the whole indicator HASHREF).
|
||||
|
||||
=head3 optional_indicator_names
|
||||
|
||||
Get a list of optional indicator names (NOT the whole indicator HASHREF).
|
||||
|
||||
=head3 experimental_indicator_names
|
||||
|
||||
Get a list of experimental indicator names (NOT the whole indicator HASHREF).
|
||||
|
||||
=head3 all_indicator_names
|
||||
|
||||
Get a list of all indicator names (NOT the whole indicator HASHREF).
|
||||
|
||||
=head3 available_kwalitee
|
||||
|
||||
Get the number of available kwalitee points
|
||||
|
||||
=head3 total_kwalitee
|
||||
|
||||
Get the total number of kwalitee points. This is bigger the available_kwalitee as some kwalitee metrics are marked as 'extra' (e.g. C<is_prereq>).
|
||||
|
||||
=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.
|
||||
158
database/perl/lib/Module/CPANTS/Kwalitee/BrokenInstaller.pm
Normal file
158
database/perl/lib/Module/CPANTS/Kwalitee/BrokenInstaller.pm
Normal file
@@ -0,0 +1,158 @@
|
||||
package Module::CPANTS::Kwalitee::BrokenInstaller;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
my $distdir = $me->distdir;
|
||||
|
||||
# inc/Module/Install.pm file
|
||||
my $mi = catfile($distdir, 'inc', 'Module', 'Install.pm');
|
||||
|
||||
# Must be okay if not using Module::Install
|
||||
return if not -f $mi;
|
||||
|
||||
open my $ih, '<', $mi
|
||||
or die "Could not open file '$mi' for checking the bad_installer metric: $!";
|
||||
my $buf;
|
||||
read $ih, $buf, 100000 or die $!;
|
||||
close $ih;
|
||||
if ($buf =~ /VERSION\s*=\s*("|'|)(\d+|\d*\.\d+(?:_\d+)?)\1/m) {
|
||||
$me->d->{module_install}{version} = my $version = $2;
|
||||
my $non_devel = $version;
|
||||
$non_devel =~ s/_\d+$//;
|
||||
if ($non_devel < 0.61 or $non_devel == 1.04) {
|
||||
$me->d->{module_install}{broken} = 1;
|
||||
}
|
||||
if ($non_devel < 0.89) {
|
||||
my $makefilepl = catfile($distdir, 'Makefile.PL');
|
||||
return if not -f $makefilepl;
|
||||
|
||||
open my $ih, '<', $makefilepl
|
||||
or die "Could not open file '$makefilepl' for checking the bad_installer metric: $!";
|
||||
local $/ = undef;
|
||||
my $mftext = <$ih>;
|
||||
close $ih;
|
||||
|
||||
return if not defined $mftext;
|
||||
|
||||
if ($mftext =~ /auto_install/) {
|
||||
$me->d->{module_install}{broken_auto_install} = 1;
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
|
||||
if ($non_devel < 0.64) {
|
||||
$me->d->{module_install}{broken} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Unknown version (parsing $VERSION failed)
|
||||
$me->d->{module_install}{broken} = 1;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'no_broken_module_install',
|
||||
error => q{This distribution uses an obsolete version of Module::Install. Versions of Module::Install prior to 0.61 might not work on some systems at all. Additionally if your Makefile.PL uses the 'auto_install()' feature, you need at least version 0.64. Also, 1.04 is known to be broken.},
|
||||
remedy => q{Upgrade the bundled version of Module::Install to the most current release. Alternatively, you can switch to another build system / installer that does not suffer from this problem. (ExtUtils::MakeMaker, Module::Build both of which have their own set of problems.)},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 unless exists $d->{module_install};
|
||||
$d->{module_install}{broken} ? 0 : 1;
|
||||
},
|
||||
details => sub {
|
||||
q{This distribution uses obsolete Module::Install version }.(shift->{module_install}{version});
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_broken_auto_install',
|
||||
error => q{This distribution uses an old version of Module::Install. Versions of Module::Install prior to 0.89 do not detect correctly that CPAN/CPANPLUS shell is used.},
|
||||
remedy => q{Upgrade the bundled version of Module::Install to at least 0.89, but preferably to the most current release. Alternatively, you can switch to another build system / installer that does not suffer from this problem. (ExtUtils::MakeMaker, Module::Build both of which have their own set of problems.)},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 unless exists $d->{module_install};
|
||||
$d->{module_install}{broken_auto_install} ? 0 : 1;
|
||||
},
|
||||
details => sub {
|
||||
q{This distribution uses obsolete Module::Install version }.(shift->{module_install}{version});
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
1
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::BrokenInstaller - Check for broken Module::Install
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Find out whether the distribution uses an outdated version of Module::Install.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>, as data generated by this should not be
|
||||
used by any other tests.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
C<MCK::BrokenInstaller> checks whether the distribution uses Module::Install
|
||||
and if so whether it uses a reasonably current version of it (0.61 or later).
|
||||
|
||||
It also checks whether the F<Makefile.PL> uses the C<auto_install> feature.
|
||||
If so, C<Module::Install> should be at least version 0.64.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * no_broken_module_install
|
||||
|
||||
=item * no_broken_auto_install
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Steffen Müller|https://metacpan.org/author/smueller>
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Copyright © 2006 L<Steffen Müller|https://metacpan.org/author/smueller>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
94
database/perl/lib/Module/CPANTS/Kwalitee/CpantsErrors.pm
Normal file
94
database/perl/lib/Module/CPANTS/Kwalitee/CpantsErrors.pm
Normal file
@@ -0,0 +1,94 @@
|
||||
package Module::CPANTS::Kwalitee::CpantsErrors;
|
||||
use warnings;
|
||||
use strict;
|
||||
use version;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 1000 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
# NOTE: CPANTS error should be logged somewhere, but it
|
||||
# should not annoy people. If anything wrong or interesting
|
||||
# is found in the log, add some metrics (if it's worth),
|
||||
# or just fix our problems.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::CpantsErrors module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
}
|
||||
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
# Older Test::Kwalitee (prior to 1.08) has hardcoded metrics
|
||||
# names in it, and if those metrics are gone from
|
||||
# Module::CPANTS::Kwalitee, it fails because the number of tests
|
||||
# is not as expected. This is not beautiful, but better than
|
||||
# to break others' distributions needlessly.
|
||||
if ($INC{"Test/Kwalitee.pm"}) {
|
||||
return [
|
||||
map {+{name => $_, code => sub {1}}}
|
||||
qw/extractable no_pod_errors
|
||||
has_test_pod has_test_pod_coverage/
|
||||
] if version->parse(Test::Kwalitee->VERSION) < version->parse(1.08);
|
||||
}
|
||||
|
||||
return [];
|
||||
}
|
||||
|
||||
|
||||
q{Listeing to: FM4 the early years};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::CpantsErrors - Check for CPANTS testing errors
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Checks if something strange happened during testing
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<1000>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Uses C<IO::Capture::Stdout> to check for any strange things that might happen during testing
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=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.
|
||||
93
database/perl/lib/Module/CPANTS/Kwalitee/Distname.pm
Normal file
93
database/perl/lib/Module/CPANTS/Kwalitee/Distname.pm
Normal file
@@ -0,0 +1,93 @@
|
||||
package Module::CPANTS::Kwalitee::Distname;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 20 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
# NOTE: The analysis code has moved to ::Analyse to avoid
|
||||
# duplication.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::Distname module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
# NOTE: The metrics in this module have moved to
|
||||
# Module::CPANTS::SiteKwalitee because these require an archived
|
||||
# distribution which you don't have while testing local Kwalitee
|
||||
# with Test::Kwalitee.
|
||||
|
||||
return [];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Distname - Proper Distname layout
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics in this module have moved to L<Module::CPANTS::SiteKwalitee::Distname|https://github.com/cpants/Module-CPANTS-SiteKwalitee>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<20>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Does nothing now.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=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.
|
||||
90
database/perl/lib/Module/CPANTS/Kwalitee/Distros.pm
Normal file
90
database/perl/lib/Module/CPANTS/Kwalitee/Distros.pm
Normal file
@@ -0,0 +1,90 @@
|
||||
package Module::CPANTS::Kwalitee::Distros;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 800 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
my $debian;
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
# NOTE: The data source of these debian metrics has not been
|
||||
# updated for more than a year, and mirroring stuff from
|
||||
# external source every time you test is very nasty.
|
||||
|
||||
# These metrics are deprecated and actually removed to
|
||||
# reduce unwanted dependencies for Test::Kwalitee users.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::Distro module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
return [];
|
||||
}
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Lili Allen - Allright, still};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Distros - Information retrieved from the various Linux and other distributions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics here were based on data provided by the various downstream packaging systems, but are deprecated now.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Does nothing now.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
and L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
with the help of Martín Ferrari and the
|
||||
Debian Perl packaging team
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
484
database/perl/lib/Module/CPANTS/Kwalitee/Files.pm
Normal file
484
database/perl/lib/Module/CPANTS/Kwalitee/Files.pm
Normal file
@@ -0,0 +1,484 @@
|
||||
package Module::CPANTS::Kwalitee::Files;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Find::Object;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use File::stat;
|
||||
use ExtUtils::Manifest qw(maniskip);
|
||||
$ExtUtils::Manifest::Quiet = 1;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
our $RespectManiskip = 1; # for Test::Kwalitee and its friends
|
||||
|
||||
sub order { 15 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
my $distdir = $me->distdir;
|
||||
$distdir =~ s|\\|/|g if $^O eq 'MSWin32';
|
||||
|
||||
# Respect no_index if possible
|
||||
my $no_index_re = $class->_make_no_index_regex($me);
|
||||
my $maniskip = $class->_make_maniskip($me, $distdir);
|
||||
|
||||
my (%files, %dirs);
|
||||
my (@files_array, @dirs_array, @files_to_be_skipped);
|
||||
my $size = 0;
|
||||
my $latest_mtime = 0;
|
||||
my @base_dirs;
|
||||
my $finder = File::Find::Object->new({
|
||||
depth => 1,
|
||||
followlink => 0,
|
||||
}, $distdir);
|
||||
my %seen; # GH-83
|
||||
while(defined(my $name = $finder->next)) {
|
||||
$name =~ s|\\|/|g if $^O eq 'MSWin32';
|
||||
(my $path = $name) =~ s!^\Q$distdir\E(?:/|$)!! or next;
|
||||
next if $path eq '';
|
||||
next if $seen{$path}++;
|
||||
|
||||
if ($me->d->{is_local_distribution}) {
|
||||
next if $path =~ m!/\.!;
|
||||
}
|
||||
|
||||
if ($maniskip && $maniskip->($path)) {
|
||||
next if $RespectManiskip;
|
||||
push @files_to_be_skipped, $path;
|
||||
if (-d $name) { $dirs{$path}{maniskip} = 1 }
|
||||
else { $files{$path}{maniskip} = 1 }
|
||||
}
|
||||
|
||||
if (-d $name) {
|
||||
$dirs{$path} ||= {};
|
||||
if (-l $name) {
|
||||
$dirs{$path}{symlink} = 1;
|
||||
}
|
||||
push @dirs_array, $path;
|
||||
next;
|
||||
}
|
||||
|
||||
if (my $stat = stat($name)) {
|
||||
$files{$path}{size} = $stat->size || 0;
|
||||
$size += $files{$path}{size};
|
||||
|
||||
my $mtime = $files{$path}{mtime} = $stat->mtime;
|
||||
$latest_mtime = $mtime if $mtime > $latest_mtime;
|
||||
} else {
|
||||
$files{$path}{stat_error} = $!;
|
||||
next;
|
||||
}
|
||||
|
||||
if (-l $name) {
|
||||
$files{$path}{symlink} = 1;
|
||||
}
|
||||
|
||||
if ($no_index_re && $path =~ qr/$no_index_re/) {
|
||||
$files{$path}{no_index} = 1;
|
||||
next;
|
||||
}
|
||||
|
||||
if (!-r $name) {
|
||||
$files{$path}{unreadable} = 1;
|
||||
next;
|
||||
}
|
||||
|
||||
# ignore files in dot directories (probably VCS stuff)
|
||||
next if $path =~ m!(?:^|/)\.[^/]+/!;
|
||||
|
||||
push @files_array, $path;
|
||||
|
||||
# distribution may have several Makefile.PLs, thus
|
||||
# several 'lib' or 't' directories to care
|
||||
if ($path =~ m!/Makefile\.PL$! && $path !~ m!(^|/)x?t/!) {
|
||||
(my $dir = $path) =~ s|/[^/]+$||;
|
||||
push @base_dirs, $dir;
|
||||
}
|
||||
}
|
||||
|
||||
$me->d->{size_unpacked} = $size;
|
||||
$me->d->{latest_mtime} = $latest_mtime;
|
||||
|
||||
my @symlinks = sort {$a cmp $b} (
|
||||
grep({ $files{$_}{symlink} } keys %files),
|
||||
grep({ $dirs{$_}{symlink} } keys %dirs)
|
||||
);
|
||||
|
||||
if (@symlinks) {
|
||||
$me->d->{error}{symlinks} = join ',', @symlinks;
|
||||
}
|
||||
|
||||
if (@files_to_be_skipped) {
|
||||
$me->d->{error}{no_files_to_be_skipped} = join ',', @files_to_be_skipped;
|
||||
}
|
||||
|
||||
$me->d->{base_dirs} = [sort @base_dirs] if @base_dirs;
|
||||
my $base_dirs_re = join '|', '', map {quotemeta "$_/"} @base_dirs;
|
||||
|
||||
# find special files/dirs
|
||||
my @special_files = sort (qw(Makefile.PL Build.PL META.yml META.json MYMETA.yml MYMETA.json dist.ini cpanfile SIGNATURE MANIFEST MANIFEST.SKIP test.pl LICENSE LICENCE));
|
||||
my @special_dirs = sort (qw(lib t xt));
|
||||
|
||||
my %special_files_re = (
|
||||
file_changelog => qr{^(?:$base_dirs_re)(?:chang|history)}i,
|
||||
file_readme => qr{^(?:$base_dirs_re)readme(?:\.(?:txt|md|pod|mkdn|mdown|markdown))?}i,
|
||||
);
|
||||
|
||||
for my $base_dir ('', @base_dirs) {
|
||||
$base_dir = "$base_dir/" if $base_dir;
|
||||
for my $name (@special_files) {
|
||||
my $file = "$base_dir$name";
|
||||
if (exists $files{$file}) {
|
||||
(my $key = "file_".lc $name) =~ s/\./_/;
|
||||
$me->d->{$key} = $me->d->{$key} ? $me->d->{$key}.",$file" : $file;
|
||||
}
|
||||
}
|
||||
for my $name (@special_dirs) {
|
||||
my $dir = "$base_dir$name";
|
||||
if (exists $dirs{$dir}) {
|
||||
my $key = "dir_$name";
|
||||
$me->d->{$key} = $me->d->{$key} ? $me->d->{$key}.",$dir" : $dir;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for my $file (sort keys %files) {
|
||||
next unless $file =~ m!^(?:$base_dirs_re)[^/]+$!;
|
||||
while(my ($key, $re) = each %special_files_re) {
|
||||
if ($file =~ /$re/) {
|
||||
$me->d->{$key} = $me->d->{$key} ? $me->d->{$key}.",$file" : $file;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# store stuff
|
||||
$me->d->{files} = scalar @files_array;
|
||||
$me->d->{files_array} = \@files_array;
|
||||
$me->d->{files_hash} = \%files;
|
||||
$me->d->{dirs} = scalar @dirs_array;
|
||||
$me->d->{dirs_array} = \@dirs_array;
|
||||
|
||||
my @ignored = grep {$files{$_}{no_index}} sort keys %files;
|
||||
$me->d->{ignored_files_array} = \@ignored if @ignored;
|
||||
|
||||
# check STDIN in Makefile.PL and Build.PL
|
||||
# objective: convince people to use prompt();
|
||||
for my $type (qw/makefile_pl build_pl/) {
|
||||
for my $path (split ',', $me->d->{"file_$type"} || '') {
|
||||
next unless $path;
|
||||
my $file = catfile($me->distdir, $path);
|
||||
next if not -e $file;
|
||||
open my $fh, '<', $file or next;
|
||||
my $content = do { local $/; <$fh> } or next;
|
||||
$me->d->{"stdin_in_$type"} = 1 if $content =~ /<STDIN>/;
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _make_no_index_regex {
|
||||
my ($class, $me) = @_;
|
||||
|
||||
my $meta = $me->d->{meta_yml};
|
||||
return unless $meta && ref $meta eq ref {};
|
||||
|
||||
my $no_index = $meta->{no_index} || $meta->{private};
|
||||
return unless $no_index && ref $no_index eq ref {};
|
||||
|
||||
my %map = (
|
||||
file => '\z',
|
||||
directory => '/',
|
||||
);
|
||||
my @ignore;
|
||||
for my $type (qw/file directory/) {
|
||||
next unless $no_index->{$type};
|
||||
my $rest = $map{$type};
|
||||
my @entries = ref $no_index->{$type} eq ref []
|
||||
? @{ $no_index->{$type} }
|
||||
: ( $no_index->{$type} );
|
||||
# entries may possibly have escape chars; DAGOLDEN/Class-InsideOut-0.90_01.tar.gz
|
||||
push @ignore, map {s/\\/\\\\/g; "^$_$rest"} @entries;
|
||||
}
|
||||
return unless @ignore;
|
||||
|
||||
$me->d->{no_index} = join ';', sort @ignore;
|
||||
return '(?:' . (join '|', @ignore) . ')';
|
||||
}
|
||||
|
||||
sub _make_maniskip {
|
||||
my ($class, $me, $distdir) = @_;
|
||||
|
||||
my $maniskip_file = "$distdir/MANIFEST.SKIP";
|
||||
return unless -f $maniskip_file && -r _;
|
||||
|
||||
# ignore MANIFEST.SKIP if it has an invalid entry
|
||||
my $maniskip_bak_file = "$maniskip_file.bak";
|
||||
my $has_maniskip_bak = -f $maniskip_bak_file;
|
||||
|
||||
my $maniskip = maniskip($maniskip_file);
|
||||
|
||||
my $maniskip_warning;
|
||||
local $SIG{__WARN__} = sub { $maniskip_warning = shift; };
|
||||
eval { $maniskip->(""); };
|
||||
if ($@ or $maniskip_warning) {
|
||||
$me->d->{error}{no_maniskip_error} = $@ || $maniskip_warning;
|
||||
$maniskip = undef;
|
||||
}
|
||||
if (-f $maniskip_bak_file && !$has_maniskip_bak) {
|
||||
my $mtime = stat($maniskip_bak_file)->mtime;
|
||||
utime $mtime, $mtime, $maniskip_file;
|
||||
|
||||
unlink $maniskip_bak_file; # probably generated by #include_default
|
||||
}
|
||||
$maniskip;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'has_readme',
|
||||
error => q{The file "README" is missing from this distribution. The README provides some basic information to users prior to downloading and unpacking the distribution.},
|
||||
remedy => q{Add a README to the distribution. It should contain a quick description of your module and how to install it.},
|
||||
code => sub { shift->{file_readme} ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "README was not found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_manifest',
|
||||
error => q{The file "MANIFEST" is missing from this distribution. The MANIFEST lists all files included in the distribution.},
|
||||
remedy => q{Add a MANIFEST to the distribution. Your buildtool should be able to autogenerate it (eg "make manifest" or "./Build manifest")},
|
||||
code => sub { shift->{file_manifest} ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "MANIFEST was not found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_meta_yml',
|
||||
error => q{The file "META.yml" is missing from this distribution. META.yml is needed by people maintaining module collections (like CPAN), for people writing installation tools, or just people who want to know some stuff about a distribution before downloading it.},
|
||||
remedy => q{Add a META.yml to the distribution. Your buildtool should be able to autogenerate it.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 if $d->{file_meta_yml};
|
||||
return 1 if $d->{is_local_distribution} && $d->{file_mymeta_yml};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "META.yml was not found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_meta_json',
|
||||
error => q{The file "META.json" is missing from this distribution. META.json has better information than META.yml and is preferred by people maintaining module collections (like CPAN), for people writing installation tools, or just people who want to know some stuff about a distribution before downloading it.},
|
||||
remedy => q{Add a META.json to the distribution. Your buildtool should be able to autogenerate it.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 if $d->{file_meta_json};
|
||||
return 1 if $d->{is_local_distribution} && $d->{file_mymeta_json};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "META.json was not found.";
|
||||
},
|
||||
is_extra => 1,
|
||||
},
|
||||
{
|
||||
name => 'has_buildtool',
|
||||
error => q{Makefile.PL and/or Build.PL are missing. This makes installing this distribution hard for humans and impossible for automated tools like CPAN/CPANPLUS/cpanminus.},
|
||||
remedy => q{Add a Makefile.PL (for ExtUtils::MakeMaker/Module::Install) or a Build.PL (for Module::Build and its friends), or use a distribution builder such as Dist::Zilla, Dist::Milla, Minilla.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 if $d->{file_makefile_pl} || $d->{file_build_pl};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "Neither Makefile.PL nor Build.PL was found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_changelog',
|
||||
error => q{The distribution hasn't got a Changelog (named something like m/^chang(es?|log)|history$/i). A Changelog helps people decide if they want to upgrade to a new version.},
|
||||
remedy => q{Add a Changelog (best named 'Changes') to the distribution. It should list at least major changes implemented in newer versions.},
|
||||
code => sub { shift->{file_changelog} ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "Any Changelog file was not found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_files_to_be_skipped',
|
||||
error => q{This distribution contains files that should be skipped by MANIFEST.SKIP.},
|
||||
remedy => q{Fix MANIFEST.SKIP or use an authoring tool which respects MANIFEST.SKIP. Note that each entry in MANIFEST.SKIP is a regular expression. You may need to add appropriate meta characters not to ignore necessary stuff.},
|
||||
code => sub {shift->{error}{no_files_to_be_skipped} ? 0 : 1},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "The following files were found: ".$d->{error}{no_files_to_be_skipped};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_symlinks',
|
||||
error => q{This distribution includes symbolic links (symlinks). This is bad, because there are operating systems that do not handle symlinks.},
|
||||
remedy => q{Remove the symlinks from the distribution.},
|
||||
code => sub {shift->{error}{symlinks} ? 0 : 1},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "The following symlinks were found: ".$d->{error}{symlinks};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_tests',
|
||||
error => q{This distribution doesn't contain either a file called 'test.pl' or a directory called 't'. This indicates that it doesn't contain even the most basic test-suite. This is really BAD!},
|
||||
remedy => q{Add tests!},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
# TODO: make sure if .t files do exist in t/ directory.
|
||||
return 1 if $d->{file_test_pl} || $d->{dir_t};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return q{Neither "test.pl" nor "t/" directory was not found.};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_tests_in_t_dir',
|
||||
is_extra => 1,
|
||||
error => q{This distribution contains either a file called 'test.pl' (the old test file) or is missing a directory called 't'. This indicates that it uses the old test mechanism or it has no test-suite.},
|
||||
remedy => q{Add tests or move tests.pl to the t/ directory!},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
# TODO: make sure if .t files do exist in t/ directory.
|
||||
return 1 if !$d->{file_test_pl} && $d->{dir_t};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return q{"test.pl" was found.} if $d->{file_test_pl};
|
||||
return q{"t/" directory was not found.};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_stdin_for_prompting',
|
||||
error => q{This distribution is using direct call from STDIN instead of prompt(). Make sure STDIN is not used in Makefile.PL or Build.PL.},
|
||||
is_extra => 1,
|
||||
remedy => q{Use the prompt() method from ExtUtils::MakeMaker/Module::Build.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
if ($d->{stdin_in_makefile_pl}||$d->{stdin_in_build_pl}) {
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "<STDIN> was found in Makefile.PL" if $d->{stdin_in_makefile_pl};
|
||||
return "<STDIN> was found in Build.PL" if $d->{stdin_in_build_pl};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_maniskip_error',
|
||||
error => q{This distribution's MANIFEST.SKIP has a problematic entry.},
|
||||
is_extra => 1,
|
||||
remedy => q{Fix the problematic entry.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
if ($d->{error}{no_maniskip_error}) {
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return $d->{error}{no_maniskip_error};
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Files - Check for various files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Find various files and directories that should be part of every self-respecting distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<15>, as data generated by C<MCK::Files> is used by all other tests.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
C<MCK::Files> uses C<File::Find::Object> to get a list of all files and directories in a distribution. It checks if certain crucial files are there, and does some other file-specific stuff.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * has_readme
|
||||
|
||||
=item * has_manifest
|
||||
|
||||
=item * has_meta_yml
|
||||
|
||||
=item * has_buildtool
|
||||
|
||||
=item * has_changelog
|
||||
|
||||
=item * no_symlinks
|
||||
|
||||
=item * has_tests
|
||||
|
||||
=item * has_tests_in_t_dir
|
||||
|
||||
=item * no_stdin_for_prompting
|
||||
|
||||
=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.
|
||||
244
database/perl/lib/Module/CPANTS/Kwalitee/FindModules.pm
Normal file
244
database/perl/lib/Module/CPANTS/Kwalitee/FindModules.pm
Normal file
@@ -0,0 +1,244 @@
|
||||
package Module::CPANTS::Kwalitee::FindModules;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 30 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
my $files = $me->d->{files_array} || [];
|
||||
|
||||
if ($me->d->{meta_yml} && $me->d->{meta_yml}{provides}) {
|
||||
my $provides = $me->d->{meta_yml}{provides};
|
||||
for my $module (sort keys %$provides) {
|
||||
my $data = $provides->{$module};
|
||||
next unless ref $data eq ref {}; # ignore wrong format
|
||||
my $file = $data->{file} || '';
|
||||
my $found = {
|
||||
module => $module,
|
||||
file => $file,
|
||||
in_basedir => 0,
|
||||
in_lib => 0,
|
||||
};
|
||||
my $loc;
|
||||
if ($file =~ /^lib\W/) {
|
||||
$found->{in_lib} = 1;
|
||||
}
|
||||
elsif ($file !~ /\//) {
|
||||
$found->{in_basedir} = 1;
|
||||
}
|
||||
|
||||
push @{$me->d->{modules}}, $found;
|
||||
if (exists $me->d->{files_hash}{$file}) {
|
||||
(my $path_part = $module) =~ s|::|/|g;
|
||||
if ($file =~ /\b$path_part\.pm$/) {
|
||||
$me->d->{files_hash}{$file}{module} = $module;
|
||||
} elsif ("$path_part.pm" =~ /\b$file$/) {
|
||||
$me->d->{files_hash}{$file}{module} ||= $module;
|
||||
}
|
||||
} else {
|
||||
$found->{not_exists} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
my %in_basedir = map {$_ => 1} grep {/^[^\/]+\.pm$/} @$files;
|
||||
|
||||
foreach my $file (@$files) {
|
||||
next unless $file =~ /\.pm$/;
|
||||
next if $file =~ m{^x?t/};
|
||||
next if $file =~ m{^test/};
|
||||
next if $file =~ m/^(bin|scripts?|ex|eg|examples?|samples?|demos?)\/\w/i;
|
||||
next if $file =~ m{^inc/}; # skip Module::Install stuff
|
||||
next if $file =~ m{^(local|perl5|fatlib)/};
|
||||
|
||||
# proper file in lib/
|
||||
if ($file =~ m|^lib/(.*)\.pm$|) {
|
||||
my $module = $1;
|
||||
$module =~ s|/|::|g;
|
||||
push (@{$me->d->{modules}}, {
|
||||
module => $module,
|
||||
file => $file,
|
||||
in_basedir => 0,
|
||||
in_lib => 1,
|
||||
});
|
||||
$me->d->{files_hash}{$file}{module} = $module;
|
||||
}
|
||||
else {
|
||||
# open file and find first package
|
||||
my ($basename) = $file =~ /(\w+)\.pm/;
|
||||
my $module;
|
||||
my $max_lines_to_look_at = 666;
|
||||
open (my $fh, "<", catfile($me->distdir, $file)) or die "__PACKAGE__: Cannot open $file to find package declaration: $!";
|
||||
while (my $line = <$fh>) {
|
||||
next if $line =~ /^\s*#/; # ignore comments
|
||||
if ($line =~ /^\s*package\s*(.*?)\s*;/) {
|
||||
$module = $1;
|
||||
last if $basename and $module =~ /\b$basename$/;
|
||||
}
|
||||
last if $line =~ /^__(DATA|END)__/;
|
||||
$max_lines_to_look_at--;
|
||||
last unless $max_lines_to_look_at;
|
||||
}
|
||||
# try to guess from filename
|
||||
unless ($module) {
|
||||
$file =~ m|(.*)\.pm$|;
|
||||
$module = $1;
|
||||
$module =~ s|^[a-z]+/||; # remove lowercase prefixes which most likely are not part of the distname (but something like 'src/')
|
||||
$module =~ s|/|::|g;
|
||||
}
|
||||
if ($module) {
|
||||
push(@{$me->d->{modules}}, {
|
||||
module => $module,
|
||||
file => $file,
|
||||
in_basedir => $in_basedir{$file} ? 1 : 0,
|
||||
in_lib => 0,
|
||||
});
|
||||
$me->d->{files_hash}{$file}{module} = $module;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for my $file (keys %{$me->d->{files_hash}}) {
|
||||
next unless $file =~ /^inc\/(.+)\.pm/;
|
||||
my $module = $1;
|
||||
$module =~ s|/|::|g;
|
||||
push @{$me->d->{included_modules} ||= []}, $module;
|
||||
}
|
||||
|
||||
if (exists $me->d->{modules}) {
|
||||
$me->d->{modules} = [sort {$a->{module} cmp $b->{module}} @{$me->d->{modules}}];
|
||||
}
|
||||
if (exists $me->d->{included_modules}) {
|
||||
$me->d->{included_modules} = [sort @{$me->d->{included_modules}}];
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'proper_libs',
|
||||
error => q{There is more than one .pm file in the base dir, or the .pm files are not in lib/ directory.},
|
||||
remedy => q{Move your *.pm files in a directory named 'lib'. The directory structure should look like 'lib/Your/Module.pm' for a module named 'Your::Module'. If you need to provide additional files, e.g. for testing, that should not be considered for Kwalitee, then you should look at the 'provides' map in META.yml to limit the files scanned; or use the 'no_index' map to exclude parts of the distribution.},
|
||||
is_extra => 1,
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my @modules = @{$d->{modules} || []};
|
||||
return 1 unless @modules;
|
||||
|
||||
my @not_in_lib = grep { !$_->{in_lib} } @modules;
|
||||
return 1 unless @not_in_lib;
|
||||
|
||||
my @in_basedir = grep { $_->{in_basedir} } @not_in_lib;
|
||||
return 1 if @in_basedir == 1;
|
||||
|
||||
$d->{error}{proper_libs} = join ', ', map {$_->{file}} @not_in_lib;
|
||||
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my @modules = @{$d->{modules} || []};
|
||||
return "No modules were found" unless @modules;
|
||||
return "The following files were found: ".$d->{error}{proper_libs};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_missing_files_in_provides',
|
||||
error => q{Provides field in the META.yml lists a file that does not found in the distribution.},
|
||||
remedy => q{Use authoring tool like Dist::Zilla, Milla, and Minilla to generate correct provides.},
|
||||
is_extra => 1,
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my @modules = @{$d->{modules} || []};
|
||||
return 1 unless @modules;
|
||||
|
||||
if (my @not_exists = grep { $_->{not_exists} } @modules) {
|
||||
$d->{error}{no_missing_files_in_provides} = join ', ', map {$_->{file}} @not_exists;
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my @modules = @{$d->{modules} || []};
|
||||
return "No modules were found" unless @modules;
|
||||
return "The following files were missing: ".$d->{error}{no_missing_files_in_provides};
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::FindModules - Find modules provided by a dist
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Finds and reports all modules (i.e. F<*.pm> files) in a distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<30>, as data generated by C<MCK::FindModules> is used by other tests.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
C<MCK::FindModules> first looks in C<basedir> and F<lib/> for C<*.pm> files. If it doesn't find any, it looks in the whole dist, but the C<proper_libs> kwalitee point is only awarded if the modules are F<lib/> or there's only one module in C<basedir>.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * proper_libs
|
||||
|
||||
=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.
|
||||
280
database/perl/lib/Module/CPANTS/Kwalitee/License.pm
Normal file
280
database/perl/lib/Module/CPANTS/Kwalitee/License.pm
Normal file
@@ -0,0 +1,280 @@
|
||||
package Module::CPANTS::Kwalitee::License;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use Software::LicenseUtils;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
my $distdir = $me->distdir;
|
||||
|
||||
# check META.yml
|
||||
my $yaml = $me->d->{meta_yml};
|
||||
$me->d->{license} = '';
|
||||
if ($yaml) {
|
||||
if ($yaml->{license} and $yaml->{license} ne 'unknown') {
|
||||
my $license = $yaml->{license};
|
||||
$license = join ',', @$license if ref $license eq 'ARRAY';
|
||||
$me->d->{license_from_yaml} = $license;
|
||||
$me->d->{license} = $license.' defined in META.yml';
|
||||
}
|
||||
}
|
||||
# use "files_array" to exclude files listed in "no_index".
|
||||
my $files = $me->d->{files_array} || [];
|
||||
|
||||
# check if there's a LICEN[CS]E file
|
||||
# (also accept LICENSE.txt etc; RT #114247)
|
||||
if (my ($file) = grep {$_ =~ /^(?:LICEN[CS]E|COPYING)\b/} @$files) {
|
||||
$me->d->{license} .= " defined in $file";
|
||||
$me->d->{external_license_file} = $file;
|
||||
}
|
||||
|
||||
# check pod
|
||||
my %licenses;
|
||||
foreach my $file (grep { /\.(?:pm|pod|pl|PL)$/ } sort @$files ) {
|
||||
next if $file =~ /(?:Makefile|Build)\.PL$/;
|
||||
my $path = catfile($distdir, $file);
|
||||
next unless -r $path; # skip if not readable
|
||||
open my $fh, '<', $path or next;
|
||||
my $in_pod = 0;
|
||||
my $pod = '';
|
||||
my $pod_head = '';
|
||||
my @possible_licenses;
|
||||
my @unknown_license_texts;
|
||||
my $uc_head;
|
||||
while(<$fh>) {
|
||||
my $first_four = substr($_, 0, 4);
|
||||
if ($first_four eq '=hea' && (($uc_head = uc $_) =~ /(?:LICEN[CS]E|LICEN[CS]ING|COPYRIGHT|LEGAL)/)) {
|
||||
$me->d->{license_in_pod} = 1;
|
||||
$me->d->{license} ||= "defined in POD ($file)";
|
||||
if ($in_pod) {
|
||||
my @guessed = Software::LicenseUtils->guess_license_from_pod("=head1 LICENSE\n$pod\n\n=cut\n");
|
||||
if (@guessed) {
|
||||
push @possible_licenses, @guessed;
|
||||
} else {
|
||||
push @unknown_license_texts, "$pod_head$pod";
|
||||
}
|
||||
}
|
||||
|
||||
$in_pod = 1;
|
||||
$pod_head = $_;
|
||||
$pod = '';
|
||||
}
|
||||
elsif ($first_four eq '=hea' or $first_four eq '=cut') {
|
||||
if ($in_pod) {
|
||||
my @guessed = Software::LicenseUtils->guess_license_from_pod("=head1 LICENSE\n$pod\n\n=cut\n");
|
||||
if (@guessed) {
|
||||
push @possible_licenses, @guessed;
|
||||
} else {
|
||||
push @unknown_license_texts, "$pod_head$pod";
|
||||
}
|
||||
}
|
||||
$in_pod = 0;
|
||||
$pod = '';
|
||||
}
|
||||
elsif ($in_pod) {
|
||||
$pod .= $_;
|
||||
}
|
||||
}
|
||||
if ($pod) {
|
||||
my @guessed = Software::LicenseUtils->guess_license_from_pod("=head1 LICENSE\n$pod\n\n=cut\n");
|
||||
if (@guessed) {
|
||||
push @possible_licenses, @guessed;
|
||||
} else {
|
||||
push @unknown_license_texts, "$pod_head$pod";
|
||||
}
|
||||
}
|
||||
if (@possible_licenses) {
|
||||
@possible_licenses = map { s/^Software::License:://; $_ } @possible_licenses;
|
||||
push @{$licenses{$_} ||= []}, $file for @possible_licenses;
|
||||
$me->d->{files_hash}{$file}{license} = join ',', @possible_licenses;
|
||||
} else {
|
||||
$me->d->{unknown_license_texts}{$file} = join "\n", @unknown_license_texts if @unknown_license_texts;
|
||||
}
|
||||
}
|
||||
if (%licenses) {
|
||||
$me->d->{licenses} = \%licenses;
|
||||
my @possible_licenses = keys %licenses;
|
||||
if (@possible_licenses == 1) {
|
||||
my ($type) = @possible_licenses;
|
||||
$me->d->{license_type} = $type;
|
||||
$me->d->{license_file} = join ',', @{$licenses{$type}};
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
return [
|
||||
{
|
||||
name => 'meta_yml_has_license',
|
||||
error => q{This distribution does not have a license defined in META.yml.},
|
||||
remedy => q{Define the license if you are using in Build.PL. If you are using MakeMaker (Makefile.PL) you should upgrade to ExtUtils::MakeMaker version 6.31.},
|
||||
is_extra => 1,
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
($yaml->{license} and $yaml->{license} ne 'unknown') ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
return "No META.yml." unless $yaml;
|
||||
return "No license was found in META.yml." unless $yaml->{license};
|
||||
return "Unknown license was found in META.yml.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_human_readable_license',
|
||||
error => q{This distribution does not have a license defined in the documentation or in a file called LICENSE},
|
||||
remedy => q{Add a section called "LICENSE" to the documentation, or add a file named LICENSE to the distribution.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return $d->{external_license_file} || $d->{license_in_pod} ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "Neither LICENSE file nor LICENSE section in pod was found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_separate_license_file',
|
||||
error => q{This distribution does not have a LICENSE or LICENCE file in its root directory.},
|
||||
remedy => q{This is not a critical issue. Currently mainly informative for the CPANTS authors. It might be removed later.},
|
||||
is_experimental => 1,
|
||||
code => sub { shift->{external_license_file} ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "LICENSE file was found.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_license_in_source_file',
|
||||
error => q{Does not have license information in any of its source files},
|
||||
remedy => q{Add =head1 LICENSE and the text of the license to the main module in your code.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return $d->{license_in_pod} ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "LICENSE section was not found in the pod.";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'has_known_license_in_source_file',
|
||||
error => q{Does not have license information in any of its source files, or the information is not recognized by Software::License},
|
||||
remedy => q{Add =head1 LICENSE and/or the proper text of the well-known license to the main module in your code.},
|
||||
is_extra => 1,
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 0 unless $d->{license_in_pod};
|
||||
my @files_with_licenses = grep {$d->{files_hash}{$_}{license}} keys %{$d->{files_hash}};
|
||||
return @files_with_licenses ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "LICENSE section was not found in the pod, or the license information was not recognized by Software::License.";
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Lili Allen - Allright, still};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::License - Checks if there is a license
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Checks if the distribution specifies a license.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
C<MCK::License> checks if there's a C<license> field C<META.yml>. Additionally, it looks for a file called LICENSE and a POD section named LICENSE
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * meta_yml_has_license
|
||||
|
||||
=item * has_known_license_in_source_file
|
||||
|
||||
=item * has_license_in_source_file
|
||||
|
||||
=item * has_human_readable_license
|
||||
|
||||
=item * has_separate_license_file
|
||||
|
||||
=back
|
||||
|
||||
=head2 License information
|
||||
|
||||
Places where the license information is taken from:
|
||||
|
||||
Has a LICENSE file file_license 1|0
|
||||
|
||||
Content of LICENSE file matches License X from Software::License
|
||||
|
||||
License in META.yml
|
||||
|
||||
License in META.yml matches one of the known licenses
|
||||
|
||||
License in source files recognized by Software::LicenseUtils
|
||||
For each file keep where is was it recognized.
|
||||
|
||||
Has license or copyright entry in pod (that might not be recognized by Software::LicenseUtils)
|
||||
|
||||
# has_license
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
and L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
155
database/perl/lib/Module/CPANTS/Kwalitee/Manifest.pm
Normal file
155
database/perl/lib/Module/CPANTS/Kwalitee/Manifest.pm
Normal file
@@ -0,0 +1,155 @@
|
||||
package Module::CPANTS::Kwalitee::Manifest;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use Array::Diff;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
my $distdir = $me->distdir;
|
||||
my $manifest_file = catfile($distdir, 'MANIFEST');
|
||||
|
||||
if (-e $manifest_file) {
|
||||
# read manifest
|
||||
open(my $fh, '<', $manifest_file) or die "cannot read MANIFEST $manifest_file: $!";
|
||||
my %seen;
|
||||
while (<$fh>) {
|
||||
chomp;
|
||||
next if /^\s*#/; # discard pure comments
|
||||
if (s/^'(\\[\\']|.+)+'\s*.*/$1/) {
|
||||
s/\\([\\'])/$1/g;
|
||||
} else {
|
||||
s/\s.*$//;
|
||||
} # strip quotes and comments
|
||||
next unless $_; # discard blank lines
|
||||
$seen{$_}++;
|
||||
}
|
||||
close $fh;
|
||||
|
||||
my @manifest = sort keys %seen;
|
||||
my @files = sort keys %{$me->d->{files_hash} || {}};
|
||||
my @dupes = grep {$seen{$_} > 1} @manifest;
|
||||
|
||||
my $diff = Array::Diff->diff(\@manifest, \@files);
|
||||
if ($diff->count == 0 && !@dupes) {
|
||||
$me->d->{manifest_matches_dist} = 1;
|
||||
}
|
||||
else {
|
||||
$me->d->{manifest_matches_dist} = 0;
|
||||
my @error = (
|
||||
'MANIFEST ('.(@manifest + @dupes).') does not match dist ('.@files."):",
|
||||
);
|
||||
if (my @added = @{$diff->added}) {
|
||||
push @error, "Missing in MANIFEST: ".join(', ', @added);
|
||||
}
|
||||
if (my @deleted = @{$diff->deleted}) {
|
||||
push @error, "Missing in Dist: " . join(', ', @deleted);
|
||||
}
|
||||
if (@dupes) {
|
||||
push @error, "Duplicates in MANIFEST: " . join(', ', @dupes);
|
||||
}
|
||||
$me->d->{error}{manifest_matches_dist} = \@error;
|
||||
}
|
||||
|
||||
# Tweak symlinks error for a local distribution (RT #97858)
|
||||
if ($me->d->{is_local_distribution} && $me->d->{error}{symlinks}) {
|
||||
my %manifested = map {$_ => 1} @manifest;
|
||||
my @symlinks = grep {$manifested{$_}} split ',', $me->d->{error}{symlinks};
|
||||
if (@symlinks) {
|
||||
$me->d->{error}{symlinks} = join ',', @symlinks;
|
||||
} else {
|
||||
delete $me->d->{error}{symlinks};
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$me->d->{manifest_matches_dist} = 0;
|
||||
$me->d->{error}{manifest_matches_dist} = q{Cannot find MANIFEST in dist.};
|
||||
}
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'manifest_matches_dist',
|
||||
error => q{MANIFEST does not match the contents of this distribution.},
|
||||
remedy => q{Run a proper command ("make manifest" or "./Build manifest", maybe with a force option), or use a distribution builder to generate the MANIFEST. Or update MANIFEST manually.},
|
||||
code => sub { shift->{manifest_matches_dist} ? 1 : 0 },
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my $error = $d->{error}{manifest_matches_dist};
|
||||
return $error unless ref $error;
|
||||
return join "\n", @$error;
|
||||
},
|
||||
}
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Listening to: YAPC::Europe 2007};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Manifest - Check MANIFEST
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Check if MANIFEST and dist contents match.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Check if MANIFEST and dist contents match.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * manifest_matches_dist
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Thomas Klausner, <domm@cpan.org>, https://domm.plix.at/
|
||||
|
||||
=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.
|
||||
329
database/perl/lib/Module/CPANTS/Kwalitee/MetaYML.pm
Normal file
329
database/perl/lib/Module/CPANTS/Kwalitee/MetaYML.pm
Normal file
@@ -0,0 +1,329 @@
|
||||
package Module::CPANTS::Kwalitee::MetaYML;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use CPAN::Meta::YAML;
|
||||
use CPAN::Meta::Validator;
|
||||
use CPAN::Meta::Converter;
|
||||
use List::Util qw/first/;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 10 }
|
||||
|
||||
my $JSON_DECODER = _load_json_decoder() || do { require JSON::PP; JSON::PP->can('decode_json') };
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
my $distdir = $me->distdir;
|
||||
my $meta_yml = catfile($distdir, 'META.yml');
|
||||
my $meta_json = catfile($distdir, 'META.json');
|
||||
my $mymeta_yml = catfile($distdir, 'MYMETA.yml');
|
||||
|
||||
# META.yml is not always the most preferred meta file,
|
||||
# but test it anyway because it may be broken sometimes.
|
||||
if (-f $meta_yml && -r _) {
|
||||
_analyse_yml($me, $meta_yml);
|
||||
}
|
||||
|
||||
# check also META.json (if exists).
|
||||
if (-f $meta_json && -r _) {
|
||||
_analyse_json($me, $meta_json);
|
||||
}
|
||||
|
||||
# If, and only if META.yml and META.json don't exist,
|
||||
# try MYMETA.yml
|
||||
if (!$me->d->{meta_yml} && -f $mymeta_yml && -r _) {
|
||||
_analyse_yml($me, $mymeta_yml);
|
||||
}
|
||||
|
||||
if (!$me->d->{meta_yml}) {
|
||||
return;
|
||||
}
|
||||
|
||||
# Theoretically it might be better to convert 1.* to 2.0.
|
||||
# However, converting 2.0 to 1.4 is much cheaper for CPANTS
|
||||
# website as it's much rarer as of this writing.
|
||||
if (($me->d->{meta_yml_spec_version} || '1.0') gt '1.4') {
|
||||
my $cmc = CPAN::Meta::Converter->new($me->d->{meta_yml});
|
||||
my $meta_14 = eval { $cmc->convert(version => '1.4') };
|
||||
if (!$@ && $meta_14) {
|
||||
$me->d->{meta_yml} = $meta_14;
|
||||
}
|
||||
}
|
||||
|
||||
$me->d->{dynamic_config} = (!exists $me->d->{meta_yml}{dynamic_config} or $me->d->{meta_yml}{dynamic_config}) ? 1 : 0;
|
||||
}
|
||||
|
||||
sub _analyse_yml {
|
||||
my ($me, $file) = @_;
|
||||
my @warnings;
|
||||
eval {
|
||||
# CPAN::Meta::YAML warns if it finds a duplicate key
|
||||
local $SIG{__WARN__} = sub { push @warnings, @_ };
|
||||
my $meta = CPAN::Meta::YAML->read($file) or die CPAN::Meta::YAML->errstr;
|
||||
# Broken META.yml may return a "YAML 1.0" string first.
|
||||
# eg. M/MH/MHASCH/Date-Gregorian-0.07.tar.gz
|
||||
if (@$meta > 1 or ref $meta->[0] ne ref {}) {
|
||||
$me->d->{meta_yml} = first { ref $_ eq ref {} } @$meta;
|
||||
$me->d->{error}{meta_yml_is_parsable} = "multiple parts found in META.yml";
|
||||
} else {
|
||||
$me->d->{meta_yml} = $meta->[0];
|
||||
$me->d->{meta_yml_is_parsable} = 1;
|
||||
}
|
||||
};
|
||||
if (my $error = $@) {
|
||||
$error =~ s/ at \S+ line \d+.+$//s;
|
||||
$me->d->{error}{meta_yml_is_parsable} = $error;
|
||||
}
|
||||
if ($me->d->{meta_yml}) {
|
||||
my ($spec, $error) = _validate_meta($me->d->{meta_yml});
|
||||
$me->d->{error}{meta_yml_conforms_to_known_spec} = $error if $error;
|
||||
$me->d->{meta_yml_spec_version} = $spec->{spec};
|
||||
}
|
||||
if (@warnings) {
|
||||
$me->d->{error}{meta_yml_has_duplicate_keys} = join ',', @warnings;
|
||||
}
|
||||
}
|
||||
|
||||
sub _analyse_json {
|
||||
my ($me, $file) = @_;
|
||||
|
||||
my $meta;
|
||||
eval {
|
||||
my $json = do { open my $fh, '<', $file or die "$file: $!"; local $/; <$fh> };
|
||||
$meta = $JSON_DECODER->($json);
|
||||
$me->d->{meta_json_is_parsable} = 1;
|
||||
};
|
||||
if (my $error = $@) {
|
||||
$error =~ s/ at \S+ line \d+.+$//s;
|
||||
$me->d->{error}{meta_json_is_parsable} = $error;
|
||||
}
|
||||
if ($meta) {
|
||||
my ($spec, $error) = _validate_meta($meta);
|
||||
$me->d->{error}{meta_json_conforms_to_known_spec} = $error if $error;
|
||||
$me->d->{meta_json_spec_version} = $spec->{spec};
|
||||
}
|
||||
if (!$me->d->{meta_yml}) {
|
||||
$me->d->{meta_yml} = $meta;
|
||||
$me->d->{meta_yml_spec_version} = $me->d->{meta_json_spec_version};
|
||||
$me->d->{meta_yml_is_meta_json} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
sub _load_json_decoder {
|
||||
my $json_class = $ENV{CPAN_META_JSON_BACKEND} || $ENV{PERL_JSON_BACKEND} || 'JSON::PP';
|
||||
eval "require $json_class; 1" or return;
|
||||
$json_class->can('decode_json');
|
||||
}
|
||||
|
||||
sub _validate_meta {
|
||||
my $meta = shift;
|
||||
my $error;
|
||||
my $spec = eval { CPAN::Meta::Validator->new($meta) };
|
||||
if ($error = $@) {
|
||||
$error =~ s/ at \S+ line \d+.+$//s;
|
||||
} elsif (!$spec->is_valid) {
|
||||
$error = join ';', sort $spec->errors;
|
||||
}
|
||||
$error =~ s/(SCALAR|ARRAY|HASH|GLOB|REF)\(0x[0-9a-f]+\)/$1(...)/g;
|
||||
return ($spec, $error);
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
return [
|
||||
{
|
||||
name => 'meta_yml_is_parsable',
|
||||
error => q{The META.yml file of this distribution could not be parsed by the version of CPAN::Meta::YAML.pm CPANTS is using.},
|
||||
remedy => q{Upgrade your YAML generator so it produces valid YAML.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
!$d->{error}{meta_yml_is_parsable} ? 1 : 0
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
$d->{error}{meta_yml_is_parsable};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_json_is_parsable',
|
||||
error => q{The META.json file of this distribution could not be parsed by the version of JSON parser CPANTS is using.},
|
||||
remedy => q{Upgrade your META.json generator so it produces valid JSON.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
!$d->{error}{meta_json_is_parsable} ? 1 : 0
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
$d->{error}{meta_json_is_parsable};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_yml_has_provides',
|
||||
is_experimental => 1,
|
||||
error => q{This distribution does not have a list of provided modules defined in META.yml.},
|
||||
remedy => q{Add all modules contained in this distribution to the META.yml field 'provides'. Module::Build or Dist::Zilla::Plugin::MetaProvides do this automatically for you.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 1 if !$d->{meta_yml};
|
||||
return 1 if $d->{meta_yml}{provides};
|
||||
return 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "No META.yml." unless $d->{meta_yml};
|
||||
return q{No "provides" was found in META.yml.};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_yml_conforms_to_known_spec',
|
||||
error => q{META.yml does not conform to any recognised META.yml Spec.},
|
||||
remedy => q{Take a look at the META.yml Spec at https://metacpan.org/pod/CPAN::Meta::History::Meta_1_4 (for version 1.4) or https://metacpan.org/pod/CPAN::Meta::Spec (for version 2), and change your META.yml accordingly.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 0 if $d->{error}{meta_yml_conforms_to_known_spec};
|
||||
return 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "No META.yml." unless $d->{meta_yml};
|
||||
return "META.yml is broken." unless $d->{meta_yml_is_parsable};
|
||||
return $d->{error}{meta_yml_conforms_to_known_spec};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_json_conforms_to_known_spec',
|
||||
error => q{META.json does not conform to any recognised META Spec.},
|
||||
remedy => q{Take a look at the META.json Spec at https://metacpan.org/pod/CPAN::Meta::History::Meta_1_4 (for version 1.4) or https://metacpan.org/pod/CPAN::Meta::Spec (for version 2), and change your META.json accordingly.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 0 if $d->{error}{meta_json_is_parsable};
|
||||
return 0 if $d->{error}{meta_json_conforms_to_known_spec};
|
||||
return 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "META.json is broken." unless $d->{meta_json_is_parsable};
|
||||
return $d->{error}{meta_json_conforms_to_known_spec};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_yml_declares_perl_version',
|
||||
error => q{This distribution does not declare the minimum perl version in META.yml.},
|
||||
is_extra => 1,
|
||||
remedy => q{If you are using Build.PL define the {requires}{perl} = VERSION field. If you are using MakeMaker (Makefile.PL) you should upgrade ExtUtils::MakeMaker to 6.48 and use MIN_PERL_VERSION parameter. Perl::MinimumVersion can help you determine which version of Perl your module needs.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
return 1 unless $yaml;
|
||||
return ref $yaml->{requires} eq ref {} && $yaml->{requires}{perl} ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
return "No META.yml." unless $yaml;
|
||||
return q{No "requires" was found in META.yml.} unless ref $yaml->{requires} eq ref {};
|
||||
return q{No "perl" subkey was found in META.yml.} unless $yaml->{requires}{perl};
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'meta_yml_has_repository_resource',
|
||||
is_experimental => 1,
|
||||
error => q{This distribution does not have a link to a repository in META.yml.},
|
||||
remedy => q{Add a 'repository' resource to the META.yml via 'meta_add' accessor (for Module::Build) or META_ADD parameter (for ExtUtils::MakeMaker).},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
return 1 unless $yaml;
|
||||
return ref $yaml->{resources} eq ref {} && $yaml->{resources}{repository} ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my $yaml = $d->{meta_yml};
|
||||
return "No META.yml." unless $yaml;
|
||||
return q{No "resources" was found in META.yml.} unless ref $yaml->{resources} eq ref {};
|
||||
return q{No "repository" subkey was found in META.yml.} unless $yaml->{resources}{repository};
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
q{Barbies Favourite record of the moment:
|
||||
Nine Inch Nails: Year Zero};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::MetaYML - Checks data available in META.yml
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Checks various pieces of information in F<META.yml>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<10>. C<MetaYML> should be checked earlier than C<Files> to
|
||||
handle C<no_index> correctly.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
C<MCK::MetaYML> checks C<META.yml>.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over
|
||||
|
||||
=item * meta_yml_is_parsable
|
||||
|
||||
=item * meta_yml_has_provides
|
||||
|
||||
=item * meta_yml_conforms_to_known_spec
|
||||
|
||||
=item * meta_yml_declares_perl_version
|
||||
|
||||
=item * meta_yml_has_repository_resource
|
||||
|
||||
=item * meta_json_is_parsable
|
||||
|
||||
=item * meta_json_conforms_to_known_spec
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
and L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
107
database/perl/lib/Module/CPANTS/Kwalitee/NeedsCompiler.pm
Normal file
107
database/perl/lib/Module/CPANTS/Kwalitee/NeedsCompiler.pm
Normal file
@@ -0,0 +1,107 @@
|
||||
package Module::CPANTS::Kwalitee::NeedsCompiler;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 200 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
my $files = $me->d->{files_array};
|
||||
foreach my $f (@$files) {
|
||||
if ($f =~ /\.[hc]$/i or $f =~ /\.xs$/i) {
|
||||
$me->d->{needs_compiler} = 1;
|
||||
return;
|
||||
}
|
||||
}
|
||||
if (defined ref($me->d->{prereq}) and ref($me->d->{prereq}) eq 'ARRAY') {
|
||||
for my $m (@{ $me->d->{prereq} }) {
|
||||
if ($m->{requires} =~ /^Inline::/
|
||||
or $m->{requires} eq 'ExtUtils::CBuilder'
|
||||
or $m->{requires} eq 'ExtUtils::ParseXS') {
|
||||
$me->d->{needs_compiler} = 1;
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
return [
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite compiler:
|
||||
gcc};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::NeedsCompiler - Checks if the module needs a (probably C) compiler
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Checks if there is some indication in the module that it needs a C compiler to build and install
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<200>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Checks for file with F<.c>, F<.h> or F<.xs> extensions.
|
||||
Check is the module depends on any of the Inline:: modules or
|
||||
on ExtUtils::CBuilder or ExtUtils::ParseXS.
|
||||
|
||||
=head3 TODO:
|
||||
|
||||
How to recognize cases such as https://metacpan.org/release/GAAS/Perl-API-0.01/
|
||||
and https://metacpan.org/release/Term-Size-Perl
|
||||
that generate the .c files during installation
|
||||
|
||||
In addition there are modules that can work without their XS part.
|
||||
E.g. Scalar-List-Utils, Net-DNS, Template-Toolkit
|
||||
For our purposes these all should be marked as "need C compiler"
|
||||
as they need it for their full functionality and speed.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
No Kwalitee Indicator.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
210
database/perl/lib/Module/CPANTS/Kwalitee/Pod.pm
Normal file
210
database/perl/lib/Module/CPANTS/Kwalitee/Pod.pm
Normal file
@@ -0,0 +1,210 @@
|
||||
package Module::CPANTS::Kwalitee::Pod;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw/catfile/;
|
||||
use Encode;
|
||||
use Data::Binary qw/is_binary/;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
our @ABSTRACT_STUBS = (
|
||||
q{Perl extension for blah blah blah}, # h2xs
|
||||
q{[One line description of module's purpose here]}, # Module::Starter etc
|
||||
q{The great new}, # Module::Starter
|
||||
q{It's new $module}, # Minilla
|
||||
);
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my ($class, $me) = @_;
|
||||
my $distdir = $me->distdir;
|
||||
my %abstract;
|
||||
my @errors;
|
||||
for my $module (@{$me->d->{modules} || []}) {
|
||||
my ($package, $abstract, $error, $has_binary_data) = $class->_parse_abstract(catfile($distdir, $module->{file}));
|
||||
push @errors, "$error ($package)" if $error;
|
||||
$me->d->{abstracts_in_pod}{$package} = $abstract if $package;
|
||||
$me->d->{files_hash}{$module->{file}}{has_binary_data} = 1 if $has_binary_data;
|
||||
}
|
||||
|
||||
# sometimes pod for .pm file is put into .pod
|
||||
for my $file (@{$me->d->{files_array} || []}) {
|
||||
next unless $file =~ /\.pod$/ && ($file =~ m!^lib/! or $file =~ m!^[^/]+$!);
|
||||
local $@;
|
||||
my ($package, $abstract, $error, $has_binary_data) = $class->_parse_abstract(catfile($distdir, $file));
|
||||
push @errors, "$error ($package)" if $error;
|
||||
$me->d->{abstracts_in_pod}{$package} = $abstract if $package;
|
||||
$me->d->{files_hash}{$file}{has_binary_data} = 1 if $has_binary_data;
|
||||
}
|
||||
$me->d->{error}{has_abstract_in_pod} = join ';', @errors if @errors;
|
||||
}
|
||||
|
||||
# adapted from ExtUtils::MM_Unix and Module::Build::PodParser
|
||||
sub _parse_abstract {
|
||||
my ($class, $file) = @_;
|
||||
my ($package, $abstract);
|
||||
my $inpod = 0;
|
||||
open my $fh, '<', $file or return;
|
||||
my $directive;
|
||||
my $encoding;
|
||||
my $package_name_pattern = '(?:[A-Za-z0-9_]+::)*[A-Za-z0-9_]+ | [BCIF] < (?:[A-Za-z0-9_]+::)*[A-Za-z0-9_]+ >';
|
||||
if ( $file !~ /\.p(?:m|od)$/ ) {
|
||||
$package_name_pattern .= ' | [A-Za-z0-9_.-]+ | [BCIF] < [A-Za-z0-9_.-]+ >';
|
||||
}
|
||||
while(<$fh>) {
|
||||
if (/^\s*__DATA__\s*$/) {
|
||||
my $copy = $_ = <$fh>;
|
||||
last unless defined $copy;
|
||||
return (undef, undef, undef, 1) if is_binary($copy);
|
||||
}
|
||||
if (substr($_, 0, 1) eq '=') {
|
||||
if (/^=encoding\s+(.+)/) {
|
||||
$encoding = $1;
|
||||
}
|
||||
if (/^=cut/) {
|
||||
$inpod = 0;
|
||||
} elsif (/^=(?!cut)(.+)/) {
|
||||
$directive = $1;
|
||||
$inpod = 1;
|
||||
}
|
||||
}
|
||||
next if !$inpod;
|
||||
next unless $directive =~ /^head/;
|
||||
if ( /^\s*(${package_name_pattern}) \s+ -+ (?:\s+ (.*)\s*$|$)/x ) {
|
||||
($package, $abstract) = ($1, $2);
|
||||
$package =~ s![BCIF]<([^>]+)>!$1!;
|
||||
next;
|
||||
}
|
||||
next unless $abstract;
|
||||
last if /^\s*$/ || /^=/;
|
||||
s/\s+$//s;
|
||||
$abstract .= "\n$_";
|
||||
}
|
||||
|
||||
my $error;
|
||||
if ($encoding && $abstract) {
|
||||
my $encoder = find_encoding($encoding);
|
||||
if (!$encoder) {
|
||||
$error = "unknown encoding: $encoding";
|
||||
} else {
|
||||
$abstract = eval { $encoder->decode($abstract) };
|
||||
if ($@) {
|
||||
$error = $@;
|
||||
$error =~ s|\s*at .+ line \d+.+$||s;
|
||||
}
|
||||
}
|
||||
}
|
||||
return ($package, $abstract, $error);
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'has_abstract_in_pod',
|
||||
error => q{No abstract (short description of a module) is found in pod from this distribution.},
|
||||
remedy => q{Provide a short description in the NAME section of the pod (after the module name followed by a hyphen) at least for the main module of this distribution.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
return 0 if $d->{error}{has_abstract_in_pod};
|
||||
my @abstracts = grep {defined $_ && length $_} values %{$d->{abstracts_in_pod} || {}};
|
||||
return @abstracts ? 1 : 0;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
return "No abstracts in pod";
|
||||
},
|
||||
},
|
||||
{
|
||||
name => 'no_abstract_stub_in_pod',
|
||||
is_extra => 1,
|
||||
error => q{A well-known abstract stub (typically generated by an authoring tool) is found in this distribution.},
|
||||
remedy => q{Modify the stub. You might need to modify other stubs (for name, synopsis, license, etc) as well.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my %mapping = map {$_ => 1} @ABSTRACT_STUBS;
|
||||
my @errors;
|
||||
for (sort keys %{$d->{abstracts_in_pod} || {}}) {
|
||||
push @errors, $_ if $mapping{$d->{abstracts_in_pod}{$_} || ''};
|
||||
}
|
||||
if (@errors) {
|
||||
$d->{error}{no_abstract_stub_in_pod} = join ',', @errors;
|
||||
}
|
||||
return @errors ? 0 : 1;
|
||||
},
|
||||
details => sub {
|
||||
my $d = shift;
|
||||
my %mapping = map {$_ => 1} @ABSTRACT_STUBS;
|
||||
return "Abstracts in the following packages are stubs:". $d->{error}{no_abstract_stub_in_pod};
|
||||
},
|
||||
},
|
||||
];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Pod - Check Pod
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Some of the check in this module has moved to L<Module::CPANTS::SiteKwalitee::Pod|https://github.com/cpants/Module-CPANTS-SiteKwalitee> to double-check the pod correctness on the server side.
|
||||
|
||||
If you do care, it is recommended to add a test to test pod (with L<Test::Pod>) in "xt/" directory in your distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Parses pod to see if it has a proper abstract.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=over 4
|
||||
|
||||
=item * has_abstract_in_pod
|
||||
|
||||
=item * no_abstract_stub_in_pod
|
||||
|
||||
=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.
|
||||
348
database/perl/lib/Module/CPANTS/Kwalitee/Prereq.pm
Normal file
348
database/perl/lib/Module/CPANTS/Kwalitee/Prereq.pm
Normal file
@@ -0,0 +1,348 @@
|
||||
package Module::CPANTS::Kwalitee::Prereq;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use Text::Balanced qw/extract_bracketed/;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
$class->_from_meta($me) or
|
||||
$class->_from_cpanfile($me) or
|
||||
$class->_from_build_pl($me) or
|
||||
$class->_from_makefile_pl($me) or
|
||||
$class->_from_dist_ini($me);
|
||||
}
|
||||
|
||||
sub _from_meta {
|
||||
my ($class, $me) = @_;
|
||||
my $meta = $me->d->{meta_yml};
|
||||
return unless $meta && ref $meta eq ref {};
|
||||
|
||||
my $spec = $meta->{'meta-spec'};
|
||||
my %res;
|
||||
if ($spec && ref $spec eq ref {} && ($spec->{version} || 0) =~ /^(\d+)/ && $1 >= 2) {
|
||||
# meta spec ver2
|
||||
my $prereqs = $meta->{prereqs};
|
||||
|
||||
%res = $class->_handle_prereqs_v2($meta->{prereqs});
|
||||
} else {
|
||||
# meta spec ver1
|
||||
my %map = (
|
||||
requires => 'is_prereq',
|
||||
build_requires => 'is_build_prereq',
|
||||
recommends => 'is_optional_prereq',
|
||||
);
|
||||
for my $rel (qw/requires recommends build_requires configure_requires conflicts/) {
|
||||
if ($meta->{$rel} && ref $meta->{$rel} eq ref {}) {
|
||||
my $prereqs_r = $meta->{$rel};
|
||||
next unless $prereqs_r && ref $prereqs_r eq ref {};
|
||||
for my $module (keys %$prereqs_r) {
|
||||
my $type = $rel =~ /_/ ? $rel : "runtime_$rel";
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $prereqs_r->{$module},
|
||||
type => $type,
|
||||
($map{$rel} ? ($map{$rel} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# TODO: optional_features handling
|
||||
}
|
||||
|
||||
return unless %res;
|
||||
$me->d->{prereq} = [sort {$a->{requires} cmp $b->{requires}} map {@$_} values %res];
|
||||
$me->d->{got_prereq_from} = 'META.yml';
|
||||
}
|
||||
|
||||
sub _from_cpanfile {
|
||||
my ($class, $me) = @_;
|
||||
|
||||
my $cpanfile = catfile($me->distdir, "cpanfile");
|
||||
return unless -f $cpanfile;
|
||||
eval { require Module::CPANfile; 1 };
|
||||
return if $@;
|
||||
my $prereqs = Module::CPANfile->load($cpanfile)->prereqs->as_string_hash;
|
||||
my %res = $class->_handle_prereqs_v2($prereqs);
|
||||
return unless %res;
|
||||
|
||||
$me->d->{prereq} = [sort {$a->{requires} cmp $b->{requires}} map {@$_} values %res];
|
||||
$me->d->{got_prereq_from} = 'cpanfile';
|
||||
}
|
||||
|
||||
sub _from_build_pl {
|
||||
my ($class, $me) = @_;
|
||||
|
||||
my $build_pl_file = catfile($me->distdir, "Build.PL");
|
||||
return unless -f $build_pl_file;
|
||||
|
||||
my $build_pl = do { local $/; open my $fh, '<', $build_pl_file; <$fh> };
|
||||
return unless $build_pl;
|
||||
|
||||
my %map = (
|
||||
requires => 'is_prereq',
|
||||
build_requires => 'is_build_prereq',
|
||||
test_requires => 'is_build_prereq',
|
||||
recommends => 'is_optional_prereq',
|
||||
);
|
||||
my %res;
|
||||
# TODO: auto_features
|
||||
while($build_pl =~ s/^.*?((?:(?:configure|build|test)_)?requires|recommends|conflicts)\s*=>\s*\{/{/s) {
|
||||
my $rel = $1;
|
||||
my ($block, $left) = extract_bracketed($build_pl, '{}');
|
||||
last unless $block;
|
||||
|
||||
my $hashref = do { no strict; no warnings; eval $block }; ## no critic
|
||||
if ($hashref && ref $hashref eq ref {}) {
|
||||
for my $module (keys %$hashref) {
|
||||
my $type = $rel =~ /_/ ? $rel : "runtime_$rel";
|
||||
my ($version) = ($hashref->{$module} || 0) =~ /^([0-9.]+)/;
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $version,
|
||||
type => $type,
|
||||
($map{$rel} ? ($map{$rel} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
$build_pl = $left;
|
||||
}
|
||||
$me->d->{prereq} = [sort {$a->{requires} cmp $b->{requires}} map {@$_} values %res];
|
||||
$me->d->{got_prereq_from} = 'Build.PL';
|
||||
}
|
||||
|
||||
sub _from_makefile_pl {
|
||||
my ($class, $me) = @_;
|
||||
|
||||
my $distdir = $me->distdir;
|
||||
my %map = (
|
||||
PREREQ_PM => 'is_prereq',
|
||||
BUILD_REQUIRES => 'is_build_prereq',
|
||||
TEST_REQUIRES => 'is_build_prereq',
|
||||
);
|
||||
|
||||
# There may be multiple Makefile.PLs in a distribution
|
||||
my %res;
|
||||
for my $file (@{$me->d->{files_array} || []}) {
|
||||
next unless $file =~ /Makefile\.PL$/;
|
||||
my $makefile_pl_file = catfile($distdir, $file);
|
||||
next unless -f $makefile_pl_file;
|
||||
|
||||
my $makefile_pl = do { local $/; open my $fh, '<', $makefile_pl_file; <$fh> };
|
||||
next unless $makefile_pl;
|
||||
|
||||
if ($makefile_pl =~ /use\s+inc::Module::Install/) {
|
||||
# Module::Install
|
||||
|
||||
# TODO
|
||||
while($makefile_pl =~ s/(?:^|;).+?((?:(?:configure|build|test)_)?requires|recommends)\s*([^;]+);//s) {
|
||||
my ($rel, $tuple_text) = ($1, $2);
|
||||
my @tuples = do { no strict; no warnings; eval $tuple_text }; ## no critic
|
||||
my $type = $rel =~ /_/ ? $rel : "runtime_$rel";
|
||||
while(@tuples) {
|
||||
my $module = shift @tuples or last;
|
||||
my $version = shift @tuples || 0;
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $version,
|
||||
type => $type,
|
||||
($map{$rel} ? ($map{$rel} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# EUMM
|
||||
while($makefile_pl =~ s/^.*?((?:BUILD|TEST)_REQUIRES|PREREQ_PM)\s*=>\s*\{/{/s) {
|
||||
my $rel = $1;
|
||||
my ($block, $left) = extract_bracketed($makefile_pl, '{}');
|
||||
last unless $block;
|
||||
|
||||
my $hashref = do { no strict; no warnings; eval $block }; ## no critic
|
||||
if ($hashref && ref $hashref eq ref {}) {
|
||||
for my $module (keys %$hashref) {
|
||||
my $type = $rel eq 'PREREQ_PM' ? "runtime_requires" : lc $rel;
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $hashref->{$module},
|
||||
type => $type,
|
||||
($map{$rel} ? ($map{$rel} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
$makefile_pl = $left;
|
||||
}
|
||||
}
|
||||
}
|
||||
$me->d->{prereq} = [sort {$a->{requires} cmp $b->{requires}} map {@$_} values %res];
|
||||
$me->d->{got_prereq_from} = 'Makefile.PL';
|
||||
}
|
||||
|
||||
# for META spec v2 and cpanfile
|
||||
sub _handle_prereqs_v2 {
|
||||
my ($class, $prereqs) = @_;
|
||||
|
||||
return unless $prereqs && ref $prereqs eq ref {};
|
||||
|
||||
# XXX: this mapping is for backward compat only
|
||||
my %map = (
|
||||
runtime_requires => 'is_prereq',
|
||||
build_requires => 'is_build_prereq',
|
||||
test_requires => 'is_build_prereq',
|
||||
runtime_recommends => 'is_optional_prereq',
|
||||
build_recommends => 'is_optional_prereq',
|
||||
test_recommends => 'is_optional_prereq',
|
||||
runtime_suggests => 'is_optional_prereq',
|
||||
build_suggests => 'is_optional_prereq',
|
||||
test_suggests => 'is_optional_prereq',
|
||||
);
|
||||
|
||||
my %res;
|
||||
for my $phase (keys %$prereqs) {
|
||||
my $prereqs_p = $prereqs->{$phase};
|
||||
next unless $prereqs_p && ref $prereqs_p eq ref {};
|
||||
for my $rel (keys %$prereqs_p) {
|
||||
my $prereqs_r = $prereqs_p->{$rel};
|
||||
next unless $prereqs_r && ref $prereqs_r eq ref {};
|
||||
for my $module (keys %$prereqs_r) {
|
||||
my $type = join '_', $phase, $rel;
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $prereqs_r->{$module},
|
||||
type => $type,
|
||||
($map{$type} ? ($map{$type} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
%res;
|
||||
}
|
||||
|
||||
sub _from_dist_ini {
|
||||
my ($class, $me) = @_;
|
||||
|
||||
my $inifile = catfile($me->distdir, "dist.ini");
|
||||
return unless -f $inifile;
|
||||
|
||||
eval { require Config::INI::Reader } or return;
|
||||
|
||||
my $config = Config::INI::Reader->read_file($inifile);
|
||||
return unless $config && ref $config eq ref {};
|
||||
|
||||
my %map = (
|
||||
runtime_requires => 'is_prereq',
|
||||
build_requires => 'is_build_prereq',
|
||||
test_requires => 'is_build_prereq',
|
||||
runtime_recommends => 'is_optional_prereq',
|
||||
build_recommends => 'is_optional_prereq',
|
||||
test_recommends => 'is_optional_prereq',
|
||||
runtime_suggests => 'is_optional_prereq',
|
||||
build_suggests => 'is_optional_prereq',
|
||||
test_suggests => 'is_optional_prereq',
|
||||
);
|
||||
my %res;
|
||||
for my $key (keys %$config) {
|
||||
next unless $key =~ /^Prereqs\b/;
|
||||
my ($phase, $rel) = qw(runtime requires);
|
||||
(undef, my $type) = split /\s*\/\s*/, $key, 2;
|
||||
if ($type) {
|
||||
if ($type =~ s/^(Configure|Build|Test|Runtime)//) {
|
||||
$phase = lc $1;
|
||||
}
|
||||
if ($type =~ s/^(Requires|Recommends|Suggests)//) {
|
||||
$rel = lc $1;
|
||||
}
|
||||
}
|
||||
my $conf = $config->{$key};
|
||||
next unless $conf && ref $conf eq ref {};
|
||||
if ($conf->{-phase}) {
|
||||
$phase = delete $conf->{-phase};
|
||||
}
|
||||
if ($conf->{-relationship}) {
|
||||
$rel = delete $conf->{-relationship};
|
||||
}
|
||||
for my $module (keys %$conf) {
|
||||
$type = join '_', $phase, $rel;
|
||||
push @{$res{$module} ||= []}, {
|
||||
requires => $module,
|
||||
version => $conf->{$module},
|
||||
type => $type,
|
||||
($map{$type} ? ($map{$type} => 1) : ()),
|
||||
};
|
||||
}
|
||||
}
|
||||
$me->d->{prereq} = [sort {$a->{requires} cmp $b->{requires}} map {@$_} values %res];
|
||||
$me->d->{got_prereq_from} = 'dist.ini';
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
# NOTE: The metrics in this module have moved to
|
||||
# Module::CPANTS::SiteKwalitee because these require databases.
|
||||
|
||||
return [];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Prereq - Checks listed prerequisites
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics in this module have moved to L<Module::CPANTS::SiteKwalitee::Prereq|https://github.com/cpants/Module-CPANTS-SiteKwalitee>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Find information on prerequisite distributions from meta files etc.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=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.
|
||||
81
database/perl/lib/Module/CPANTS/Kwalitee/Repackageable.pm
Normal file
81
database/perl/lib/Module/CPANTS/Kwalitee/Repackageable.pm
Normal file
@@ -0,0 +1,81 @@
|
||||
package Module::CPANTS::Kwalitee::Repackageable;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 900 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
my $class = shift;
|
||||
my $me = shift;
|
||||
|
||||
# NOTE: The analysis/metric in this module has moved to
|
||||
# Module::CPANTS::SiteKwalitee.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::Repackageable module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators{
|
||||
return [];
|
||||
}
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Lili Allen - Allright, still};
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Repackageable - Checks for various signs that make a module packageable
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics in this module have moved to L<Module::CPANTS::SiteKwalitee|https://github.com/cpants/Module-CPANTS-SiteKwalitee>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
and L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
|
||||
|
||||
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
|
||||
|
||||
You may use and distribute this module according to the same terms
|
||||
that Perl is distributed under.
|
||||
72
database/perl/lib/Module/CPANTS/Kwalitee/Signature.pm
Normal file
72
database/perl/lib/Module/CPANTS/Kwalitee/Signature.pm
Normal file
@@ -0,0 +1,72 @@
|
||||
package Module::CPANTS::Kwalitee::Signature;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
sub analyse {
|
||||
my ($class, $self) = @_;
|
||||
|
||||
# NOTE: The analysis/metric in this module has moved to
|
||||
# Module::CPANTS::SiteKwalitee because this requires an external
|
||||
# tool (though optional) and decent network connection to
|
||||
# validate a signature.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::Signature module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
}
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [];
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Signature - dist has a valid signature
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics in this module have moved to L<Module::CPANTS::SiteKwalitee::Signature|https://github.com/cpants/Module-CPANTS-SiteKwalitee>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Does nothing now.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::CPANTS::Analyse>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Lars Dɪᴇᴄᴋᴏᴡ C<< <daxim@cpan.org> >>
|
||||
|
||||
=head1 LICENCE AND COPYRIGHT
|
||||
|
||||
Copyright © 2012, Lars Dɪᴇᴄᴋᴏᴡ C<< <daxim@cpan.org> >>.
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl 5.14.
|
||||
310
database/perl/lib/Module/CPANTS/Kwalitee/Uses.pm
Normal file
310
database/perl/lib/Module/CPANTS/Kwalitee/Uses.pm
Normal file
@@ -0,0 +1,310 @@
|
||||
package Module::CPANTS::Kwalitee::Uses;
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Spec::Functions qw(catfile);
|
||||
use Perl::PrereqScanner::NotQuiteLite 0.9901;
|
||||
use List::Util 1.33 qw/none/;
|
||||
use version;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
# These equivalents should be reasonably well-known and, preferably,
|
||||
# well-documented. Don't add obscure modules used by only one person
|
||||
# or a few people, to keep the list relatively small and to encourage
|
||||
# people to use a better equivalent.
|
||||
# "use_(strict|warnings)" should fail if someone feels the need
|
||||
# to add "use $1;" in the modules.
|
||||
our @STRICT_EQUIV = qw( strict );
|
||||
our @WARNINGS_EQUIV = qw( warnings warnings::compat );
|
||||
our @STRICT_WARNINGS_EQUIV = qw(
|
||||
common::sense
|
||||
Any::Moose
|
||||
Catmandu::Sane Coat
|
||||
Dancer
|
||||
Mo Mu
|
||||
Modern::Perl
|
||||
Moo Moo::Role
|
||||
Moose Moose::Role Moose::Exporter
|
||||
Moose::Util::TypeConstraints Moose::Util::MetaRole
|
||||
MooseX::Declare MooseX::Role::Parameterized MooseX::Types
|
||||
Mouse Mouse::Role
|
||||
perl5 perl5i::1 perl5i::2 perl5i::latest
|
||||
Pegex::Base
|
||||
Role::Tiny
|
||||
strictures
|
||||
);
|
||||
# These modules require a flag to enforce strictness.
|
||||
push @STRICT_WARNINGS_EQUIV, qw(
|
||||
Mojo::Base
|
||||
Spiffy
|
||||
);
|
||||
|
||||
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_hash};
|
||||
|
||||
# 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 @test_files = grep {m!^t\b.*\.t$!} sort keys %$files;
|
||||
$me->d->{test_files} = \@test_files;
|
||||
|
||||
my %test_modules = map {
|
||||
my $m = my $f = $_;
|
||||
$m =~ s|\.pm$||;
|
||||
$m =~ s|/|::|g;
|
||||
(my $m0 = $m) =~ s|^t::(?:lib::)?||;
|
||||
($m => $f, $m0 => $f)
|
||||
} grep {m|^t\b.*\.pm$|} keys %$files;
|
||||
|
||||
my %skip=map {$_->{module}=>1 } @$modules;
|
||||
|
||||
# d->{versions} (from SiteKwalitee) knows inner packages as well
|
||||
if (my $versions = $me->d->{versions}) {
|
||||
for my $file (keys %$versions) {
|
||||
for my $module (keys %{$versions->{$file}}) {
|
||||
$skip{$module} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my %uses;
|
||||
|
||||
my $scanner = Perl::PrereqScanner::NotQuiteLite->new(
|
||||
parsers => [':bundled'],
|
||||
suggests => 1,
|
||||
recommends => 1,
|
||||
quick => 1,
|
||||
);
|
||||
|
||||
# modules
|
||||
my @module_files = map {$_->{file}} grep {!$_->{not_exists}} @$modules;
|
||||
|
||||
# Makefile.PL runs other Makefile.PL files at configure time (except ones under t)
|
||||
# Build.PL runs other *.PL files at build time
|
||||
my @configure_files = grep {/(?:^Build|\bMakefile)\.PL$/ && !/^t[\\\/]/} @{$me->d->{files_array} || []};
|
||||
my %configure_files_map = map {$_ => 1} @configure_files;
|
||||
|
||||
# Other *.PL files (including lib/Build.PL) would (probably) be run at bulid time
|
||||
my @build_files = grep {/\.PL$/ && !/^t[\\\/]/ && !$configure_files_map{$_}} @{$me->d->{files_array} || []};
|
||||
|
||||
$uses{runtime} = $class->_scan($scanner, $files, $distdir, \@module_files);
|
||||
$uses{configure} = $class->_scan($scanner, $files, $distdir, \@configure_files);
|
||||
$uses{build} = $class->_scan($scanner, $files, $distdir, \@build_files);
|
||||
$uses{test} = $class->_scan($scanner, $files, $distdir, \@test_files);
|
||||
|
||||
# See also .pm files under t (only) if they are used in .t files
|
||||
my $test_requirements = $uses{test}{requires}->as_string_hash;
|
||||
my @test_pmfiles;
|
||||
for my $module (keys %$test_requirements) {
|
||||
push @test_pmfiles, $test_modules{$module} if $test_modules{$module};
|
||||
}
|
||||
my $additional_test_requirements = $class->_scan($scanner, $files, $distdir, \@test_pmfiles);
|
||||
for my $relationship (keys %$additional_test_requirements) {
|
||||
$uses{test}{$relationship} = ($uses{test}{$relationship})
|
||||
? $uses{test}{$relationship}->add_requirements($additional_test_requirements->{$relationship})
|
||||
: $additional_test_requirements->{$relationship};
|
||||
}
|
||||
|
||||
for my $phase (keys %uses) {
|
||||
for my $relationship (keys %{$uses{$phase}}) {
|
||||
my $requirements = $uses{$phase}{$relationship}->as_string_hash;
|
||||
for my $requirement (keys %$requirements) {
|
||||
if (
|
||||
$skip{$requirement}
|
||||
or $requirement =~ /^(?:inc|t)::/
|
||||
or ($phase eq 'test' and $test_modules{$requirement})
|
||||
) {
|
||||
delete $requirements->{$requirement};
|
||||
}
|
||||
}
|
||||
if (%$requirements) {
|
||||
$uses{$phase}{$relationship} = $requirements;
|
||||
} else {
|
||||
delete $uses{$phase}{$relationship};
|
||||
}
|
||||
}
|
||||
delete $uses{$phase} unless %{$uses{$phase}};
|
||||
}
|
||||
|
||||
$me->d->{uses} = \%uses;
|
||||
return;
|
||||
}
|
||||
|
||||
sub _scan {
|
||||
my ($class, $scanner, $files_hash, $distdir, $files) = @_;
|
||||
|
||||
my @methods = qw/requires recommends suggests noes/;
|
||||
my %reqs = map {$_ => CPAN::Meta::Requirements->new} @methods;
|
||||
for my $file (@$files) {
|
||||
my $ctx = $scanner->scan_file("$distdir/$file");
|
||||
|
||||
# There may be broken files (intentionally, or unintentionally, esp in tests)
|
||||
if (@{$ctx->{errors} || []}) {
|
||||
my $error = join ',', @{$ctx->{errors}};
|
||||
$error =~ s/ at \S+ line \d+[^\n]*//gs;
|
||||
$error =~ s/Scan Error: //g;
|
||||
$files_hash->{$file}{scan_error} = $error;
|
||||
}
|
||||
|
||||
if ($ctx->{perl6}) {
|
||||
$files_hash->{$file}{perl6} = 1;
|
||||
next;
|
||||
}
|
||||
for my $method (@methods) {
|
||||
my $requirements = $ctx->$method;
|
||||
my $hash = $requirements->as_string_hash;
|
||||
next unless %$hash;
|
||||
$files_hash->{$file}{$method} = $hash;
|
||||
$reqs{$method} = $reqs{$method}->add_requirements($requirements);
|
||||
}
|
||||
}
|
||||
return \%reqs;
|
||||
}
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [
|
||||
{
|
||||
name => 'use_strict',
|
||||
error => q{This distribution does not 'use strict;' (or its equivalents) in all of its modules. Note that this is not about the actual strictness of the modules. It's bad if nobody can tell whether the modules are strictly written or not, without reading the source code of your favorite clever module that actually enforces strictness. In other words, it's bad if someone feels the need to add 'use strict' to your modules.},
|
||||
remedy => q{Add 'use strict' (or its equivalents) to all modules, or convince us that your favorite module is well-known enough and people can easily see the modules are strictly written.},
|
||||
ignorable => 1,
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my $files = $d->{files_hash} || {};
|
||||
|
||||
my $perl_version_with_implicit_stricture = version->new('5.011')->numify;
|
||||
my @no_strict;
|
||||
|
||||
for my $file (keys %$files) {
|
||||
next unless exists $files->{$file}{module};
|
||||
next if $files->{$file}{unreadable};
|
||||
next if $files->{$file}{perl6};
|
||||
next if $file =~ /\.pod$/;
|
||||
my $module = $files->{$file}{module};
|
||||
my $requires = $files->{$file}{requires} || {};
|
||||
my $required_perl = $requires->{perl};
|
||||
if (defined $required_perl) {
|
||||
$required_perl =~ s/_//; # tweak 5.008_001 and the likes for silence
|
||||
next if version->parse($required_perl)->numify >= $perl_version_with_implicit_stricture;
|
||||
}
|
||||
|
||||
# There are lots of acceptable strict alternatives
|
||||
push @no_strict, $module if none {exists $requires->{$_}} (@STRICT_EQUIV, @STRICT_WARNINGS_EQUIV);
|
||||
}
|
||||
if (@no_strict) {
|
||||
$d->{error}{use_strict} = join ", ", sort @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;' (or its equivalents) in all of its modules. Note that this is not about that your modules actually warn when something bad happens. It's bad if nobody can tell if a module warns or not, without reading the source code of your favorite module that actually enforces warnings. In other words, it's bad if someone feels the need to add 'use warnings' to your modules.},
|
||||
is_extra => 1,
|
||||
ignorable => 1,
|
||||
remedy => q{Add 'use warnings' (or its equivalents) to all modules, or convince us that your favorite module is well-known enough and people can easily see the modules warn when something bad happens.},
|
||||
code => sub {
|
||||
my $d = shift;
|
||||
my $files = $d->{files_hash} || {};
|
||||
|
||||
my @no_warnings;
|
||||
for my $file (keys %$files) {
|
||||
next unless exists $files->{$file}{module};
|
||||
next if $files->{$file}{unreadable};
|
||||
next if $files->{$file}{perl6};
|
||||
next if $file =~ /\.pod$/;
|
||||
my $module = $files->{$file}{module};
|
||||
my $requires = $files->{$file}{requires} || {};
|
||||
push @no_warnings, $module if none {exists $requires->{$_}} (@WARNINGS_EQUIV, @STRICT_WARNINGS_EQUIV);
|
||||
}
|
||||
if (@no_warnings) {
|
||||
$d->{error}{use_warnings} = join ", ", sort @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 data structure.
|
||||
|
||||
=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.
|
||||
83
database/perl/lib/Module/CPANTS/Kwalitee/Version.pm
Normal file
83
database/perl/lib/Module/CPANTS/Kwalitee/Version.pm
Normal file
@@ -0,0 +1,83 @@
|
||||
package Module::CPANTS::Kwalitee::Version;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = '1.01';
|
||||
$VERSION =~ s/_//; ## no critic
|
||||
|
||||
sub order { 100 }
|
||||
|
||||
##################################################################
|
||||
# Analyse
|
||||
##################################################################
|
||||
|
||||
sub analyse {
|
||||
# NOTE: The analysis/metrics in this module have moved to
|
||||
# Module::CPANTS::SiteKwalitee because these require
|
||||
# a finalized META file to detect (or ignore) versions
|
||||
# correctly.
|
||||
|
||||
# Note also that this stub should not be removed so that
|
||||
# this can replace the old ::Version module, and the old
|
||||
# metrics will not be loaded while loading plugins.
|
||||
}
|
||||
|
||||
|
||||
|
||||
##################################################################
|
||||
# Kwalitee Indicators
|
||||
##################################################################
|
||||
|
||||
sub kwalitee_indicators {
|
||||
return [];
|
||||
}
|
||||
|
||||
|
||||
q{Favourite record of the moment:
|
||||
Fat Freddys Drop: Based on a true story};
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::CPANTS::Kwalitee::Version - check versions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The metrics in this module have moved to L<Module::CPANTS::SiteKwalitee::Version|https://github.com/cpants/Module-CPANTS-SiteKwalitee>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=head3 order
|
||||
|
||||
Defines the order in which Kwalitee tests should be run.
|
||||
|
||||
Returns C<100>.
|
||||
|
||||
=head3 analyse
|
||||
|
||||
Does nothing now.
|
||||
|
||||
=head3 kwalitee_indicators
|
||||
|
||||
Returns the Kwalitee Indicators data structure.
|
||||
|
||||
=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.
|
||||
Reference in New Issue
Block a user