bin/mkgeo

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use IO::File;
   7 use Math::Trig qw(deg2rad pip2 great_circle_distance);
   8 use XML::Writer;
   9 use XML::TreeBuilder;
  10 use YAML;
  11
  12 my $source = shift @ARGV;
  13 my $zone = shift @ARGV;
  14 my $servers = YAML::LoadFile("src/${source}");
  15
  16 my %countries = ();
  17
  18 my $countries = XML::TreeBuilder->new;
  19
  20 $countries->parsefile("lib/countries.xml");
  21
  22 foreach my $country ($countries->look_down("_tag" => "country"))
  23 {
  24     my $code = $country->look_down("_tag" => "countryCode")->as_text;
  25     my $name = $country->look_down("_tag" => "countryName")->as_text;
  26     my $continent = $country->look_down("_tag" => "continent")->as_text;
  27     my $west = $country->look_down("_tag" => "bBoxWest")->as_text;
  28     my $north = $country->look_down("_tag" => "bBoxNorth")->as_text;
  29     my $east = $country->look_down("_tag" => "bBoxEast")->as_text;
  30     my $south = $country->look_down("_tag" => "bBoxSouth")->as_text;
  31     my $lat = centre_lat( $south, $north );
  32     my $lon = centre_lon( $west, $east );
  33     my @servers;
  34
  35     foreach my $servername (keys %$servers)
  36     {
  37         my $server = $servers->{$servername};
  38         my $match = match_country($server, $code, $continent);
  39
  40         if ($match eq "preferred" || $match eq "allowed")
  41         {
  42             my $priority = $match eq "preferred" ? 20 : 10;
  43             my $distance = distance($lat, $lon, $server->{lat}, $server->{lon});
  44
  45 #            print STDERR "$servername is $match for $name with distance $distance\n";
  46
  47             push @servers, { name => $servername, priority => $priority, distance => $distance };
  48         }
  49     }
  50
  51     $countries{$code} = {
  52         code => $code, name => $name, continent => $continent,
  53         lat => $lat, lon => $lon, servers => \@servers
  54     };
  55 }
  56
  57 $countries->delete;
  58
  59 my $zonefile = IO::File->new("> data/${zone}") || die "$!";
  60 my $kmlfile = IO::File->new("> kml/${zone}.kml") || die "$!";
  61 my $kmlwriter = XML::Writer->new(OUTPUT => $kmlfile, ENCODING => 'utf-8');
  62
  63 $kmlwriter->xmlDecl();
  64 $kmlwriter->startTag("kml", "xmlns" => "http://www.opengis.net/kml/2.2");
  65 $kmlwriter->startTag("Document");
  66
  67 foreach my $country (values %countries)
  68 {
  69     my @servers = sort { $b->{priority} <=> $a->{priority} || $a->{distance} <=> $b->{distance} } @{$country->{servers}};
  70     my $server = $servers->{$servers[0]->{name}};
  71
  72     $zonefile->print("C\L$country->{code}\E.${zone}:$servers[0]->{name}.${zone}:600\n");
  73
  74     $kmlwriter->startTag("Placemark");
  75     $kmlwriter->dataElement("name", $country->{name});
  76     $kmlwriter->startTag("LineString");
  77     $kmlwriter->startTag("coordinates");
  78     $kmlwriter->characters("$country->{lon},$country->{lat}");
  79     $kmlwriter->characters(" ");
  80     $kmlwriter->characters("$server->{lon},$server->{lat}");
  81     $kmlwriter->endTag("coordinates");
  82     $kmlwriter->endTag("LineString");
  83     $kmlwriter->endTag("Placemark");
  84 }
  85
  86 foreach my $server (keys %$servers)
  87 {
  88     $zonefile->print("Cxx.${zone}:${server}.${zone}:600\n");
  89 }
  90
  91 $kmlwriter->endTag("Document");
  92 $kmlwriter->endTag("kml");
  93 $kmlwriter->end();
  94
  95 $kmlfile->close();
  96 $zonefile->close();
  97
  98 exit 0;
  99
 100 sub centre_lat
 101 {
 102     my $south = shift;
 103     my $north = shift;
 104
 105     return ( $south + $north ) / 2;
 106 }
 107
 108 sub centre_lon
 109 {
 110     my $west = shift;
 111     my $east = shift;
 112     my $lon;
 113
 114     if ($west < $east)
 115     {
 116         $lon = ( $west + $east ) / 2;
 117     }
 118     else
 119     {
 120         $lon = ( $west + $east + 360 ) / 2;
 121     }
 122
 123     $lon = $lon - 360 if $lon > 180;
 124
 125     return $lon
 126 }
 127
 128 sub match_country
 129 {
 130     my $server = shift;
 131     my $country = shift;
 132     my $continent = shift;
 133     my $match;
 134
 135     if ($server->{preferred} &&
 136         $server->{preferred}->{countries} &&
 137         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 138     {
 139         $match = "preferred";
 140     }
 141     elsif ($server->{preferred} &&
 142            $server->{preferred}->{continents} &&
 143            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 144     {
 145         $match = "preferred";
 146     }
 147     elsif ($server->{allowed} &&
 148            $server->{allowed}->{countries} &&
 149            grep { $_ eq $country } @{$server->{allowed}->{countries}})
 150     {
 151         $match = "allowed";
 152     }
 153     elsif ($server->{allowed} &&
 154            $server->{allowed}->{continents} &&
 155            grep { $_ eq $continent } @{$server->{allowed}->{continents}})
 156     {
 157         $match = "allowed";
 158     }
 159     elsif ($server->{allowed})
 160     {
 161         $match = "none";
 162     }
 163     else
 164     {
 165         $match = "allowed";
 166     }
 167
 168     return $match;
 169 }
 170
 171 sub distance
 172 {
 173     my $lat1 = deg2rad(shift);
 174     my $lon1 = deg2rad(shift);
 175     my $lat2 = deg2rad(shift);
 176     my $lon2 = deg2rad(shift);
 177
 178     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
 179 }