Update experimental to CPAN version 0.019

[perl5.git] / Porting / make_modlib_cpan.pl

#!perl
#
# This program generates the list of registered CPAN sites in perlmodlib.PL
#
use strict;
use warnings;
use 5.14.0;
use autodie;
use HTTP::Tiny;
use JSON::PP;

$|=1;

my $http = HTTP::Tiny->new;

my $url      = 'http://www.cpan.org/indices/mirrors.json';

my $response = $http->get($url);

unless ( $response->{success} ) {
    die "Error downloading $url";
}

die "No content" unless $response->{content};

my $json     = JSON::PP->new->utf8;
my $mirrors  = $json->decode( $response->{content} );
my %sorted;
my @rsync;

foreach my $mirror ( sort { $a->{continent} cmp $b->{continent} || $a->{country} cmp $b->{country} } @{ $mirrors } ) {
  if ( $mirror->{country} eq 'United States' ) {
    push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} }{ $mirror->{region} } }, $mirror;
  }
  else {
    push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} } }, $mirror;
  }
}

say 'Registered CPAN sites';
say '';
say '=for maintainers';
say 'Generated by Porting/make_modlib_cpan.pl';
say '';

foreach my $continent ( sort { $a cmp $b } keys %sorted ) {
  say "=head2 $continent";
  say '';
  say '=over 4';
  say '';
  foreach my $country ( sort { $a cmp $b } keys %{ $sorted{ $continent } } ) {
    say "=item $country";
    say '';
    if ( $country eq 'United States' ) {
      say '=over 8';
      say '';
      foreach my $state ( sort { $a cmp $b } keys %{ $sorted{ $continent }{ $country } } ) {
        say "=item $state";
        say '';
        foreach my $mirror ( @{ $sorted{ $continent }{ $country }{ $state } } ) {
          say "  " . $mirror->{http} if $mirror->{http};
          say "  " . $mirror->{ftp} if $mirror->{ftp};
          push @rsync, $mirror->{rsync} if $mirror->{rsync};
        }
        say '';
      }
      say '=back';
      say '';
    }
    else {
      foreach my $mirror ( @{ $sorted{ $continent }{ $country } } ) {
        say "  " . $mirror->{http} if $mirror->{http};
        say "  " . $mirror->{ftp} if $mirror->{ftp};
        push @rsync, $mirror->{rsync} if $mirror->{rsync};
      }
      say '';
    }
  }
  say '=back';
  say '';
}

say '=head2 RSYNC Mirrors';
say '';

foreach my $rsync ( @rsync ) {
  say "\t\t$rsync";
}

say '';