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