Group
Extension

App-cpanm-meta-checker/lib/App/cpanm/meta/checker/State.pm

use 5.006;    # our
use strict;
use warnings;

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

our $VERSION = '0.001002';

# ABSTRACT: Shared state for a single test run

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

use Moo qw(has);
use Carp qw(croak);
use CPAN::Meta;
use CPAN::Meta::Check qw(verify_dependencies);
use App::cpanm::meta::checker::State::Duplicates;
use Path::Tiny qw(path);





has 'tests' => (
  is       => ro =>,
  lazy     => 1,
  required => 1,
);





has 'list_fd' => (
  is      => ro =>,
  lazy    => 1,
  builder => sub {
    \*STDERR;
  },
);

has '_duplicates' => (
  is      => ro =>,
  lazy    => 1,
  builder => sub {
    return App::cpanm::meta::checker::State::Duplicates->new();
  },
);

sub _output {
  my ( $self, $prefix, $message ) = @_;
  return $self->list_fd->printf( qq[%s: %s\n], $prefix, $message );
}





sub x_test_list {
  my ( $self, $path, ) = @_;
  return $self->_output( 'list', path($path)->basename );
}





sub x_test_list_nonempty {
  my ( $self, $path ) = @_;
  return unless path($path)->children;
  return $self->_output( 'list_nonempty', path($path)->basename );
}





sub x_test_list_empty {
  my ( $self, $path ) = @_;
  return if path($path)->children;
  return $self->_output( 'list_empty', path($path)->basename );
}

## no critic (Compatibility::PerlMinimumVersionAndWhy)
# _Pulp__5010_qr_m_propagate_properly
my $distversion_re = qr{
    \A
    (.*)
    -
    (
        [^-]+
        (?:-TRIAL)?
    )
    \z
}msx;





sub x_test_list_duplicates {
  my ( $self, $path ) = @_;
  my $basename = path($path)->basename;
  my ( $dist, $version ) = $basename =~ $distversion_re;
  $self->_duplicates->seen_dist_version( $dist, $version );

  return unless $self->_duplicates->has_duplicates($dist);

  my $label = 'list_duplicates';
  my $fmt   = '%s-%s';

  if ( $self->_duplicates->reported_duplicates($dist) ) {
    $self->_output( $label, sprintf $fmt, $dist, $version );
    return;
  }

  $self->_output( $label, sprintf $fmt, $dist, $_ ) for $self->_duplicates->duplicate_versions($dist);

  $self->_duplicates->reported_duplicates( $dist, 1 );

  return;
}

sub _cache_cpan_meta {
  my ( undef, $path, $state ) = @_;
  return $state->{cpan_meta} if defined $state->{cpan_meta};
  return ( $state->{cpan_meta} = CPAN::Meta->load_file( path($path)->child('MYMETA.json') ) );
}

sub _cpan_meta_check_phase_type {
  my ( $self, %args ) = @_;
  my $meta = $self->_cache_cpan_meta( $args{path}, $args{state} );
  for my $dep ( verify_dependencies( $meta, $args{phase}, $args{type} ) ) {
    $self->_output( $args{label}, ( sprintf '%s: %s', path( $args{path} )->basename, $dep ) );
  }
  return;
}











































for my $phase (qw( runtime configure build develop test )) {
  for my $rel (qw( requires suggests conflicts recommends )) {
    my $method = 'x_test_check_' . $phase . '_' . $rel;

    my $code = sub {
      my ( $self, $path, $state ) = @_;
      return $self->_cpan_meta_check_phase_type(
        path  => $path,
        state => $state,
        label => ( 'check_' . $phase . '_' . $rel ),
        phase => $phase,
        type  => $rel,
      );
    };
    {
      ## no critic (TestingAndDebugging::ProhibitNoStrict)
      no strict 'refs';
      *{$method} = $code;
    }
  }
}









sub check_path {
  my ( $self, $path ) = @_;
  my $state = {};
  for my $test ( @{ $self->tests } ) {
    my $method = 'x_test_' . $test;
    if ( not $self->can($method) ) {
      return croak("no method $method for test $test");
    }
    $self->$method( $path, $state );
  }
  return;
}

no Moo;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::cpanm::meta::checker::State - Shared state for a single test run

=head1 VERSION

version 0.001002

=head1 METHODS

=head2 C<x_test_list>

=head2 C<x_test_list_nonempty>

=head2 C<x_test_list_empty>

=head2 C<x_test_list_duplicates>

=head2 C<x_test_check_runtime_requires>

=head2 C<x_test_check_runtime_suggests>

=head2 C<x_test_check_runtime_conflicts>

=head2 C<x_test_check_runtime_recommends>

=head2 C<x_test_check_configure_requires>

=head2 C<x_test_check_configure_suggests>

=head2 C<x_test_check_configure_conflicts>

=head2 C<x_test_check_configure_recommends>

=head2 C<x_test_check_build_requires>

=head2 C<x_test_check_build_suggests>

=head2 C<x_test_check_build_conflicts>

=head2 C<x_test_check_build_recommends>

=head2 C<x_test_check_develop_requires>

=head2 C<x_test_check_develop_suggests>

=head2 C<x_test_check_develop_conflicts>

=head2 C<x_test_check_develop_recommends>

=head2 C<x_test_check_test_requires>

=head2 C<x_test_check_test_suggests>

=head2 C<x_test_check_test_conflicts>

=head2 C<x_test_check_test_recommends>

=head2 C<check_path>

    ->check_path('./foo/bar/baz');

Read the content from C<./foo/bar/baz> and check its consistency.

=head1 ATTRIBUTES

=head2 C<tests>

=head2 C<list_fd>

=head1 AUTHOR

Kent Fredric <kentnl@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Kent Fredric <kentfredric@gmail.com>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.