script/misc/update-wiki-pages

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