Commit | Line | Data |
---|---|---|
872fa928 LB |
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'; |