|
|
|
@ -1,13 +1,39 @@ |
|
|
|
|
use v5.36; |
|
|
|
|
use rlib '.'; |
|
|
|
|
|
|
|
|
|
use Getopt::Long; |
|
|
|
|
use Carp; |
|
|
|
|
use Data::Dumper; |
|
|
|
|
|
|
|
|
|
use MediaWiki::API; |
|
|
|
|
use MWTemplate; |
|
|
|
|
|
|
|
|
|
use feature "signatures"; |
|
|
|
|
no warnings "experimental::signatures"; |
|
|
|
|
|
|
|
|
|
my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/; |
|
|
|
|
my $coords_regex = qr/^\s*(\s*-?\d+\s*)\s*,\s*(\s*-?\d+\s*)\s*$/; |
|
|
|
|
|
|
|
|
|
my $api_url; |
|
|
|
|
my $region_template_name = "MapRegion"; |
|
|
|
|
my $subregion_template_name = "MapSubregion"; |
|
|
|
|
my $location_template_name = "MapLocation"; |
|
|
|
|
my $site_template_name = "MapSite"; |
|
|
|
|
my $path_template_name = "MapPath"; |
|
|
|
|
|
|
|
|
|
GetOptions |
|
|
|
|
( |
|
|
|
|
'api-url=s' => \$api_url, |
|
|
|
|
'region-template-name=s' => \$region_template_name, |
|
|
|
|
'subregion-template-name=s' => \$subregion_template_name, |
|
|
|
|
'location-template-name=s' => \$location_template_name, |
|
|
|
|
'site-template-name=s' => \$site_template_name, |
|
|
|
|
'path-template-name=s' => \$path_template_name, |
|
|
|
|
); |
|
|
|
|
|
|
|
|
|
my $mw = MediaWiki::API->new(); |
|
|
|
|
$mw->{config}->{api_url} = $api_url; |
|
|
|
|
|
|
|
|
|
$api_url // croak "Base API URL is required! Use --api-url to set"; |
|
|
|
|
|
|
|
|
|
my %regions; |
|
|
|
|
my %tile_to_regions; |
|
|
|
@ -19,26 +45,108 @@ my %bounds = |
|
|
|
|
sw_max => "-Inf" |
|
|
|
|
); |
|
|
|
|
|
|
|
|
|
my $input_file = shift; |
|
|
|
|
open (my $input_fh, $input_file); |
|
|
|
|
|
|
|
|
|
my $output_file = shift // "$input_file.out"; |
|
|
|
|
open (my $output_fh, ">$output_file"); |
|
|
|
|
my $region_query_results = $mw->api |
|
|
|
|
( { |
|
|
|
|
action => 'query', |
|
|
|
|
generator => 'categorymembers', |
|
|
|
|
gcmtitle => 'Category:Regions', |
|
|
|
|
gcmlimit => 'max', |
|
|
|
|
prop => 'info|revisions', |
|
|
|
|
rvprop => 'content', |
|
|
|
|
inprop => 'url', |
|
|
|
|
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
|
|
|
|
|
|
|
|
|
my (@tile_pages, %background_pages); |
|
|
|
|
foreach my $page (values %{$region_query_results->{query}{pages}}) |
|
|
|
|
{ |
|
|
|
|
my $region_name = $page->{title}; |
|
|
|
|
next if $region_name =~ /^Category:/; |
|
|
|
|
# say STDERR "Processing region: $region_name"; |
|
|
|
|
my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $region_template_name); |
|
|
|
|
next unless $parsed_template; |
|
|
|
|
$regions{$region_name}{bg} = $parsed_template->{named_params}{colour}; |
|
|
|
|
push @tile_pages, "$region_name/Tiles"; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
my $subregion_query_results = $mw->api |
|
|
|
|
( { |
|
|
|
|
action => 'query', |
|
|
|
|
generator => 'categorymembers', |
|
|
|
|
gcmtitle => 'Category:Subregions', |
|
|
|
|
gcmlimit => 'max', |
|
|
|
|
prop => 'info|revisions', |
|
|
|
|
rvprop => 'content', |
|
|
|
|
inprop => 'url', |
|
|
|
|
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
|
|
|
|
|
|
|
|
|
foreach my $page (values %{$subregion_query_results->{query}{pages}}) |
|
|
|
|
{ |
|
|
|
|
my $subregion_name = $page->{title}; |
|
|
|
|
next if $subregion_name =~ /^Category:/; |
|
|
|
|
my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $subregion_template_name); |
|
|
|
|
next unless $parsed_template; |
|
|
|
|
$regions{$subregion_name}{bg} = $parsed_template->{named_params}{colour}; |
|
|
|
|
# say STDERR "Processing subregion: $subregion_name"; |
|
|
|
|
push @tile_pages, "$subregion_name/Tiles"; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
# As above, get all tile pages in one request. |
|
|
|
|
# By doing so, we lose context as to which page corresponds to which region, |
|
|
|
|
# so we extract it from the title of the page. |
|
|
|
|
|
|
|
|
|
# say STDERR "Getting Tile pages"; |
|
|
|
|
my $tile_query_results = $mw->api |
|
|
|
|
( { |
|
|
|
|
action => 'query', |
|
|
|
|
titles => join('|', @tile_pages), |
|
|
|
|
prop => 'revisions', |
|
|
|
|
rvprop => 'content', |
|
|
|
|
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
|
|
|
|
|
|
|
|
|
foreach my $page (values %{$tile_query_results->{query}{pages}}) |
|
|
|
|
{ |
|
|
|
|
my $content = $page->{revisions}[0]{'*'}; |
|
|
|
|
my ($region_name) = $page->{title} =~ /(.*)\/Tiles/; |
|
|
|
|
# say STDERR "Processing tiles for: $region_name"; |
|
|
|
|
expand_coords(\%regions, \%tile_to_regions, $region_name, \%bounds, split ';', $content); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
# say STDERR "Getting Location pages"; |
|
|
|
|
my $location_query_results = $mw->api |
|
|
|
|
( { |
|
|
|
|
action => 'query', |
|
|
|
|
generator => 'categorymembers', |
|
|
|
|
gcmtitle => 'Category:Locations', |
|
|
|
|
gcmlimit => 'max', |
|
|
|
|
prop => 'info|revisions', |
|
|
|
|
rvprop => 'content', |
|
|
|
|
inprop => 'url', |
|
|
|
|
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
|
|
|
|
|
|
|
|
|
while (my $line = <$input_fh>) |
|
|
|
|
foreach my $page (values %{$location_query_results->{query}{pages}}) |
|
|
|
|
{ |
|
|
|
|
my @fields = split '; ', $line; |
|
|
|
|
my $region = (shift @fields); #region name |
|
|
|
|
$regions{$region}{bg} = (shift @fields); #background colour |
|
|
|
|
expand_coords(\%regions, \%tile_to_regions, $region, \%bounds, @fields); |
|
|
|
|
my $location_name = $page->{title}; |
|
|
|
|
next if $location_name =~ /^Category:/; |
|
|
|
|
my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $location_template_name); |
|
|
|
|
next unless $parsed_template; |
|
|
|
|
next unless $parsed_template->{positional_params}[0] =~ $coords_regex; |
|
|
|
|
my ($nw, $sw) = ($1, $2); |
|
|
|
|
|
|
|
|
|
# say STDERR "Processing location: $location_name"; |
|
|
|
|
|
|
|
|
|
$regions{$location_name}{bg} = $parsed_template->{named_params}{colour}; |
|
|
|
|
my $region_name = $parsed_template->{positional_params}[1]; |
|
|
|
|
add_location(\%regions, \%tile_to_regions, $location_name, $region_name, \%bounds, $nw, $sw); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
fill_holes(\%regions, \%tile_to_regions, \%bounds); |
|
|
|
|
foreach my $region (keys %regions) |
|
|
|
|
{ |
|
|
|
|
say $output_fh ("$region; $regions{$region}{bg}; " . make_output_region_line(\%regions, $region)); |
|
|
|
|
say ("$region; $regions{$region}{bg}; " . make_output_region_line(\%regions, $region)); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub expand_coords($regions_hashref, $tile_to_region_hashref, $region, $bounds, @coord_list) |
|
|
|
|
{ |
|
|
|
|
foreach my $coords (@coord_list) |
|
|
|
@ -70,6 +178,33 @@ sub expand_coords($regions_hashref, $tile_to_region_hashref, $region, $bounds, @ |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
sub add_location($regions_hashref, $tile_to_region_hashref, $location_name, $region_name, $bounds, $nw, $sw) |
|
|
|
|
{ |
|
|
|
|
my $nw_base = $nw * 3; |
|
|
|
|
my $sw_base = $sw * 3; |
|
|
|
|
|
|
|
|
|
push @{$regions_hashref->{$location_name}{tiles}{$nw_base}}, $sw_base; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base+1}}, $sw_base; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base-1}}, $sw_base; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base}}, $sw_base+1; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base}}, $sw_base-1; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base+1}}, $sw_base-1; |
|
|
|
|
push @{$regions_hashref->{$region_name}{tiles}{$nw_base-1}}, $sw_base+1; |
|
|
|
|
|
|
|
|
|
$tile_to_region_hashref->{$nw_base}{$sw_base} = $location_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base+1}{$sw_base} = $region_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base-1}{$sw_base} = $region_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base}{$sw_base+1} = $region_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base}{$sw_base-1} = $region_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base+1}{$sw_base-1} = $region_name; |
|
|
|
|
$tile_to_region_hashref->{$nw_base-1}{$sw_base+1} = $region_name; |
|
|
|
|
|
|
|
|
|
$bounds{nw_min} = $nw_base - 1 if $bounds{nw_min} > $nw_base - 1; |
|
|
|
|
$bounds{nw_max} = $nw_base + 1 if $bounds{nw_max} < $nw_base + 1; |
|
|
|
|
$bounds{sw_min} = $sw_base - 1 if $bounds{sw_min} > $sw_base - 1; |
|
|
|
|
$bounds{sw_max} = $sw_base + 1 if $bounds{sw_max} < $sw_base + 1; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
sub fill_holes($regions_hashref, $tile_to_region_hashref, $bounds) |
|
|
|
|
{ |
|
|
|
|
for(my $nw = $bounds->{nw_min}; $nw <= $bounds->{nw_max}; $nw++) |
|
|
|
@ -123,6 +258,3 @@ sub make_output_region_line($regions_hashref, $region) |
|
|
|
|
chop($line); |
|
|
|
|
return $line; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
close $input_fh; |
|
|
|
|
close $output_fh; |
|
|
|
|