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("$server->{lon},$server->{lat}");
  80     $kmlwriter->endTag("coordinates");
  81     $kmlwriter->endTag("LineString");
  82     $kmlwriter->endTag("Placemark");
  83 }
  84
  85 foreach my $server (keys %$servers)
  86 {
  87     $zonefile->print("Cxx.${zone}:${server}.${zone}:600\n");
  88 }
  89
  90 $kmlwriter->endTag("Document");
  91 $kmlwriter->endTag("kml");
  92 $kmlwriter->end();
  93
  94 $kmlfile->close();
  95 $zonefile->close();
  96
  97 exit 0;
  98
  99 sub centre_lat
 100 {
 101     my $south = shift;
 102     my $north = shift;
 103
 104     return ( $south + $north ) / 2;
 105 }
 106
 107 sub centre_lon
 108 {
 109     my $west = shift;
 110     my $east = shift;
 111     my $lon;
 112
 113     if ($west < $east)
 114     {
 115         $lon = ( $west + $east ) / 2;
 116     }
 117     else
 118     {
 119         $lon = ( $west + $east + 360 ) / 2;
 120     }
 121
 122     $lon = $lon - 360 if $lon > 180;
 123
 124     return $lon
 125 }
 126
 127 sub match_country
 128 {
 129     my $server = shift;
 130     my $country = shift;
 131     my $continent = shift;
 132     my $match;
 133
 134     if ($server->{preferred} &&
 135         $server->{preferred}->{countries} &&
 136         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 137     {
 138         $match = "preferred";
 139     }
 140     elsif ($server->{preferred} &&
 141            $server->{preferred}->{continents} &&
 142            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 143     {
 144         $match = "preferred";
 145     }
 146     elsif ($server->{allowed} &&
 147            $server->{allowed}->{countries} &&
 148            grep { $_ eq $country } @{$server->{allowed}->{countries}})
 149     {
 150         $match = "allowed";
 151     }
 152     elsif ($server->{allowed} &&
 153            $server->{allowed}->{continents} &&
 154            grep { $_ eq $continent } @{$server->{allowed}->{continents}})
 155     {
 156         $match = "allowed";
 157     }
 158     elsif ($server->{allowed})
 159     {
 160         $match = "none";
 161     }
 162     else
 163     {
 164         $match = "allowed";
 165     }
 166
 167     return $match;
 168 }
 169
 170 sub distance
 171 {
 172     my $lat1 = deg2rad(shift);
 173     my $lon1 = deg2rad(shift);
 174     my $lat2 = deg2rad(shift);
 175     my $lon2 = deg2rad(shift);
 176
 177     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
 178 }