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
  11 my $http = HTTP::Tiny->new;
  12
  13 my $url      = 'http://www.cpan.org/SITES';
  14 my $filename = 'SITES';
  15 my $response = $http->mirror( $url, $filename );
  16 unless ( $response->{success} ) {
  17     die "Error downloading $url";
  18 }
  19
  20 my $fh = IO::File->new($filename);
  21
  22 while ( my $line = <$fh> ) {
  23     chomp $line;
  24     last
  25         if $line eq
  26             '[Africa] [Asia] [Australasia] [Central America] [Europe] [North America] [South America]';
  27 }
  28
  29 my $line = <$fh>;
  30
  31 say 'Registered CPAN sites';
  32 say '';
  33 say '=for maintainers';
  34 say 'Generated by Porting/make_modlib_cpan.pl';
  35 say '';
  36
  37 my $continent;
  38 my $country;
  39 my $state;
  40
  41 while ( my $line = <$fh> ) {
  42     chomp $line;
  43     next if $line =~ /^\s+$/;
  44     last if $line eq 'Feedback';
  45
  46     if ( $line =~ /^(?<continent>\w.+)$/ ) {
  47         if ($continent) {
  48             say '';
  49             if ($continent) {
  50                 say "=back";
  51                 say '';
  52             }
  53             if ( $continent eq 'North America' ) {
  54                 say "=back";
  55                 say '';
  56             }
  57         }
  58         $continent = $+{continent};
  59         undef $country;
  60         say "=head2 $continent";
  61         say '';
  62         say '=over 4';
  63         say '';
  64     } elsif ( $line =~ /^\s{3}(?<country>\w.+)$/ ) {
  65         if ($country) {
  66             say '';
  67         }
  68         $country = $+{country};
  69         undef $state;
  70         say "=item $country";
  71         say '';
  72         if ( $country eq 'United States' ) {
  73             say '=over 8';
  74             say '';
  75         }
  76     } elsif ( $line =~ /^\s{5}(?<state>\w.+)$/ ) {
  77         if ($state) {
  78             say '';
  79         }
  80         $state = $+{state};
  81         say "=item $state";
  82         say '';
  83     } elsif ( $line =~ /^\s{22}(?<site>\w.+$)/ ) {
  84         say "  $+{site}";
  85     } else {
  86         die "Unknown line: $line";
  87     }
  88 }
  89
  90 say '';
  91 say '=back';