Add program which generates the list of registered CPAN sites in perlmodlib.PL

1 files changed, 91 insertions, 0 deletions

diff --git a/Porting/make_modlib_cpan.pl b/Porting/make_modlib_cpan.pl
new file mode 100755
index 0000000000..ea0878bda0
--- /dev/null
+++ b/Porting/make_modlib_cpan.pl
@@ -0,0 +1,91 @@
+#!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;
+
+my $http = HTTP::Tiny->new;
+
+my $url      = 'http://www.cpan.org/SITES';
+my $filename = 'SITES';
+my $response = $http->mirror( $url, $filename );
+unless ( $response->{success} ) {
+    die "Error downloading $url";
+}
+
+my $fh = IO::File->new($filename);
+
+while ( my $line = <$fh> ) {
+    chomp $line;
+    last
+        if $line eq
+            '[Africa] [Asia] [Australasia] [Central America] [Europe] [North America] [South America]';
+}
+
+my $line = <$fh>;
+
+say 'Registered CPAN sites';
+say '';
+say '=for maintainers';
+say 'Generated by Porting/make_modlib_cpan.pl';
+say '';
+
+my $continent;
+my $country;
+my $state;
+
+while ( my $line = <$fh> ) {
+    chomp $line;
+    next if $line =~ /^\s+$/;
+    last if $line eq 'Feedback';
+
+    if ( $line =~ /^(?<continent>\w.+)$/ ) {
+        if ($continent) {
+            say '';
+            if ($continent) {
+                say "=back";
+                say '';
+            }
+            if ( $continent eq 'North America' ) {
+                say "=back";
+                say '';
+            }
+        }
+        $continent = $+{continent};
+        undef $country;
+        say "=head2 $continent";
+        say '';
+        say '=over 4';
+        say '';
+    } elsif ( $line =~ /^\s{3}(?<country>\w.+)$/ ) {
+        if ($country) {
+            say '';
+        }
+        $country = $+{country};
+        undef $state;
+        say "=item $country";
+        say '';
+        if ( $country eq 'United States' ) {
+            say '=over 8';
+            say '';
+        }
+    } elsif ( $line =~ /^\s{5}(?<state>\w.+)$/ ) {
+        if ($state) {
+            say '';
+        }
+        $state = $+{state};
+        say "=item $state";
+        say '';
+    } elsif ( $line =~ /^\s{22}(?<site>\w.+$)/ ) {
+        say "  $+{site}";
+    } else {
+        die "Unknown line: $line";
+    }
+}
+
+say '';
+say '=back';