wiki-map/wiki-map.pl

use v5.36;

use HexGrid;
use HexGrid::Pin;
use MWTemplate;
use MediaWiki::API;

use Getopt::Long;
use Carp;

use Data::Dumper;
# $Data::Dumper::Indent = 1;

use feature "signatures";
no warnings "experimental::signatures";

# The below regex is a whitespace forgiving version of /^(-?\d+),(-?\d+)/, an int pair
my $coords_regex = qr/^\s*(-?\s*\d+)\s*,\s*(-?\s*\d+)\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 $border_width = 1;
my $border_colour = 'black';
my $show_coords = 0;

my $html_document = 1;
my $outfile = '-';
my $regiondir;

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,

	'border-width|bw=f' => \$border_width,
	'border-colour|border-color|bc=s' => \$border_colour,
	'show-coords|coords!' => \$show_coords,

	'html-document!' => \$html_document,
	'outfile=s' => \$outfile,
	'regiondir=s' => \$regiondir
);

$api_url // croak "Base API URL is required! Use --api-url to set";

my $grid = HexGrid->new(defaults => {
		style => { 'stroke-width' => $border_width, stroke => $border_colour },
		show_coords => $show_coords });
my %region_grids;
my $mw = MediaWiki::API->new();
$mw->{config}->{api_url} = $api_url;



say STDERR "Getting Region pages";
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}})
{
	next if $page->{title} =~ /^Category:/;
	my $region = $grid->make_region($page->{title});
	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $region_template_name);
	next unless $parsed_template;
	say STDERR "Processing region: $page->{title}";
	$region->{defaults}{colour} = $parsed_template->{named_params}{colour};
	if($regiondir)
	{
		$region_grids{$page->{title}} = HexGrid->new
		(
			defaults =>
			{
				style => { 'stroke-width' => $border_width, stroke => $border_colour },
				show_coords => $show_coords
			},
			height => 300,
			width => 300
		);
		$region_grids{$page->{title}}->add_region($region);
	}

	push @tile_pages, "$page->{title}/Tiles";
	push @{$background_pages{"File:$parsed_template->{named_params}{background}"}}, $region;
}



say STDERR "Getting Subregion pages";
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}})
{
	next if $page->{title} =~ /^Category:/;
	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $subregion_template_name);
	next unless $parsed_template;
	say STDERR "Processing subregion: $page->{title}";
	my $subregion = $grid->make_region($page->{title});
	$subregion->{defaults}{colour} = $parsed_template->{named_params}{colour};
	if($regiondir)
	{
		my $region_name = $parsed_template->{positional_params}[0];
		$region_grids{$region_name}->add_region($subregion);
	}

	push @tile_pages, "$page->{title}/Tiles";
	push @{$background_pages{"File:$parsed_template->{named_params}{background}"}}, $subregion;
}



my @location_continuations;
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};

foreach my $page (values %{$location_query_results->{query}{pages}})
{
	next if $page->{title} =~ /^Category:/;
	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $location_template_name);
	next unless $parsed_template;
	say STDERR "Processing location: $page->{title}";
	my $location = $grid->make_region($page->{title});
	$location->{defaults}{colour} = $parsed_template->{named_params}{colour};
	push @{$background_pages{"File:$parsed_template->{named_params}{background}"}}, $location;
	push @location_continuations, sub
	{
		return unless $parsed_template->{positional_params}[0] =~ $coords_regex;
		my ($nw, $sw) = ($1, $2);
		$location->make_tile_at($nw, $sw);
		my $region_name = $parsed_template->{positional_params}[1];
		$region_grids{$region_name}->add_region($location);
		if($regiondir)
		{
			my $region_name = $parsed_template->{positional_params}[1];
			$region_grids{$region_name}->add_region($location);

			$region_grids{$location->{name}} = HexGrid->new
			(
				defaults =>
				{
					style => { 'stroke-width' => $border_width, stroke => $border_colour },
					show_coords => $show_coords
				},
				height => 300,
				width => 300
			);
			my $location_with_context = $region_grids{$location->{name}}->make_region($location->{name});
			$location_with_context->add_tile($grid->get_tile_at($nw, $sw));
			foreach my $coords (split /;/, $parsed_template->{named_params}{context_tiles})
			{
				do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
				$location_with_context->add_tile($grid->get_tile_at($1, $2));
			}
		}
	};
}



say STDERR "Getting Background image pages";
my $background_query_results = $mw->api({ action => 'query',
		prop => 'imageinfo',
		titles => join('|', keys %background_pages),
		iiprop => 'url'
	}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details};

foreach my $page (values %{$background_query_results->{query}{pages}})
{
	if($page->{imageinfo})
	{
		say STDERR "Processing image: $page->{title}";
		foreach my $region (@{$background_pages{$page->{title}}})
		{
			$region->{defaults}{image} = $page->{imageinfo}[0]{url};
		}
	}
}



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";
	my $region = $grid->{regions}{$region_name};
	foreach my $coords (split /;/, $content)
	{
		do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
		$region->make_tile_at($1,$2);
	}
}



say STDERR "Continuing Location processing";
$_->() for @location_continuations;



say STDERR "Getting Site pages";
my $site_query_results = $mw->api
( {
	action => 'query',
	generator => 'categorymembers',
	prop => 'info|revisions',
	gcmtitle => 'Category:Sites',
	gcmlimit => 'max',
	rvprop => 'content',
	inprop => 'url',
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};

# say STDERR "Sites found: " . join(" ,", map { $_->{title} } @$site_pages);
foreach my $site_page_ref (values %{$site_query_results->{query}{pages}})
{
	next if $site_page_ref->{title} =~ /^Category:/;
	my $site_name = $site_page_ref->{title};
	say STDERR "Processing Site $site_name";
	my $site_url = $site_page_ref->{canonicalurl};
	my $site_content = $site_page_ref->{revisions}[0]{'*'};
	my $parsed_template = MWTemplate::Parse($site_content, $site_template_name);
	next unless $parsed_template;
	my ($nw,$sw) = split /,/, $parsed_template->{named_params}{coords};

	my $imageinfo_query_results = $mw->api({ action => 'query',
			prop => 'imageinfo',
			titles => "File:$parsed_template->{named_params}{icon}",
			iiprop => 'url'
		}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details};
	my %image_pages = %{$imageinfo_query_results->{query}{pages}};
	my $image_url = (values %image_pages)[0]{imageinfo}[0]{url};

	my $pin = HexGrid::Pin->new
	(
		name => $site_name,
		id => "${site_name}_pin",
		icon => $image_url,
		link => $site_url,
		description => $parsed_template->{named_params}{abstract}
	);
	$grid->get_tile_at($nw, $sw)->pin($pin);
}



open (my $fh, "> $outfile") or croak "Couldn't open $outfile for writing: $!";
say $fh ($html_document ? wrap_in_html($grid) : $grid->render);
close $fh;
if($regiondir)
{
	chdir $regiondir || croak "Couldn't chdir to $regiondir: $!";
	my $extension = $html_document ? 'html' : 'svg';
	while(my ($region, $region_grid) = each %region_grids)
	{
		open (my $region_fh, "> $region.$extension")
			or croak "Couldn't open $region.extension for writing: $!";
		say $region_fh ($html_document ? wrap_in_html($region_grid) : $region_grid->render);
		close $region_fh;
	}
}

sub wrap_in_html($grid)
{
	my $html_builder = "<!DOCTYPE html>";
	$html_builder .= "\n<html>\n<body>";
	$html_builder .= "\n" . <<EOS;
<script>
	function clickPin(pinId, containerId) {
		let popup = document.getElementById(pinId + '-popup');
		popup.style.visibility = popup.style.visibility == 'visible' ? 'hidden' : 'visible';
	}
</script>
EOS
	$html_builder .= "\n" . $grid->render;
	$html_builder .= "\n</body>\n</html>";
	return $html_builder;
}