nntp2fact.pl

#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
use DDS;
use JSON::XS;
use File::Slurp qw/read_file write_file/;
use Parse::CPAN::Authors;
use aliased 'CPAN::Testers::Common::Article';
use aliased 'CPAN::Testers::Report';

#--------------------------------------------------------------------------#

my $suffix_re = qr{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)\z};

my $mailrc = "/srv/minicpan/authors/01mailrc.txt.gz";
my $index_file = "backpan_index.json";

my $file = shift or die "usage: $0 <file>";

#--------------------------------------------------------------------------#

my $dv_index;

if ( -f $index_file ) {
  $dv_index = decode_json( scalar read_file($index_file) ) ;
}
else {
  say "Indexing BackPAN releases...";
  $ENV{SCHEMA_LOADER_BACKCOMPAT} = 1;
  require BackPAN::Index;
  my $bp = BackPAN::Index->new;

  my $rels = $bp->releases;

  while ( my $r = $rels->next ) {
    $dv_index->{$r->distvname}{$r->cpanid} = $r->path->path;
  }
  
  write_file($index_file, encode_json($dv_index) );
}

my $mrc = Parse::CPAN::Authors->new($mailrc);

sub find_distfile {
  my ($dvname, $text) = @_;
  my $path;
  return '' unless my $authors = $dv_index->{$dvname};
  if ( scalar keys %$authors == 1 ) {
    ($path) = values( %$authors );
  }
  else {
    for my $cpanid ( keys %$authors ) {
      my ($salutation) = $text =~ /Dear ([^\n]+)\n/ms;
      my $author = $mrc->author($cpanid)->name;
      $author = $cpanid unless defined $author && length $author;
      last unless defined $salutation;
      if ( $salutation =~ m{$cpanid|\Q$author\E} ) {
        $path = $authors->{$cpanid};
        last;
      }
    }
  }
  return '' unless $path;
  $path =~ s{authors/id/./../}{};
  return $path;
}

#--------------------------------------------------------------------------#

my $text = read_file( $file );

my $article = Article->new($text);

die "Not a valid article" unless $article->parse_report;

my $dvname = $article->distribution . "-" . $article->version;
my $distfile = find_distfile($dvname, $article->body);

my $report = Report->open(
  resource => "cpan:///distfile/$distfile" 
);

$report->add( 'CPAN::Testers::Fact::LegacyReport' => {
  grade         => $article->status,
  osname        => $article->osname,
  osversion     => $article->osvers,
  archname      => $article->archname,
  perl_version  => $article->perl,
  textreport    => $article->cooked,
});

# TestSummary happens to be the same as content metadata 
# of LegacyReport for now
$report->add( 'CPAN::Testers::Fact::TestSummary' =>
  [$report->facts]->[0]->content_metadata()
);
  
$report->close();

Dump $report;