Compare dual-life to MetaCPAN

compare2metacpan.pl

use strict;
use warnings;
use CPAN::DistnameInfo;
use JSON::PP;
use HTTP::Tiny;
use version;

my $metabase= 'http://api.metacpan.org/release/';

$|=1;

my $url = 'http://perl5.git.perl.org/perl.git/blob_plain/HEAD:/Porting/Maintainers.pl';

my $resp = HTTP::Tiny->new( )->get( $url );
die "Oh dear\n" unless $resp->{success};

my $code = $resp->{content} || die "Fuck\n";

{no strict; eval $code }

foreach my $module ( keys %Maintainers::Modules ) {
  next unless defined $Maintainers::Modules{$module}->{DISTRIBUTION};
  my $distname = $Maintainers::Modules{$module}->{DISTRIBUTION};
  next unless $distname;
  $distname = join('/', substr( $distname, 0, 1 ), substr( $distname, 0, 2 ), $distname );
  my $d = CPAN::DistnameInfo->new( $distname );
  my $cpan = _get_idx( $d->dist );
  next unless $cpan;
  next if $cpan->{maturity} and $cpan->{maturity} eq 'developer';;
  next unless _vcmp( $cpan->{version}, $d->version ) > 0;
  my $dist_file = $cpan->{download_url};
  $dist_file =~ s!http://.+?/authors/id/!!;
  print $distname, ' -> ', $dist_file, "\n";
}

exit 0;

sub _get_idx {
  my $dist = shift;
  my $resp = HTTP::Tiny->new( )->get( $metabase . $dist );
  unless ( $resp->{success} ) {
    warn "'$dist' doesn't exist\n";
    return;
  }
  my $json = $resp->{content} || die "Fuck\n";
  return eval { decode_json $json };
}

sub _vcmp {
    my ($x, $y) = @_;

    s/_//g foreach $x, $y;

    return version->parse($x) <=> version->parse($y);
}