Porting/make_modlib_cpan.pl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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';