Porting/make_modlib_cpan.pl

   1 #!perl
   2 #
   3 # This program generates the list of registered CPAN sites in perlmodlib.PL
   4 #
   5 use strict;
   6 use warnings;
   7 use 5.14.0;
   8 use autodie;
   9 use HTTP::Tiny;
  10 use JSON::PP;
  11
  12 $|=1;
  13
  14 my $http = HTTP::Tiny->new;
  15
  16 my $url      = 'http://www.cpan.org/indices/mirrors.json';
  17
  18 my $response = $http->get($url);
  19
  20 unless ( $response->{success} ) {
  21     die "Error downloading $url";
  22 }
  23
  24 die "No content" unless $response->{content};
  25
  26 my $json     = JSON::PP->new->utf8;
  27 my $mirrors  = $json->decode( $response->{content} );
  28 my %sorted;
  29 my @rsync;
  30
  31 foreach my $mirror ( sort { $a->{continent} cmp $b->{continent} || $a->{country} cmp $b->{country} } @{ $mirrors } ) {
  32   if ( $mirror->{country} eq 'United States' ) {
  33     push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} }{ $mirror->{region} } }, $mirror;
  34   }
  35   else {
  36     push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} } }, $mirror;
  37   }
  38 }
  39
  40 say 'Registered CPAN sites';
  41 say '';
  42 say '=for maintainers';
  43 say 'Generated by Porting/make_modlib_cpan.pl';
  44 say '';
  45
  46 foreach my $continent ( sort { $a cmp $b } keys %sorted ) {
  47   say "=head2 $continent";
  48   say '';
  49   say '=over 4';
  50   say '';
  51   foreach my $country ( sort { $a cmp $b } keys %{ $sorted{ $continent } } ) {
  52     say "=item $country";
  53     say '';
  54     if ( $country eq 'United States' ) {
  55       say '=over 8';
  56       say '';
  57       foreach my $state ( sort { $a cmp $b } keys %{ $sorted{ $continent }{ $country } } ) {
  58         say "=item $state";
  59         say '';
  60         foreach my $mirror ( @{ $sorted{ $continent }{ $country }{ $state } } ) {
  61           say "  " . $mirror->{http} if $mirror->{http};
  62           say "  " . $mirror->{ftp} if $mirror->{ftp};
  63           push @rsync, $mirror->{rsync} if $mirror->{rsync};
  64         }
  65         say '';
  66       }
  67       say '=back';
  68       say '';
  69     }
  70     else {
  71       foreach my $mirror ( @{ $sorted{ $continent }{ $country } } ) {
  72         say "  " . $mirror->{http} if $mirror->{http};
  73         say "  " . $mirror->{ftp} if $mirror->{ftp};
  74         push @rsync, $mirror->{rsync} if $mirror->{rsync};
  75       }
  76       say '';
  77     }
  78   }
  79   say '=back';
  80   say '';
  81 }
  82
  83 say '=head2 RSYNC Mirrors';
  84 say '';
  85
  86 foreach my $rsync ( @rsync ) {
  87   say "\t\t$rsync";
  88 }
  89
  90 say '';