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