view release on metacpan or  search on metacpan

inc/expand_author_list.pm  view on Meta::CPAN

use 5.014;    # /r modifier
use strict;
use warnings;

package expand_author_list;

# ABSTRACT: Expand a DATA section into a CPAN Authors list

# AUTHORITY

use HTTP::Tiny;
use Parse::CPAN::Whois;
use Acme::CPANAuthors::Factory;
use JSON::MaybeXS 1.001000;
use Path::Tiny qw(path);
use HTML::Entities;
use Math::Random::MT;

sub tempdir { return state $tempdir = Path::Tiny->tempdir() }
sub http    { return state $http    = HTTP::Tiny->new() }
sub json    { return state $json    = JSON::MaybeXS->new( utf8 => 0 ) }

sub rng {
  return state $rng = Math::Random::MT->new( map { unpack 'L', $_ } q[Kent], q[ is ], q[a du], q[ll b], q[oy  ] );
}

sub dolog { *STDERR->print("$_[0]\n") }

sub mirror_whois {
  my ($filename) = @_;
  my $out = tempdir()->child($filename);
  dolog("Fetching $filename to $out");
  my $response = http()->mirror( 'http://www.cpan.org/authors/' . $filename, $out );
  die "failed to fetch $filename: $response->{status} $response->{reason}\n"
    if not $response->{success} and $response->{status} ne '304';
  return "$out";
}

sub get_gravatar_url {
  my ($authorid) = @_;
  dolog("Resolving Gravatar for $authorid");
  my $request = http()->get( 'http://api.metacpan.org/v0/author/' . $authorid ) // {};
  my $content = $request->{content}                                             // {};
  my $json    = json()->decode($content);
  my $url     = $json->{gravatar_url};
  $url =~ s/s=\K130/80/g;
  return $url;
}

sub extract_data {
  state $result_cache = {};
  my ( $category, $source_file ) = @_;
  return $result_cache->{$category} if exists $result_cache->{$category};

  my $author_data = Parse::CPAN::Whois->new( mirror_whois('00whois.xml') );

  my $author_hash = {};
  my @authors;

  for my $id ( path($source_file)->lines_raw( { chomp => 1 } ) ) {
    dolog("$category / $id");
    my $name = $author_data->author($id)->name;
    $author_hash->{$id} = $name;
    push @authors,
      {
      id     => $id,
      name   => $name,