view release on metacpan or  search on metacpan

lib/App/cpanminus/reporter.pm  view on Meta::CPAN

package App::cpanminus::reporter;

use warnings;
use strict;

our $VERSION = '0.22';

use Carp ();
use File::Spec     3.19;
use Test::Reporter 1.54;
use CPAN::Testers::Common::Client 0.13;
use CPAN::Testers::Common::Client::Config;
use Parse::CPAN::Meta;
use CPAN::Meta::Converter;
use Try::Tiny;
use URI;
use Metabase::Resource;
use Capture::Tiny qw(capture);
use IO::Prompt::Tiny ();

sub new {
  my ($class, %params) = @_;
  my $self = bless {}, $class;

  $self->config(
    CPAN::Testers::Common::Client::Config->new(
      prompt => sub { local %ENV; IO::Prompt::Tiny::prompt(@_) },
    )
  );

  if ($params{cpanm}) {
    my $cpanm = $self->_cpanm( $params{cpanm} );
    $params{only} =~ s/-\d+(\.\d+)*$//; # strip version from cpanm's "only" data

    # FIXME: cpanm doesn't provide an accessor here, so
    # we break encapsulation in order to make sure we
    # always have the right paths.
    $params{build_dir}     = $cpanm->{home};
    $params{build_logfile} = $cpanm->{log};
  }

  $self->build_dir(
    $params{build_dir}
      || File::Spec->catdir( _home(), '.cpanm' )
  );

  $self->build_logfile(
    $params{build_logfile}
      || File::Spec->catfile( $self->build_dir, 'build.log' )
  );

  $self->max_age($params{max_age} || 30);

  foreach my $option ( qw(quiet verbose force exclude only dry-run skip-history ignore-versions all) ) {
    my $method = $option;
    $method =~ s/\-/_/g;
    $self->$method( $params{$option} ) if exists $params{$option};
  }

  return $self;
}

sub setup { shift->config->setup }

## basic accessors ##

sub author {
  my ($self, $author) = @_;
  $self->{_author} = $author if $author;
  return $self->{_author};
}

sub distfile {
  my ($self, $distfile) = @_;
  $self->{_distfile} = $distfile if $distfile;
  return $self->{_distfile};
}

sub config {
  my ($self, $config) = @_;
  $self->{_config} = $config if $config;
  return $self->{_config};
}

sub verbose {
  my ($self, $verbose) = @_;
  $self->{_verbose} = $verbose if $verbose;

lib/App/cpanminus/reporter.pm  view on Meta::CPAN

sub skip_history {
    my ($self, $skip) = @_;
    $self->{_skip_history} = $skip if $skip;
    $self->{_skip_history};
}

sub only {
  my ($self, $only) = @_;
  if ($only) {
    $only =~ s/::/-/g;
    my @modules = split /\s*,\s*/, $only;
    foreach (@modules) { $_ =~ s/(\S+)-[\d.]+$/$1/ };

    $self->{_only} = { map { $_ => 0 } @modules };
  }
  return $self->{_only};
}

sub exclude {
  my ($self, $exclude) = @_;
  if ($exclude) {
    $exclude =~ s/::/-/g;
    my @modules = split /\s*,\s*/, $exclude;
    foreach (@modules) { $_ =~ s/(\S+)-[\d.]+$/$1/ };

    $self->{_exclude} = { map { $_ => 0 } @modules };
  }
  return $self->{_exclude};
}

sub build_dir {
  my ($self, $dir) = @_;
  $self->{_build_dir} = $dir if $dir;
  return $self->{_build_dir};
}

sub build_logfile {
  my ($self, $file) = @_;
  $self->{_build_logfile} = $file if $file;
  return $self->{_build_logfile};
}

sub _cpanm {
  my ($self, $cpanm) = @_;
  $self->{_cpanm_object} = $cpanm if $cpanm;
  return $self->{_cpanm_object};
}

sub _check_cpantesters_config_data {
  my $self     = shift;
  my $config   = $self->config;
  my $filename = $config->get_config_filename;

  if (-e $filename) {
    if (!$config->read) {
      print "Error reading CPAN Testers configuration file '$filename'. Aborting.";
      return;
    }
  }
  else {
    my $answer = IO::Prompt::Tiny::prompt("CPAN Testers configuration file '$filename' not found. Would you like to set it up now? (y/n)", 'y');

    if ( $answer =~ /^y/i ) {
      $config->setup;
    }
    else {
      print "The CPAN Testers configuration file is required. Aborting.\n";
      return;
    }
  }
  return 1;
}

# Returns 1 if log is fresh enough, 0 if it is too old.
sub _check_build_log {
  my ($self, $build_logfile) = @_;

  my $max_age = $self->max_age;

  # as a safety mechanism, we only let people parse build.log files
  # if they were generated up to 30 minutes (1800 seconds) ago,
  # unless the user asks us to --force it.
  my $mtime = (stat $build_logfile)[9];
  my $age_in_minutes = int((time - $mtime) / 60);
  if ( !$self->force && $mtime && $age_in_minutes > $max_age ) {
    if($self->all) {
      print "Skipping $build_logfile, too old (modified $age_in_minutes minutes ago > $max_age)."
    } else {
      print <<"EOMESSAGE";
$build_logfile is too old (created $age_in_minutes minutes ago).

As a standalone tool, it is important that you run cpanm-reporter as
soon as you finish cpanm, otherwise your system data may have changed,
from new libraries to a completely different perl binary.

Because of that, this app will *NOT* parse build.log files which are
too old (by default: which are last modified more than 30 minutes ago).

You can override this behaviour by touching the file, passing
--max-age option or --force flag, but please take good care to avoid
sending bogus reports.
EOMESSAGE
    }
    return;
  }
  return 1;
}

sub _get_logfiles {
  my ($self) = @_;
  my @files;
  if ($self->all) {
    my $workdir = File::Spec->catdir($self->build_dir, 'work');
    if (-e $workdir) {
      opendir my $dh, $workdir or return ();
      my @children = grep { $_ ne '.' && $_ ne '..' } readdir $dh;
      closedir $dh;
      foreach my $child (@children) {
        my $logfile = File::Spec->catfile($workdir, $child, 'build.log');
        if (-e $logfile && !-d _) {
          push @files, $logfile;