#!/usr/bin/perl
#----------------------------------------------------------------------------------------------
#	$Id: convert-lc-cc-region.pl,v 1.4 2023/01/20 19:56:50 wolf Exp $
#----------------------------------------------------------------------------------------------
#	Parst eine regions-by-Datei und erzeugt daraus eine JSON-Datei.
#----------------------------------------------------------------------------------------------

use strict;
use utf8;
use POSIX;

use open ':utf8';
binmode( STDOUT, ':utf8' );
binmode( STDERR, ':utf8' );

#----------------------------------------------------------------------------------------------
#	Option
#----------------------------------------------------------------------------------------------

my $DoAlign = 0;

if( @ARGV && $ARGV[ 0 ] eq '--align' ){

	shift( @ARGV );
	$DoAlign = 1;
}

#----------------------------------------------------------------------------------------------
#
#	Sprachcodes können frei stehen oder mit einem der Suffixe "*", "!" und "-".
#
#	* Ein frei stehender Sprachcode drückt aus, dass diese Sprache ausschließlich in dem
#	folgend angegebenen Land gesprochen wird. Er darf dann (natürlich) kein weiteres Mal
#	genutzt werden. Dieser Sprachcode im Browser wird dann direkt auf das Land abgebildet.
#
#	Beispiel: "da" -> "Dänemark."
#
#	* Ein "*" nach dem Sprachcode drückt aus, dass diese Sprache im folgend angegebenen
#	Land gesprochen wird, aber auch in anderen Ländern. Die Grenzen dieser Länder werden
#	zu einer "Sprachregion" zusammengefasst. Dieser Sprachcode im Browser wird auf die
#	Sprachregion abgebildet.
#
#	Beispiel: "de" -> "{Deutschland, Österreich, Schweiz}"
#
#	* Ein "!" nach dem Sprachcode drückt aus, dass die Sprache im folgen angegebenen Land
#	und in weiteren Ländern gesprochen wird, dass der Sprachcode im Browser aber nur auf
#	dieses Land abgebildet. Eine Sprache wie Portugiesisch würde ohne die Funktion auf
#	die halbe Welt abgebildet, was wenig hilfreich ist.
#
#	Stattdessen habe ich entschieden, die Sprachcodes mit weltweiter Verbreitung auf das
#	europäische Herkunftsland abzubilden: "en" auf das Vereinigte Königreich, "es" auf
#	Spanien, "fr" auf den europäischen Teil von Frankreich, und "pt" auf Portugal.
#	Wem dies unfair erscheint, der möge die "!" anders vergeben oder gegen "*" tauschen.
#
#	In der Praxis ist diese Regel ohnehin von nur geringer Bedeutung: ein Brasilianer wird
#	im  Browser "pt-BR" auswählen und landet so in Brasilien, so wie der Neuseeländer
#	"en-NZ" oder der Papst "it-VA".
#
#	* Ein "-" nach dem Sprachcode drückt aus, dass die Sprache in diesem Land gesprochen
#	wird, ich aber nicht will, dass das Land in die Sprachregion aufgenommen wird.
#	Ein Beispiel ist "se-" -> "Russia": diese Sprache wird in einem winzigen Teil Russlands
#	gesprochen, deshalb ganz Russland in die Sprachregion aufzunehmen wäre grober Unfu.
#
#	Wem das nicht gefällt, darf mir gerne eine Zeile schicken mit
#	"se-RU" -> "Gebiet in Russland, in dem die Sprache gesprochen wird (Koordinaten)".
#
#	* Die Form "lc-CC" ist die offizielle Schreibweise für die Kombination einer Sprache
#	mit einem Land; dieser wird als Region die (inoffizielle) Schreibweise "CC-lc"
#	zugeordnet, mit den Koordinaten des Bereiches im jeweiligen Land, in dem die jeweilige
#	Sprache gesprochen wird.
#
#----------------------------------------------------------------------------------------------
#
#	Die Zuordnung von Ländercode (Spalte 2) zum Rest der Tabelle muss eindeutig sein.
#	Der Datensatz von Spalte 2 bis Spalte 7 darf sich wiederholen.
#
#	Der Ländercode wird freizügig ausgelegt:
#
#	* Es kann ein Sprachcode angehängt werden; diese Kombination bezeichnet eine
#	Sprachregion im jeweiligen Land. Beispiel: "CH-de" oder "BE-fr".
#
#	* Es kann eine offizielle oder inoffiziell Subregion angehängt sein. Beispiel sind:
#	"CN-XZ" für Tibet, "US-AK" für Alaska, "GB-HL" für die Schottischen Highlands" oder
#	"IT-88" für Sardinien.
#
#	* Ich habe eine Region "Welt" mit Ländercode "XX" ergänzt, die abzubilden natürlich
#	sinnlos ist: Regeln für die Region "XX" werden faktisch ignoriert. Die Kombination
#	von "XX-" mit einem Ländercode dagegen ist sinnvoll für Sprachregionen, die mehrere
#	Länder in Teilen überdecken, wenn man zu faul ist, echte Länder-Sprachregionen zu
#	erfassen. Ein Beispiel ist "li" -> "XX-li".
#
#----------------------------------------------------------------------------------------------

#----------------------------------------------------------------------------------------------
#	Information for single country codes
#----------------------------------------------------------------------------------------------

my %cc_lino;
my %country_lino;
my %country_cc;

#----------------------------------------------------------------------------------------------
#	Information for language region
#----------------------------------------------------------------------------------------------

my %region_name;
my %region_minlon;
my %region_maxlon;
my %region_minlat;
my %region_maxlat;

#----------------------------------------------------------------------------------------------
#	Ergebnis
#----------------------------------------------------------------------------------------------

my %lc_def_lino;
my %lc_region;
my %cc_defined;

#----------------------------------------------------------------------------------------------
#	Read file
#----------------------------------------------------------------------------------------------

my $FILE = 'stdin';
my $LINE = 0;

while( <> ){

	++$LINE;

	#--------------------------------------------------------------------------------------
	#	split
	#--------------------------------------------------------------------------------------

	next unless m!^[|]!;

	my( $links, $xlc, $xcc, $uminlon, $umaxlon, $uminlat, $umaxlat, $country, $rechts )
		= split( /\s*[|]\s*/, s!\s+$!!r );

	#--------------------------------------------------------------------------------------
	#	sanity
	#--------------------------------------------------------------------------------------

	die $_ if $links | $rechts | !$country;

	#--------------------------------------------------------------------------------------
	#	check and unpack lc
	#--------------------------------------------------------------------------------------

	die "$FILE.$LINE: Invalid lc '$xlc'.\n" unless $xlc =~ m/^
		( #1: lc
			( #2: base
				[a-z]{0,3}
			)
			(?:
				-
				( #3: extension
					[A-Z]+
				 ) 
			)?
		)
		( #4: mode
			[*!-]?
		)
	$/x;

	my $lc      = $1;
	my $lc_base = $2;
	my $lc_ext  = $3 // '';
	my $mode    = $4;

	#--------------------------------------------------------------------------------------
	#	check and unpack cc
	#--------------------------------------------------------------------------------------

	die "$FILE.$LINE: Invalid cc '$xcc'.\n" unless $xcc =~ m/^
		( #1: cc
			( #2: base
				( #3: cc2
					[A-Z]{2}
				)
				(?:
					- [A-Z0-9]+
				)*
			)
			(?:
				-
				( #4: ext
					[a-z]{2,3}
				)
			)?
		)
	$/x;

	my $cc      = $1;
	my $cc_base = $2;
	my $cc_cc2  = $3;
	my $cc_ext  = $4 // "";

	$cc_defined{ $cc_base } = 1; # XXX if $cc_cc2 eq $cc_base;

	#--------------------------------------------------------------------------------------
	#	check coordinates
	#--------------------------------------------------------------------------------------

	die unless $uminlon =~ m!^ -? \d+ [.]? \d* $!x;
	die unless $umaxlon =~ m!^ -? \d+ [.]? \d* $!x;
	die unless $uminlat =~ m!^ -? \d+ [.]? \d* $!x;
	die unless $umaxlat =~ m!^ -? \d+ [.]? \d* $!x;

	my $minlon = $uminlon + 0;
	my $maxlon = $umaxlon + 0;
	my $minlat = $uminlat + 0;
	my $maxlat = $umaxlat + 0;

	#--------------------------------------------------------------------------------------
	#	crosscheck lc <-> cc
	#--------------------------------------------------------------------------------------

	if( $lc_ext && $lc_ext ne $cc_base || $cc_ext && $cc_ext ne $lc_base ){

		die "$FILE:$LINE: Conflict between lc '$lc' and cc '$cc',\n";
	}

	#--------------------------------------------------------------------------------------
	#	check consistent cc → cc_* mapping
	#--------------------------------------------------------------------------------------

	if( !$cc_lino{ $cc } ){

		$cc_lino{ $cc } = $LINE;

		$region_minlon{ $cc } = $minlon;
		$region_maxlon{ $cc } = $maxlon;
		$region_minlat{ $cc } = $minlat;
		$region_maxlat{ $cc } = $maxlat;
		$region_name  { $cc } = $country;

	} else {

		my @conflicts;
		push( @conflicts, 'minlon' ) if $minlon  != $region_minlon { $cc };
		push( @conflicts, 'maxlon' ) if $maxlon  != $region_maxlon { $cc };
		push( @conflicts, 'minlon' ) if $minlat  != $region_minlat { $cc };
		push( @conflicts, 'maxlon' ) if $maxlat  != $region_maxlat { $cc };
		push( @conflicts, 'country') if $country ne $region_name   { $cc };

die "$FILE:$LINE: Conflicting '@conflicts' with line ${country_lino{$country}}.\n" if @conflicts;
	} 

	#--------------------------------------------------------------------------------------
	#	check consistent country→ cc mapping
	#--------------------------------------------------------------------------------------

	if( !$country_lino{ $country } ){

		$country_lino { $country } = $LINE;
		$country_cc   { $country } = $cc;

	} else {

		my @conflicts;

		push( @conflicts, 'country' ) if $cc ne $country_cc{ $country };

die "$FILE:$LINE: Conflicting '@conflicts' with line ${country_lino{$country}}.\n" if @conflicts;
	}

	#--------------------------------------------------------------------------------------
	#	"lc" / "lc!": must be unique, sets result
	#--------------------------------------------------------------------------------------

	if( $mode eq "" || $mode eq "!" ){

		die "$FILE:LINE: Assignment of '$lc' different to line $lc_def_lino{$lc}.\n"
							if defined $lc_region{$lc};
		$lc_region{ $lc } = $cc;
	}

	#--------------------------------------------------------------------------------------
	#	"lc" / "lc*" / "lc!": contribute to region
	#--------------------------------------------------------------------------------------

	if( $mode ne "-" ){

		my $region = "region_$lc";

		if( !defined( $region_name{$region} ) ){

			$region_name  {$region} = "Language region '$lc'";
			$region_minlon{$region} = $minlon;
			$region_maxlon{$region} = $maxlon;
			$region_minlat{$region} = $minlat;
			$region_maxlat{$region} = $maxlat;

		} else {

			my $lower_dist = sprintf( "%.2f", wrap( $region_minlon{$region} - $minlon ));
			my $upper_dist = sprintf( "%.2f", wrap( $maxlon - $region_maxlon{$region} ));

			$region_minlon{$region} -= $lower_dist if $lower_dist >= 0;
			$region_maxlon{$region} += $upper_dist if $upper_dist >= 0;
			$region_minlat{$region} = $minlat if $minlat < $region_minlat{$region};
			$region_maxlat{$region} = $maxlat if $maxlat > $region_maxlat{$region};
		}
	}

	#--------------------------------------------------------------------------------------
	#	remember line
	#--------------------------------------------------------------------------------------

	$lc_def_lino{$lc} = $LINE;
}

#----------------------------------------------------------------------------------------------
#	Process dateline
#----------------------------------------------------------------------------------------------

sub fract {
	my( $x ) = @_;
	return $x - floor( $x );
}

sub wrap {
	my( $x ) = @_;
	return fract( $x/360 + 0.5) * 360 - 180;
}

foreach my $region( sort keys %region_name ){

	my $minlon = $region_minlon{ $region };
	my $maxlon = $region_maxlon{ $region };

	my $width = $maxlon - $minlon; $width += 360 unless $width >= 0;

	if( $width >= 360 ){

		$minlon = -180;
		$maxlon = +180;

	} else {

		$minlon = wrap( $minlon );
		$maxlon = wrap( $maxlon );
	}

	$region_minlon{ $region } = $minlon;
	$region_maxlon{ $region } = $maxlon;

	next unless $width >= 150;

	my $name = $region_name{ $region };

	warn sprintf "Wide region:  %7.2f .. %7.2f (%4u) %s\n",
		$minlon, $maxlon, $width, $name;
}

warn "\n";
	
foreach my $region( sort keys %region_name ){

	my $minlon = $region_minlon{ $region };
	my $maxlon = $region_maxlon{ $region };

	next unless $minlon > $maxlon;

	my $name = $region_name{ $region };

	warn sprintf "Wrap region:  %7.2f .. %7.2f %s\n",
		$minlon, $maxlon, $name;
}

warn "\n";
	
#----------------------------------------------------------------------------------------------
#	Format
#----------------------------------------------------------------------------------------------

my $FORMAT_RAW     = '%s%s:{"w":%.2f,"e":%.2f,"s":%.2f,"n":%.2f,"r":"%s"}';
my $FORMAT_ALIGNED = '%s%-9s:{"w":%7.2f,"e":%7.2f,"s":%6.2f,"n":%6.2f,"r":"%s"}';

my $FORMAT = $DoAlign ? $FORMAT_ALIGNED : $FORMAT_RAW;

#----------------------------------------------------------------------------------------------
#	Result line
#----------------------------------------------------------------------------------------------

my $sepa = "\n";

sub out {
	my( $code, $region ) = @_;

	printf $FORMAT,
		$sepa,
		"\"$code\"",
                $region_minlon { $region },
                $region_maxlon { $region },
                $region_minlat { $region },
                $region_maxlat { $region },
                $region_name   { $region };

	$sepa = ",\n";
}

#----------------------------------------------------------------------------------------------
#	JSON
#----------------------------------------------------------------------------------------------

print "{";

#----------------------------------------------------------------------------------------------
#	Languages
#----------------------------------------------------------------------------------------------

foreach my $lc( grep( /./, sort keys %lc_def_lino ) ){

	my $region = $lc_region{ $lc } // "region_$lc";

	out( $lc, $region );
}

#----------------------------------------------------------------------------------------------
#	Countries
#----------------------------------------------------------------------------------------------

foreach my $cc( sort keys %cc_defined ){

	out( "*-$cc", $cc );
}

#----------------------------------------------------------------------------------------------
#	JSON
#----------------------------------------------------------------------------------------------

print "\n}\n";

exit( 0 );

#----------------------------------------------------------------------------------------------
#	$Id: convert-lc-cc-region.pl,v 1.4 2023/01/20 19:56:50 wolf Exp $
#----------------------------------------------------------------------------------------------