script/misc/update-wiki-pages

   1 #!/usr/bin/env perl
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5
   6 use Pod::Usage ();
   7 use Getopt::Long ();
   8
   9 BEGIN {
  10     eval "require MediaWiki::API; require YAML::XS;" or do {
  11         print "You have to install some modules via CPAN to run this:\n";
  12         print "   sudo cpanp MediaWiki::API YAML::XS\n";
  13         exit 1;
  14     };
  15 }
  16
  17 use MediaWiki::API;
  18 use YAML::XS qw(Dump);
  19 use Test::More 'no_plan';
  20
  21 =head1 NAME
  22
  23 update-wiki-pages - Scrape the wiki for key/value wiki description pages
  24
  25 =head1 SYNOPSIS
  26
  27     perl script/misc/update-wiki-pages config/wiki_pages.yml
  28
  29 Or with prove(1):
  30
  31     prove -e 'perl script/misc/update-wiki-pages' config/wiki_pages.yml
  32
  33 =cut
  34
  35 # Get the command-line options
  36 Getopt::Long::Parser->new(
  37     config => [ qw< bundling no_ignore_case no_require_order pass_through > ],
  38 )->getoptions(
  39     'h|help' => \my $help,
  40 ) or help();
  41
  42 # On --help
  43 help() if $help;
  44
  45 my $out_file = $ARGV[0];
  46 $out_file //= 'config/wiki_pages.yml';
  47
  48 help() unless -f $out_file;
  49
  50 # Get a API interface
  51 my $mw = MediaWiki::API->new();
  52 ok($mw, "Got a MediaWiki API");
  53 $mw->{config}->{api_url} = 'https://wiki.openstreetmap.org/w/api.php';
  54
  55 # All our goodies
  56 my (%feature, %count);
  57
  58 # This is what you get on:
  59 ## http://wiki.openstreetmap.org/w/index.php?search=Template:KeyDescription&fulltext=Search&fulltext=Search
  60 for my $lang ('', map { "${_}:" } qw[ Pt Fi De It HU Cz Fr RU Pl ]) {
  61     ok(1, "  Templates for language '$lang'");
  62
  63     # Key pages
  64     ok(1, "    Getting key pages");
  65     my $cnt = stick_content_in_hash("key", "Template:${lang}KeyDescription", \%feature);
  66     $cnt += stick_content_in_hash("key", "Template:${lang}Feature", \%feature);
  67     ok(1, "    Got $cnt key pages");
  68     $count{key} += $cnt;
  69
  70     # Value pages
  71     ok(1, "    Getting value pages");
  72     $cnt = stick_content_in_hash("tag", "Template:${lang}ValueDescription", \%feature);
  73     ok(1, "    Got $cnt value pages");
  74     $count{value} += $cnt;
  75 }
  76
  77 ok(1, "Got a total of $count{$_} ${_}s") for qw[ key value ];
  78
  79 # Dump to .yml file
  80 open my $out, ">", $out_file or die "Can't open file '$out_file' supplied on the command line";
  81 say $out "# THIS FILE IS AUTOGENERATED WITH THE script/misc/update-wiki-pages";
  82 say $out "# PROGRAM DO NOT MANUALLY EDIT IT";
  83 say $out "";
  84 say $out Dump(\%feature);
  85 close $out;
  86
  87 exit 0;
  88
  89 sub stick_content_in_hash
  90 {
  91     my ($key, $title, $hash) = @_;
  92     my $ukey = ucfirst $key;
  93
  94     my $space_to_underscore = sub {
  95         my $txt = shift;
  96         $txt =~ s/ /_/g;
  97         $txt;
  98     };
  99
 100     my $count = 0;
 101
 102     my $process_link = sub {
 103         my $link = shift;
 104         $count++;
 105         ok(1, "    ... got $count links") if $count % 200 == 0;
 106         my $title = $link->{title};
 107         my $lang;
 108         my $key_name;
 109         if ($title =~ /^$ukey:(?<key_name>.*?)$/) {
 110             # English by default
 111             $lang = "en";
 112             $key_name = $space_to_underscore->($+{key_name});
 113         } elsif ($title =~ /^(?<lang>[^:]+):$ukey:(?<key_name>.*?)$/) {
 114             $lang = lc $+{lang};
 115             $key_name = $space_to_underscore->($+{key_name});
 116         }
 117         if ($lang && !exists($hash->{$lang}->{$key}->{$key_name})) {
 118             $hash->{$lang}->{$key}->{$key_name} = $title;
 119         }
 120     };
 121
 122     get_embeddedin(
 123         $title,
 124         sub {
 125             my $link = shift;
 126             $process_link->($link);
 127             get_redirects(
 128                 $link->{title},
 129                 sub {
 130                     my $link = shift;
 131                     $process_link->($link) if exists($link->{redirect});
 132                 }
 133             );
 134         }
 135     );
 136
 137     return $count;
 138 }
 139
 140 sub process_list
 141 {
 142     my $callback = shift;
 143     my $links = shift;
 144     for my $link (@$links) {
 145         $callback->($link);
 146     }
 147 }
 148
 149 sub get_embeddedin
 150 {
 151     my ($title, $callback) = @_;
 152     my $articles = $mw->list(
 153         {
 154             action => 'query',
 155             list => 'embeddedin',
 156             eititle => $title,
 157             eifilterredir => 'nonredirects',
 158             # Doesn't work for De:* and anything non-en. Odd.
 159             # einamespace => '0|8',
 160             eilimit => '200',
 161         },
 162         {
 163             max => '0',
 164             hook => sub { process_list($callback, @_) },
 165             skip_encoding => 1,
 166         }
 167     ) || die $mw->{error}->{code} . ': ' . $mw->{error}->{details};
 168 }
 169
 170 sub get_redirects
 171 {
 172     my ($title, $callback) = @_;
 173     my $articles = $mw->list(
 174         {
 175             action => 'query',
 176             list => 'backlinks',
 177             bltitle => $title,
 178             blfilterredir => 'redirects',
 179             # Doesn't work for De:* and anything non-en. Odd.
 180             # einamespace => '0|8',
 181             bllimit => '200',
 182         },
 183         {
 184             max => '0',
 185             hook => sub { process_list($callback, @_) },
 186             skip_encoding => 1,
 187         }
 188     ) || die $mw->{error}->{code} . ': ' . $mw->{error}->{details};
 189 }
 190
 191 sub help
 192 {
 193     my %arg = @_;
 194
 195     Pod::Usage::pod2usage(
 196         -verbose => $arg{ verbose },
 197         -exitval => $arg{ exitval } || 0,
 198     );
 199 }