File Coverage

blib/lib/App/cpanm/meta/checker.pm

Criterion	Covered	Total	%
statement	26	90	28.8
branch	0	12	0.0
condition			n/a
subroutine	9	25	36.0
pod	9	9	100.0
total	44	136	32.3

use 5.006;    # our
use strict;
use warnings;

package App::cpanm::meta::checker;

our $VERSION = '0.001002';

# ABSTRACT: Verify and sanity check your installation verses cpanm meta files

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY








































































use Moo 1.000008 ('has');
use Path::Tiny qw( path );
use App::cpanm::meta::checker::State;
use Config qw(%Config);
use Carp qw(croak);
use Getopt::Long;





has 'search_dirs' => (
  is      => 'ro',
  lazy    => 1,
  builder => sub {
    my @paths;
    push @paths, path( $Config{sitelibexp} )->child( $Config{archname} )->child('.meta');
    return \@paths;
  },
);









sub all_search_dirs {
  my ($self) = @_;
  return @{ $self->search_dirs };
}














sub all_search_dir_child {
  my ( $self, @childpath ) = @_;
  my @answers = grep { -e }
    map { path($_)->child(@childpath) } @{ $self->search_dirs };
  return @answers unless $self->sorted;
  return @{ [ sort @answers ] };
}
















sub all_search_dir_children {
  my ($self) = @_;
  my @answers = map { path($_)->children } @{ $self->search_dirs };
  return @answers unless $self->sorted;
  return @{ [ sort @answers ] };
}














has 'tests' => (
  is      => ro =>,
  lazy    => 1,
  builder => sub {
    return [
      'list_empty',               'list_duplicates',        'check_runtime_requires',
      'check_runtime_recommends', 'check_runtime_suggests', 'check_runtime_conflicts',
    ];
  },
);















has 'sorted' => (
  is      => ro  =>,
  lazy    => 1,
  builder => sub { return; },
);













has 'mode' => (
  is      => ro  =>,
  lazy    => 1,
  builder => sub { return 'all' },
);









sub check_path {
  my ( $self, $path ) = @_;
  my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
  return $state->check_path($path);
}









sub check_release {
  my ( $self, $releasename ) = @_;
  my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
  for my $dir ( $self->all_search_dir_child($releasename) ) {
    $state->check_path($dir);
  }
  return;
}











sub check_distname {
  my ( $self, $distname ) = @_;
  my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );

  ## no critic (Compatibility::PerlMinimumVersionAndWhy)
  # _Pulp__5010_qr_m_propagate_properly
  my $distname_re = qr{
       \A
       \Q$distname\E
       -
       [^-]+
       (?:TRIAL)?
       \z
    }msx;

  for my $dir ( grep { path($_)->basename =~ $distname_re } $self->all_search_dir_children ) {
    $state->check_path($dir);
  }
  return;
}









sub check_all {
  my ($self) = @_;

  my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
  for my $dir ( $self->all_search_dir_children ) {
    $state->check_path($dir);
  }
  return;
}









sub run_command {
  my ($self) = @_;
  return $self->check_all if 'all' eq $self->mode;
  return;
}

































sub new_from_command {
  my ( $class, %defaults ) = @_;

  my $config = {};
  my $verbose;

  Getopt::Long::Configure( 'auto_version', 'auto_help' );

  Getopt::Long::GetOptions(
    's|sort!'  => \$config->{sorted},
    'A|all!'   => sub { $config->{mode} = 'all' },
    'verbose!' => sub {
      $verbose = $_[0];
    },
    'test=s' => sub {
      if ( not App::cpanm::meta::checker::State->can( 'x_test_' . $_[1] ) ) {
        croak("No such test $_[1]");
      }
      push @{ $config->{tests} }, $_[1];
    },
  ) or croak(Getopt::Long::HelpMessage);

  my $app_obj = $class->new( +{ %defaults, %{$config} } );
  if ($verbose) {
    unshift @{ $app_obj->tests }, 'list';
  }
  return $app_obj;
}
1;

__END__