view release on metacpan or  search on metacpan

lib/Test/Reporter/Transport/Metabase.pm  view on Meta::CPAN

use 5.006;
use warnings;
use strict;
package Test::Reporter::Transport::Metabase;
# ABSTRACT: Metabase transport for Test::Reporter

our $VERSION = '1.999010';

use Test::Reporter::Transport 1.57 ();
our @ISA = qw/Test::Reporter::Transport/;

use Carp                            ();
use Config::Perl::V                 ();
use CPAN::Testers::Report     1.999001 ();
use File::Glob                      ();
use JSON::MaybeXS;
use Metabase::User::Profile   0.016 ();
use Metabase::User::Secret    0.016 ();
use Metabase::Client::Simple  0.008 ();

#--------------------------------------------------------------------------#
# argument definitions
#--------------------------------------------------------------------------#

my %default_args = (
  client => 'Metabase::Client::Simple'
);
my @allowed_args = qw/uri id_file client/;
my @required_args = qw/uri id_file/;

#--------------------------------------------------------------------------#
# new
#--------------------------------------------------------------------------#

sub new {
  my $class = shift;
  Carp::confess __PACKAGE__ . " requires transport args in key/value pairs\n"
    if @_ % 2;
  my %args = ( %default_args, @_ );
 
  for my $k ( @required_args ) {
    Carp::confess __PACKAGE__ . " requires $k argument\n"
      unless exists $args{$k};
  }

  for my $k ( keys %args ) {
    Carp::confess __PACKAGE__ . " unknown argument '$k'\n"
      unless grep { $k eq $_ } @allowed_args;
  }

  return bless \%args => $class;
}

#--------------------------------------------------------------------------#
# send
#--------------------------------------------------------------------------#

sub send {
  my ($self, $report) = @_;

  unless ( eval { $report->distfile } ) {
    Carp::confess __PACKAGE__ . ": requires the 'distfile' parameter to be set\n"
      . "Please update CPAN::Reporter and/or CPANPLUS to a version that provides \n"
      . "this information to Test::Reporter.  Report will not be sent.\n";
  }

  my ($profile, $secret) = $self->_load_id_file;

  # Load specified metabase client.
  my $class = $self->{client};
  eval "require $class"  
      or Carp::confess __PACKAGE__ . ": could not load client '$class':\n$@\n";

  my $client = $class->new(
    uri => $self->{uri},
    profile => $profile,
    secret => $secret,
  );

  # Get facts about Perl config that Test::Reporter doesn't capture
  # Unfortunately we can't do this from the current perl in case this
  # is a report regenerated from a file and isn't the perl that the report
  # was run on
  my $perlv = $report->{_perl_version}->{_myconfig};
  my $config = Config::Perl::V::summary(Config::Perl::V::plv2hash($perlv));
  my $perl_version = $report->{_perl_version}{_version} || $config->{version};

  # Build CPAN::Testers::Report with its various component facts.
  my $metabase_report = CPAN::Testers::Report->open(
    resource => 'cpan:///distfile/' . $report->distfile
  );

  $metabase_report->add( 'CPAN::Testers::Fact::LegacyReport' => {
    grade         => $report->grade,
    osname        => $config->{osname},
    osversion     => $report->{_perl_version}{_osvers},
    archname      => $report->{_perl_version}{_archname},
    perl_version  => $perl_version,
    textreport    => $report->report
  });

  # TestSummary happens to be the same as content metadata 
  # of LegacyReport for now
  $metabase_report->add( 'CPAN::Testers::Fact::TestSummary' =>
    [$metabase_report->facts]->[0]->content_metadata()
  );
    
  # XXX wish we could fill these in with stuff from CPAN::Testers::ParseReport
  # but it has too many dependencies to require for T::R::Transport::Metabase.
  # Could make it optional if installed?  Will do this for the offline NNTP 
  # archive conversion, so maybe wait until that is written then move here and