#!/usr/bin/perl -w
### /usr/bin/perl -wT
# 22/08/2011 - Appears I got heading and roll reversed
# fg_server_xml.cgi: for FGMap
# fg_server_kml.cgi: initial request from GE
# fg_server_kml.cgi and callsigns=: update request from GE
#
# TODO: callsigns is semicolon seperated, can be easily broken

use strict;
use warnings;
use Time::gmtime;
use IO::Socket;
#use lib "./sg_perl/blib/lib";
#use lib "./sg_perl/blib/arch/auto/sgmath";
#use sgmath;
#use Math::Trig qw(great_circle_distance great_circle_direction deg2rad rad2deg);
use Math::Trig;

my $SGD_PI = 3.1415926535;
my $SGD_DEGREES_TO_RADIANS = $SGD_PI / 180.0;
my $SGD_RADIANS_TO_DEGREES = 180.0 / $SGD_PI;
my $SGD_MIN = 1.17549e-038;

my $testing = 1;
my $test_socket = 1;
my $add_sg_math = 0;
my ($LF);
my $write_log = 1;
my $PATH_SEP = "\\";
my $log_out = "templog.txt";
my $log_dir = 'C:\GTools\perl';
my $log_file = $log_dir.$PATH_SEP.$log_out;
my $output_structure_value = 0; # add output to copy into a c++ module

my ($HTTP_HOST, $SCRIPT_NAME, $QUERY_STRING, $DOCUMENT_PATH);
#my $def_server = "localhost";
my $def_server = "mpserver14.flightgear.org";
my $port = 5001;
my $in_callsigns = "GA9999";
my $act_server = $def_server;
my(@last_callsigns);
my(@this_callsigns);

my $do_def_serv = 1;
my $do_win7 = 1;
my $do_all = 0;
my $do_fgx = 0;
my $do_dell01 = 0;
my $do_dell02 = 0;

my ($output) = "";
my ($l);
my (%ocs);

my @conversions = ();

#/// Quaternion
# x,y,z,w
my $QX = 0;
my $QY = 1;
my $QZ = 2;
my $QW = 3;
#/// Vector(3)
# x,y,z
my $VX = 0;
my $VY = 1;
my $VZ = 2;

sub prt($) {
    my $txt = shift;
    if ($write_log) {
        print $LF $txt;
    }
    print $txt;
}

sub test_conv();

sub fgs_rad2deg($) {
    my ($rad) = @_;
    return ($rad * $SGD_RADIANS_TO_DEGREES);
}

# 'mpserver01.flightgear.org (Germany)',
my %server_location = (
    1 => 'Frankfurt/Germany',
    2 => 'Kansas/USA / Hong Kong',
    3 => 'Germany',
    4 => 'UK',
    5 => 'Texas US',
    6 => 'Sweden',
    7 => 'Wisconsin US',
    8 => 'Germany',
    9 => 'Germany',
    10 => 'Montpellier, France',
    11 => 'Vilnius, Lithuania',
    12 => 'Amsterdam, Netherlands',
    13 => 'Grenoble, France'
    );

sub get_YYYYMMDD_hhmmss_UTC {
    my ($t) = shift;
    # sec, min, hour, mday, mon, year, wday, yday, and isdst.
    my $tm = gmtime($t);
    my $m = sprintf( "%04d/%02d/%02d %02d:%02d:%02d",
        $tm->year() + 1900, $tm->mon() + 1, $tm->mday(), $tm->hour(), $tm->min(), $tm->sec());
    return $m;
}

# ============================================================ #
# SimGear Services, rendered in perl
# ============================================================ #
# dot(const SGVec3<T>& v1, const SGVec3<T>& v2)
# { return v1(0)*v2(0) + v1(1)*v2(1) + v1(2)*v2(2); }
# Given 2 Vectors3, return the dot product
sub scalar_dot_product($$) {
    my ($rv1,$rv2) = @_;
    return ${$rv1}[0] * ${$rv2}[0] + ${$rv1}[1] * ${$rv2}[1] + ${$rv1}[2] * ${$rv2}[2];
}

# The euclidean norm of the vector, that is what most people call length
# norm(const SGVec3<T>& v)
# { return sqrt(dot(v, v)); }
# Given a Vector3, return length
sub norm_vector_length($) {
    my ($rv) = @_;
    return sqrt(scalar_dot_product($rv, $rv));
}

# print out a quaternion - x,y,z,w
sub show_quat($) {
    my ($rv4) = @_;
    my $x = ${$rv4}[$QX];
    my $y = ${$rv4}[$QY];
    my $z = ${$rv4}[$QZ];
    my $w = ${$rv4}[$QW];
    print "x $x, y $y, z $z, w $w\n";
}

# print out a vector3
sub show_vec3($) {
    my ($rv3) = @_;
    my $x = ${$rv3}[0];
    my $y = ${$rv3}[1];
    my $z = ${$rv3}[2];
    print "x $x, y $y, z $z\n";
}

#/// The conjugate of the quaternion, this is also the
#/// inverse for normalized quaternions
#SGQuat<T> conj(const SGQuat<T>& v)
#{ return SGQuat<T>(-v(0), -v(1), -v(2), v(3)); }
sub quat_conj($) {
    my ($rq) = @_;
    my @q = (0,0,0,0);
    $q[$QX] = -${$rq}[$QX];
    $q[$QY] = -${$rq}[$QY];
    $q[$QZ] = -${$rq}[$QZ];
    $q[$QW] =  ${$rq}[$QW];
    # return [ -${$rq}[0], -${$rq}[1], -${$rq}[2], ${$rq}[3] ];
    return \@q;
}


#/// Quaternion multiplication
sub mult_quats($$) {
    my ($rv1,$rv2) = @_;
    my @v = (0,0,0,0);
    $v[$QX] = ${$rv1}[$QW] * ${$rv2}[$QX] + ${$rv1}[$QX] * ${$rv2}[$QW] + ${$rv1}[$QY] * ${$rv2}[$QZ] - ${$rv1}[$QZ] * ${$rv2}[$QY];
    $v[$QY] = ${$rv1}[$QW] * ${$rv2}[$QY] - ${$rv1}[$QX] * ${$rv2}[$QZ] + ${$rv1}[$QY] * ${$rv2}[$QW] + ${$rv1}[$QZ] * ${$rv2}[$QX];
    $v[$QZ] = ${$rv1}[$QW] * ${$rv2}[$QZ] + ${$rv1}[$QX] * ${$rv2}[$QY] - ${$rv1}[$QY] * ${$rv2}[$QX] + ${$rv1}[$QZ] * ${$rv2}[$QW];
    $v[$QW] = ${$rv1}[$QW] * ${$rv2}[$QW] - ${$rv1}[$QX] * ${$rv2}[$QX] - ${$rv1}[$QY] * ${$rv2}[$QY] - ${$rv1}[$QZ] * ${$rv2}[$QZ];
    return \@v;
}

#SGVec3<T> mult(const SGVec3<T>& v1, const SGVec3<T>& v2)
#{ return SGVec3<T>(v1(0)*v2(0), v1(1)*v2(1), v1(2)*v2(2)); }
sub mult_vec3($$) {
    my ($rv1,$rv2) = @_;
    my @v = (0,0,0);
    $v[0] = ${$rv1}[0] * ${$rv2}[0];
    $v[1] = ${$rv1}[1] * ${$rv2}[1];
    $v[2] = ${$rv1}[2] * ${$rv2}[2];
    return \@v;
}

#/// Scalar multiplication
#template<typename S, typename T>
# SGVec3<T> operator*(S s, const SGVec3<T>& v)
#{ return SGVec3<T>(s*v(0), s*v(1), s*v(2)); }
sub scalar_mult_vector($$) {
    my ($s,$rv) = @_;
    my @v = (0,0,0);
    $v[0] = ${$rv}[0] * $s;
    $v[1] = ${$rv}[1] * $s;
    $v[2] = ${$rv}[2] * $s;
    return \@v;
}

#  /// write the euler angles into the references
#  void getEulerRad(T& zRad, T& yRad, T& xRad) const {
#    T sqrQW = w()*w();
#    T sqrQX = x()*x();
#    T sqrQY = y()*y();
#    T sqrQZ = z()*z();
#    T num = 2*(y()*z() + w()*x());
#    T den = sqrQW - sqrQX - sqrQY + sqrQZ;
#    if (fabs(den) <= SGLimits<T>::min() &&
#        fabs(num) <= SGLimits<T>::min())
#      xRad = 0;
#    else
#      xRad = atan2(num, den);
#    T tmp = 2*(x()*z() - w()*y());
#    if (tmp <= -1)
#      yRad = T(0.5)*SGMisc<T>::pi();
#    else if (1 <= tmp)
#      yRad = -T(0.5)*SGMisc<T>::pi();
#    else
#      yRad = -asin(tmp);
#    num = 2*(x()*y() + w()*z()); 
#    den = sqrQW + sqrQX - sqrQY - sqrQZ;
#    if (fabs(den) <= SGLimits<T>::min() &&
#        fabs(num) <= SGLimits<T>::min())
#      zRad = 0;
#    else {
#      T psi = atan2(num, den);
#      if (psi < 0)
#        psi += 2*SGMisc<T>::pi();
#      zRad = psi;
#    }
#  }
sub getEulerRad($$$$) {
    my ($rq, $rzRad, $ryRad, $rxRad) = @_;
    my ($xRad,$yRad,$zRad);
    my $sqrQW = ${$rq}[$QW] * ${$rq}[$QW];
    my $sqrQX = ${$rq}[$QX] * ${$rq}[$QX];
    my $sqrQY = ${$rq}[$QY] * ${$rq}[$QY];
    my $sqrQZ = ${$rq}[$QZ] * ${$rq}[$QZ];

    # y * z + w * x
    my $num = 2 * ( ${$rq}[$QY] * ${$rq}[$QZ] + ${$rq}[$QW] * ${$rq}[$QX] );
    my $den = $sqrQW - $sqrQX - $sqrQY + $sqrQZ;
    if ((abs($den) <= 0.0000001) &&
        (abs($num) <= 0.0000001) ) {
        $xRad = 0;
    } else {
        $xRad = atan2($num, $den);
    }

    # x * z - w * y
    my $tmp = 2 * ( ${$rq}[$QX] * ${$rq}[$QZ] - ${$rq}[$QW] * ${$rq}[$QY] );
    if ($tmp <= -1) {
        $yRad = 0.5 * $SGD_PI;
    } elsif (1 <= $tmp) {
        $yRad = - 0.5 * $SGD_PI;
    } else {
        $yRad = -asin($tmp); # needs Math::Trig
    }

    # x * y + w * z
    $num = 2 * ( ${$rq}[$QX] * ${$rq}[$QY] + ${$rq}[$QW] * ${$rq}[$QZ] ); 
    $den = $sqrQW + $sqrQX - $sqrQY - $sqrQZ;
    if ((abs($den) <= 0.0000001) &&
        (abs($num) <= 0.0000001) ) {
        $zRad = 0;
    } else {
        my $psi = atan2($num, $den);
        if ($psi < 0) {
            $psi += 2 * $SGD_PI;
        }
        $zRad = $psi;
    }
    # pass value back
    ${$rxRad} = $xRad;
    ${$ryRad} = $yRad;
    ${$rzRad} = $zRad;
}

# uses getEulerRad, and converts to degrees
sub getEulerDeg($$$$) {
    my ($rq,$rzDeg,$ryDeg,$rxDeg) = @_;
    my ($xRad,$yRad,$zRad);
    getEulerRad($rq, \$zRad, \$yRad, \$xRad);
    # pass converted values back
    ${$rzDeg} = fgs_rad2deg($zRad);
    ${$ryDeg} = fgs_rad2deg($yRad);
    ${$rxDeg} = fgs_rad2deg($xRad);
}

#  static SGQuat fromRealImag(T r, const SGVec3<T>& i) {
#    SGQuat q;
#    q.w() = r;
#    q.x() = i.x();
#    q.y() = i.y();
#    q.z() = i.z();
#    return q; }
sub fromRealImag($$) {
    my ($r, $ri) = @_;
    my @q = (0,0,0,0);
    $q[$QW] = $r;
    $q[$QX] = ${$ri}[0];
    $q[$QY] = ${$ri}[1];
    $q[$QZ] = ${$ri}[2];
    return \@q;
}

#  /// Create a quaternion from the angle axis representation where the angle
#  /// is stored in the axis' length
#  static SGQuat fromAngleAxis(const SGVec3<T>& axis) {
#    T nAxis = norm(axis);
#    if (nAxis <= SGLimits<T>::min())
#      return SGQuat::unit();
#    T angle2 = T(0.5)*nAxis;
#    return fromRealImag(cos(angle2), T(sin(angle2)/nAxis)*axis); }
sub fromAngleAxis($) {
    my ($raxis) = @_;
    my $nAxis = norm_vector_length($raxis);
    if ($nAxis <= 0.0000001) {
        my @arr = (0,0,0,0);
        return \@arr; # SGQuat::unit();
    }
    my $angle2 = $nAxis * 0.5;
    my $sang = sin($angle2) / $nAxis ;
    my $cang = cos($angle2);
    #print "nAxis = $nAxis, ange2 = $angle2, saxa = $sang\n";
    my $rv = scalar_mult_vector($sang,$raxis);
    #print "san ";
    #show_vec3($rv);
    #return fromRealImag(cos(angle2), T(sin(angle2)/nAxis)*axis);
    return fromRealImag( $cang, $rv );
}

#  /// Return a quaternion rotation from the earth centered to the
#  /// simulation usual horizontal local frame from given
#  /// longitude and latitude.
#  /// The horizontal local frame used in simulations is the frame with x-axis
#  /// pointing north, the y-axis pointing eastwards and the z axis
#  /// pointing downwards.
#  static SGQuat fromLonLatRad(T lon, T lat)
#    SGQuat q;
#    T zd2 = T(0.5)*lon;
#    T yd2 = T(-0.25)*SGMisc<T>::pi() - T(0.5)*lat;
#    T Szd2 = sin(zd2);
#    T Syd2 = sin(yd2);
#    T Czd2 = cos(zd2);
#    T Cyd2 = cos(yd2);
#    q.w() = Czd2*Cyd2;
#    q.x() = -Szd2*Syd2;
#    q.y() = Czd2*Syd2;
#    q.z() = Szd2*Cyd2;
#    return q;  }
sub fromLonLatRad($$) {
    my ($lonr,$latr) = @_;
    my @q = (0,0,0,0);
    my $zd2 = 0.5 * $lonr; 
    my $yd2 = -0.25 * $SGD_PI - (0.5 * $latr);
    my $Szd2 = sin($zd2);
    my $Syd2 = sin($yd2);
    my $Czd2 = cos($zd2);
    my $Cyd2 = cos($yd2);
    $q[$QW] = $Czd2 * $Cyd2;
    $q[$QX] = - $Szd2 * $Syd2;
    $q[$QY] = $Czd2 * $Syd2;
    $q[$QZ] = $Szd2 * $Cyd2;
    return \@q;
}

#void euler_get(float lat, float lon, float ox, float oy, float oz,
#    float *head, float *pitch, float *roll)
#{
#    /* FGMultiplayMgr::ProcessPosMsg */
#    SGVec3f angleAxis;
#    angleAxis(0) = ox;
#    angleAxis(1) = oy;
#    angleAxis(2) = oz;
#    SGQuatf ecOrient;
#    ecOrient = SGQuatf::fromAngleAxis(angleAxis);
#    /* FGAIMultiplayer::update */
#    float lat_rad, lon_rad;
#    lat_rad = lat * SGD_DEGREES_TO_RADIANS;
#    lon_rad = lon * SGD_DEGREES_TO_RADIANS;
#    SGQuatf qEc2Hl = SGQuatf::fromLonLatRad(lon_rad, lat_rad);
#    SGQuatf hlOr = conj(qEc2Hl) * ecOrient;
#    float hDeg, pDeg, rDeg;
#    hlOr.getEulerDeg(hDeg, pDeg, rDeg);
#    if(head)
#        *head = hDeg;
#    if(pitch)
#        *pitch = pDeg;
#    if(roll)
#        *roll = rDeg;
#}
sub euler_get($$$$$$$$) {
    my ($lat, $lon, $ox, $oy, $oz, $rhead, $rpitch, $rroll) = @_;
    #/* FGMultiplayMgr::ProcessPosMsg */
    my @angleAxis = ($ox,$oy,$oz);
    #push(@angleAxis, $ox);
    #push(@angleAxis, $oy);
    #push(@angleAxis, $oz);
    #print "angleAxis ";
    #show_vec3(\@angleAxis);
    my $recOrient = fromAngleAxis(\@angleAxis); # ecOrient = SGQuatf::fromAngleAxis(angleAxis);
    #print "ecOrient ";
    #show_quat($recOrient);
    #/* FGAIMultiplayer::update */
    my ($lat_rad, $lon_rad);
    $lat_rad = $lat * $SGD_DEGREES_TO_RADIANS;
    $lon_rad = $lon * $SGD_DEGREES_TO_RADIANS;
    my $qEc2Hl = fromLonLatRad($lon_rad, $lat_rad);
    #print "fromLonLatRad ";
    #show_quat($qEc2Hl);
    my $con = quat_conj($qEc2Hl);
    #print "conj ";
    #show_quat($con);
    my $rhlOr = mult_quats($con, $recOrient);
    #print "mult ";
    #show_quat($rhlOr);
    getEulerDeg($rhlOr, $rhead, $rpitch, $rroll );
}

# ================================================================ #
# End SimGear Fuctions
# ================================================================ #

# XML output, for FGMap
my($XML_HEADER) = <<XML;
Pragma: no-cache
Cache-Control: no-cache
Expires: Sat, 17 Sep 1977 00:00:00 GMT
Content-Type: text/xml

XML

if ($write_log) {
    if (!open $LF, ">$log_file") {
        print "ERROR: Log file FAILED\n";
        exit 1;
    }
}

sub do_xml_header
{
    my($cnt) = @_;
    return ${XML_HEADER}."<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n<fg_server pilot_cnt=\"${cnt}\">\n";
}

sub do_xml_single
{
    my($callsign, $server_ip, $model, $lat, $lon, $alt, $head, $pitch, $roll) =
        @_;
    return <<XML;
    <marker callsign="${callsign}" server_ip="${server_ip}" model="${model}" lat="${lat}" lng="${lon}" alt="${alt}" heading="${head}" pitch="${pitch}" roll="${roll}" />
XML
}

sub do_xml_tail
{
    return "</fg_server>\n\n";
}

my(%xml_output) =
(
    'header' => \&do_xml_header,
    'single' => \&do_xml_single,
    'tail' => \&do_xml_tail,
);


######

my($KML_HEADER) = <<KML;
Pragma: no-cache
Cache-Control: no-cache
Expires: Sat, 17 Sep 1977 00:00:00 GMT
Content-Type: application/vnd.google-earth.kml+xml

KML

my($DAE_SCALE) = "150.0";
my($KML_REFRESH_INTERVAL) = "5";

sub kml_model_url_get
{
    my($model) = @_;
    my(@GE_MODELS) = ( 'c172p', 'ufo', '737-300', );
    if(!grep(/^${model}$/, @GE_MODELS))
    {
        $model = $GE_MODELS[0];
    }
    return "http://${HTTP_HOST}/${DOCUMENT_PATH}/ge/daes/${model}/${model}.dae";
}


# KML (initial) output, for Google Earth
sub do_kml_header
{
    my($kml) = <<KML;
<?xml version="1.0" encoding="UTF-8" ?>
<kml xmlns="http://earth.google.com/kml/2.0">
<Document id="mpmap">
<name>FlightGear MP server map</name>
<visibility>1</visibility>
KML
    return ${KML_HEADER}.${kml};

}

sub do_kml_single
{
    my($callsign, $server_ip, $model, $lat, $lon, $alt, $head, $pitch, $roll) =
        @_;

    push(@this_callsigns, $callsign);

    # simple feet to meter
    $alt *= 0.3048;

    my($model_url) = &kml_model_url_get($model);

    return <<KML;
    <Placemark id="${callsign}">
        <name>${callsign}</name>
        <description>${callsign}: ${model}</description>
        <Model>
            <altitudeMode>absolute</altitudeMode>
            <Location>
                <latitude>${lat}</latitude>
                <longitude>${lon}</longitude>
                <altitude>${alt}</altitude>
            </Location>
            <Orientation>
                <heading>${head}</heading>
                <tilt>${pitch}</tilt>
                <roll>${roll}</roll>
            </Orientation>
            <Scale>
                <x>${DAE_SCALE}</x>
                <y>${DAE_SCALE}</y>
                <z>${DAE_SCALE}</z>
            </Scale>
            <Link>
                <href>${model_url}</href>
                <refreshMode>onChange</refreshMode>
            </Link>
        </Model>
    </Placemark>

KML
}

sub do_kml_tail
{
    my($callsigns_str) = join(';', @this_callsigns);
    return <<KML;
    <NetworkLink id="fgmap_update">
        <name>Update</name>
        <Link>
            <href>http://${HTTP_HOST}/${DOCUMENT_PATH}/fg_server_kml.cgi?${act_server}:${port}&amp;callsigns=${callsigns_str}</href>
            <refreshMode>onInterval</refreshMode>
            <refreshInterval>${KML_REFRESH_INTERVAL}</refreshInterval>
        </Link>
    </NetworkLink>
</Document>
</kml>
KML
}

my(%kml_normal_output) =
(
    'header' => \&do_kml_header,
    'single' => \&do_kml_single,
    'tail' => \&do_kml_tail,
);


# KML (update) output, for Google Earth
sub do_kml_update_header
{
    my($kml) = <<KML;
<?xml version="1.0" encoding="UTF-8" ?>
<kml xmlns="http://earth.google.com/kml/2.0">
<NetworkLinkControl>
<Update>
    <targetHref>http://${HTTP_HOST}/${DOCUMENT_PATH}/fg_server_kml.cgi?${act_server}:${port}</targetHref>
KML
    return ${KML_HEADER}.${kml};
}

sub do_kml_update_single
{
    my($callsign, $server_ip, $model, $lat, $lon, $alt, $head, $pitch, $roll) =
        @_;

    # simple feet to meter
    $alt *= 0.3048;

    my($model_url) = &kml_model_url_get($model);

    push(@this_callsigns, $callsign);

    if(grep(/^${callsign}$/, @last_callsigns))
    {
        # We have it before, <Change> it

        return <<KML;
    <Change>
        <Placemark targetId="${callsign}">
            <Model>
                <Location>
                    <latitude>${lat}</latitude>
                    <longitude>${lon}</longitude>
                    <altitude>${alt}</altitude>
                </Location>
                <Orientation>
                    <heading>${head}</heading>
                    <tilt>${pitch}</tilt>
                    <roll>${roll}</roll>
                </Orientation>
            </Model>
        </Placemark>
    </Change>
KML
    }
    else
    {
        # New one, <Create> it
        return <<KML;
    <Create>
        <Document targetId="mpmap">
            <Placemark id="${callsign}">
                <name>${callsign}</name>
                <description>${callsign}: ${model}</description>
                <Model>
                    <altitudeMode>absolute</altitudeMode>
                    <Location>
                        <latitude>${lat}</latitude>
                        <longitude>${lon}</longitude>
                        <altitude>${alt}</altitude>
                    </Location>
                    <Orientation>
                        <heading>${head}</heading>
                        <tilt>${pitch}</tilt>
                        <roll>${roll}</roll>
                    </Orientation>
                    <Scale>
                        <x>${DAE_SCALE}</x>
                        <y>${DAE_SCALE}</y>
                        <z>${DAE_SCALE}</z>
                    </Scale>
                    <Link>
                        <href>${model_url}</href>
                        <refreshMode>onChange</refreshMode>
                    </Link>
                </Model>
            </Placemark>
        </Document>
    </Create>
KML
    }
}

sub do_kml_update_tail
{
    my($callsign);
    my($kml);
    my($callsigns_str) = join(';', @this_callsigns);

    foreach $callsign (@last_callsigns)
    {
        if(!grep(/^${callsign}$/, @this_callsigns))
        {
            $kml .= <<KML;
    <Delete>
        <Placemark targetId="${callsign}" />
    </Delete>
KML
        }
    }

    $kml .= <<KML;
    <Change>
        <NetworkLink targetId="fgmap_update">
            <Link>
                <href>http://${HTTP_HOST}/${DOCUMENT_PATH}/fg_server_kml.cgi?${act_server}:${port}&amp;callsigns=${callsigns_str}</href>
            </Link>
        </NetworkLink>
    </Change>
</Update>
</NetworkLinkControl>
</kml>
KML
}

my(%kml_update_output) =
(
    'header' => \&do_kml_update_header,
    'single' => \&do_kml_update_single,
    'tail' => \&do_kml_update_tail,
);



sub escape_strs
{
    my($str) = @_;
    $str =~ s/"/\&quot;/g;
    $str =~ s/'/\&apos;/g;
    $str =~ s/\&/\&amp;/g;
    $str =~ s/>/\&gt;/g;
    $str =~ s/</\&lt;/g;
    return $str;
}



# Main starts here
# &fg_server=mpserver01:5000,mpserver01.flightgear.org,5001
if ($testing) {
    $HTTP_HOST = "mpserver01.flightgear.org";
    $QUERY_STRING = "mpserver01:5000";
    $SCRIPT_NAME = $0;
    $act_server = "mpserver01.flightgear.org";
    $port = 5001;
    $in_callsigns = 'GA9999';
} else {
    $HTTP_HOST = $ENV{'HTTP_HOST'};
    $QUERY_STRING = $ENV{'QUERY_STRING'};
    $SCRIPT_NAME = $ENV{'SCRIPT_NAME'};

    if(!defined(${HTTP_HOST}) ||
            !defined(${QUERY_STRING}) ||
            !defined(${SCRIPT_NAME}))
    {
        exit(-1);
    }

    ($DOCUMENT_PATH) = (${SCRIPT_NAME} =~ /^\/*(.*)\/.*?$/);

    ($act_server, $port, $in_callsigns) =
        (${QUERY_STRING} =~ m#(.*?):(\d+)&?(.*)#);

    if(!defined($act_server) || !(defined($port)))
    {
        exit(-1);
    }

    $act_server =~ s#></\\&\?\|\!\*##g;
    $port =~ s#></\\&\?\|\!\*##g;

    if($port <= 0 || $port >= 65536)
    {
        exit(-1);
    }

}

prt("Host $HTTP_HOST, query $QUERY_STRING, script $SCRIPT_NAME, server $act_server, port $port, callsign $in_callsigns\n");

if($0 =~ m/fg_server_kml.cgi$/)
{
    if($in_callsigns =~ m/^callsigns=(.*)$/)
    {
        $in_callsigns = $1;
        @last_callsigns = split(/;/, $in_callsigns);
        %ocs = %kml_update_output;
    }
    else
    {
        %ocs = %kml_normal_output;
    }
}
else
{
    %ocs = %xml_output;
}


sub do_socket
{
    my($ret) = "";
    my($pilot_total) = 0;
    my($pilot_cnt) = 0;
    my($head, $pitch, $roll);
    prt("Opening socket to $act_server:$port...\n");
    my($socket) = IO::Socket::INET->new(PeerAddr => $act_server,
                                        PeerPort => $port,
                                        Proto => "tcp",
                                        Type => SOCK_STREAM,
                                        Timeout => 10);

    if($socket)
    {
        while($l = <$socket>)
        {
            chomp($l);
            if ($write_log) {
                print $LF "# ".get_YYYYMMDD_hhmmss_UTC(time())."\n";
                print $LF "$l\n";
            }
            if((substr($l, 0, 1) eq "#") && ($l =~ /^# (\d+) .*? online/))
            {
                $pilot_total = $1;
                $ret .= $ocs{'header'}->($pilot_total);
            }
            #elsif($l =~ m/^(.*)@(.*?): (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (.*?)$/)
            elsif($l =~ m/^(.*)@(.*?): (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (.*?)$/)
            {
                my($callsign, $server_ip,
                        $x, $y, $z,
                        $lat, $lon, $alt,
                        $ox, $oy, $oz,
                        $model) =
                    ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);

                $callsign = &escape_strs(${callsign});

                $callsign =~ s/^# //g;

                if($callsign and $model)
                {
                    #$model =~ s#.*/(.*?)\..*?$#$1#;
                    $model =~ s#.*/(.*?)#$1#;
                    $model =~ s/\..*?$//;
                    if ($add_sg_math) {
                        ($head, $pitch, $roll) = &sgmath::euler_get($lat, $lon,
                            $ox, $oy, $oz);
                    } else {
                        $head = 0;
                        $pitch = 0;
                        $roll = 0;
                        euler_get($lat, $lon, $ox, $oy, $oz, \$head, \$pitch, \$roll);
                    }

                    $ret .= $ocs{'single'}->($callsign, $server_ip, $model,
                            $lat, $lon, $alt,
                            $head, $pitch, $roll);

                    $pilot_cnt++;

                    if($pilot_cnt >= $pilot_total)
                    {
                        prt("Done pilot count $pilot_cnt...\n");
                        close($socket);
                        undef($socket);
                        last;
                    }
                }
            }

        }

        $ret .= $ocs{'tail'}->();

        if($socket)
        {
            close($socket);
        }
    }
    else
    {
        prt("Socket to $act_server:$port FAILED\n");
        $ret .= $ocs{'header'}->(0);
        $ret .= $ocs{'tail'}->();
    }

    return $ret;
}

# sample data 2010-12-23 13:00 UTC
sub sample_serv_data() {
    my $sd = <<EOF;
# This is mpserver01
# FlightGear Multiplayer Server v0.10.6 using protocol version v1.1 (LazyRelay enabled)
# This server is tracked: 194.126.113.132
# 29 pilots online
G-EORG\@mpserver05: 3812658.100607 -151569.530046 5093855.734726 53.348596 -2.276554 241.742828 -2.904634 1.457308 0.992861 Aircraft/777-200/Models/777-200ER.xml
USSVins\@mpserver05: -3430657.654572 4738394.026494 2532904.213932 23.552273 125.905017 0 -3.605824 -2.337402 -0.144971 Aircraft/MPCarrier/Models/mp-vinson.xml
LZ076\@mpserver05: 1623201.743093 -5652250.888576 2476715.476662 22.976706 -73.977102 19926.475257 -2.037041 1.598863 0.824076 Aircraft/Concorde/Models/Concorde_ba.xml
rady\@LOCAL: 3978197.677722 3825.311658 4968731.806327 51.505225 0.055093 31.379322 -1.868831 -1.807119 0.665704 Aircraft/il-96-400/Models/il-96-400.xml
F-VEBR\@LOCAL: -1296144.775344 -4931223.439358 3824671.247865 37.059242 -104.726766 11048.258345 -1.979754 -1.295663 -0.891624 Aircraft/Citation/Models/Citation-II.xml
G-ATOM\@mpserver05: -2654859.059820 -4296141.895715 3887895.628692 37.776634 -121.714553 10807.638831 -0.258662 2.368900 0.925450 Aircraft/Fairchild-Metroliner/Models/metroliner.xml
thuko48\@LOCAL: -184106.059280 5726769.818089 2819771.855810 26.355679 91.841329 39507.394911 -3.739011 1.483983 -1.047733 Aircraft/RA-5/Models/RA-5.xml
Palo\@mpserver12: -1296208.720119 -4931225.984241 3824646.824350 37.058965 -104.727454 11048.973275 -1.988018 -1.290148 -0.901166 Aircraft/Citation/Models/Citation-II.xml
PL-LOT\@mpserver04: 3661318.945555 1403507.444958 5013731.534147 52.158566 20.973518 353.156860 -1.592723 3.454173 0.085857 Aircraft/777-200/Models/777-200ER.xml
Bravo_O\@mpserver05: -2674012.886200 -4331218.150245 3832938.101049 37.165113 -121.690404 5031.982828 1.764562 2.304961 1.420491 Aircraft/777-200/Models/777-200ER.xml
EC-BOE\@LOCAL: 1754214.445244 -5033329.151026 -3491841.557211 -33.405350 -70.785546 1585.456153 -0.928745 0.622462 1.710294 Aircraft/737-300/Models/737-300.xml
VooDoo\@LOCAL: 3789432.539964 -481990.341826 5102726.752967 53.365207 -7.248714 32000.003652 -2.268327 -1.353068 0.591359 Aircraft/F-15E/Models/F-15E_StrikeEagle.xml
MyName\@mpserver12: 3346022.397442 3449127.092685 4199975.409472 41.343922 45.869298 43713.225510 -3.469154 1.877697 0.442268 Aircraft/RA-5/Models/RA-5.xml
F-Sig\@LOCAL: 4677997.718361 172263.872095 4318799.168266 42.886150 2.108922 2680.109989 -2.300405 2.555840 0.096592 Aircraft/A-26-Invader/Models/a26_airspray.xml
3-m\@LOCAL: 4057948.093128 612338.634629 4866273.361465 50.047514 8.581111 380.306510 -2.805102 -0.708596 1.014189 Aircraft/747-400/Models/747-400.xml
Moli\@LOCAL: 3697137.810465 -182183.328431 5177607.541880 54.619765 -2.821073 2483.148037 -0.652895 -2.321629 0.492411 Aircraft/Hunter/Models/hunter-model.xml
Gary\@mpserver04: -2708373.846893 -4272259.436347 3871972.000177 37.618259 -122.372414 16.652365 1.408777 2.310530 1.513795 Aircraft/777-200/Models/777-200ER.xml
MAXSOUS\@mpserver05: -2675383.210813 -4295387.552552 3871849.932250 37.606227 -121.916724 5047.762562 0.832303 2.526580 1.277845 Aircraft/777-200/Models/777-200ER.xml
wrg\@LOCAL: 2778321.202959 1622347.280472 5488794.143509 59.790510 30.281971 89.496650 -2.828505 2.222536 0.367799 Aircraft/IL-76TD/Models/IL-76.xml
JX001\@mpserver05: -3862153.276306 3568411.639965 3600553.470854 34.580434 137.263811 5269.727143 -3.458702 -1.875070 -0.669141 Aircraft/CitationX/Models/Citation-X.xml
Pat\@LOCAL: -3372130.875307 4729529.415259 2626538.061560 24.476405 125.488679 1100.003433 -0.630060 -3.540042 1.619858 Aircraft/A6M2/Models/a6m2-anim.xml
yama\@mpserver05: -3742599.581973 3702823.258514 3590065.752183 34.469471 135.306093 3276.664002 1.998240 -1.928568 1.684790 Aircraft/777-200/Models/777-200ER.xml
vityaz\@mpserver12: 2419639.459966 2840526.916974 5157847.424201 54.299077 49.574723 6491.677537 -1.823260 -1.929294 1.283035 Aircraft/tu154/Models/tu154B.xml
TaroGP\@LOCAL: -3933763.807616 3414143.342294 3671179.686543 35.358054 139.045040 4786.410447 -1.186623 -3.800322 0.402067 Aircraft/F-5E/Models/F-5Emin.xml
A.N.\@LOCAL: 4058278.241201 611586.107680 4866085.885434 50.044955 8.570035 360.192674 -2.956757 1.738947 0.995623 Aircraft/MD-81/Models/MD-81.xml
callsig\@LOCAL: -2710372.808231 -4270486.990678 3873550.662447 37.631867 -122.402289 2071.606968 1.197675 2.533158 1.513910 Aircraft/tu154/Models/tu154B.xml
Robs\@LOCAL: -2709465.579599 -4271004.997411 3872580.533783 37.625212 -122.390467 1.859416 -1.173042 0.721231 0.885302 Aircraft/sopwithCamel/Models/sopwithCamel-model-Y.xml
Pat2\@LOCAL: -3348865.829712 4731340.739543 2654107.725233 24.747771 125.291044 2986.301055 -0.630981 -3.923400 1.529822 Aircraft/A6M2/Models/a6m2-anim.xml
seb\@LOCAL: -2414320.669511 -1452476.904089 5703342.399797 63.862267 -148.968508 1369.537204 3.050772 0.941372 0.724262 Aircraft/bo105/Models/bo105.xml
EOF
    return $sd;
}


sub process_lines($) {
    my ($rlines) = @_;
    my($ret) = "";
    my($pilot_total) = 0;
    my($pilot_cnt) = 0;
    my($head, $pitch, $roll);
    my($socket) = scalar @{$rlines};
    if($socket) {
        foreach $l (@{$rlines}) {
            chomp($l);
            #if ($write_log) {
            #    print $LF "# ".get_YYYYMMDD_hhmmss_UTC(time())."\n";
            #    print $LF "$l\n";
            #}
            if((substr($l, 0, 1) eq "#") && ($l =~ /^# (\d+) .*? online/))
            {
                $pilot_total = $1;
                $ret .= $ocs{'header'}->($pilot_total);
            }
            #elsif($l =~ m/^(.*)@(.*?): (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (.*?)$/)
            elsif($l =~ m/^(.*)@(.*?): (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (.*?)$/)
            {
                my($callsign, $server_ip,
                        $x, $y, $z,
                        $lat, $lon, $alt,
                        $ox, $oy, $oz,
                        $model) =
                    ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);

                $callsign = &escape_strs(${callsign});

                $callsign =~ s/^# //g;

                if($callsign and $model)
                {
                    #$model =~ s#.*/(.*?)\..*?$#$1#;
                    $model =~ s#.*/(.*?)#$1#;
                    $model =~ s/\..*?$//;
                    if ($add_sg_math) {
                        ($head, $pitch, $roll) = &sgmath::euler_get($lat, $lon,
                            $ox, $oy, $oz);
                    } else {
                        $head = 0;
                        $pitch = 0;
                        $roll = 0;
                        euler_get($lat, $lon, $ox, $oy, $oz, \$head, \$pitch, \$roll);
                        push(@conversions, [$lat, $lon, $ox, $oy, $oz, $head, $pitch, $roll] );
                    }

                    $ret .= $ocs{'single'}->($callsign, $server_ip, $model,
                            $lat, $lon, $alt,
                            $head, $pitch, $roll);

                    $pilot_cnt++;

                    if($pilot_cnt >= $pilot_total)
                    {
                        close($socket);
                        undef($socket);
                        last;
                    }
                }
            }

        }

        $ret .= $ocs{'tail'}->();

        #if($socket)
        #{
        #    close($socket);
        #}
    }
    else
    {
        $ret .= $ocs{'header'}->(0);
        $ret .= $ocs{'tail'}->();
    }

    return $ret;
}


sub get_socket_lines() {
    my $dat = sample_serv_data();
    my @arr = split(/\n/,$dat);
    return \@arr;
}

sub do_testing() {
    my $ra = get_socket_lines();
    my $ret = process_lines($ra);
    if ($output_structure_value) {
        # output the conversion as an structure array
        #                     0     1     2    3    4    5      6       7
        # push(@conversions, [$lat, $lon, $ox, $oy, $oz, $head, $pitch, $roll] );
        my $ra = \@conversions;
        my $cnt = scalar @{$ra};
        prt("Got $cnt conversions...\n");
        my ($lat, $lon, $ox, $oy, $oz, $head, $pitch, $roll);
        my ($i,$i2);
        for ($i = 0; $i < $cnt; $i++) {
            $i2 = $i + 1;
            $lat = ${$ra}[$i][0];
            $lon = ${$ra}[$i][1];
            $ox  = ${$ra}[$i][2];
            $oy  = ${$ra}[$i][3];
            $oz  = ${$ra}[$i][4];
            $head  = ${$ra}[$i][5];
            $pitch = ${$ra}[$i][6];
            $roll  = ${$ra}[$i][7];
            prt(" { $lat, $lon, $ox, $oy, $oz, $head, $pitch, $roll }, // $i2\n" );
        }
    }
    return $ret;
}

sub do_testing2
{
    my($ret) = "";

    my($default_lat) = 37.613545;
    my($default_lon) = -122.357237;

    my(@test_pilots) = (
        {   callsign => 'pilot1',
            model => 'model1',
            server_ip => '127.0.0.1',
            lat => $default_lat,
            lon => $default_lon,
            alt => 0,
            head => 0, pitch => 0, roll => 0,
        },
        {   callsign => 'pilot2',
            model => 'model2',
            server_ip => '127.0.0.1',
            lat => $default_lat + 0.01,
            lon => $default_lon + 0.01,
            alt => 0,
            head => 90, pitch => 0, roll => 0,
        },
        {   callsign => 'pilot3',
            model => 'model3',
            server_ip => '127.0.0.1',
            lat => $default_lat + 0.02,
            lon => $default_lon + 0.02,
            alt => 0,
            head => 45, pitch => 0, roll => 0,
        },
        {   callsign => 'pilot4',
            model => 'model4',
            server_ip => '127.0.0.1',
            lat => $default_lat + 0.03,
            lon => $default_lon + 0.03,
            alt => 0,
            head => 180, pitch => 0, roll => 0,
        },
        {   callsign => 'pilot5',
            model => 'model5',
            server_ip => '127.0.0.1',
            lat => $default_lat + 0.04,
            lon => $default_lon + 0.04,
            alt => 0,
            head => 270, pitch => 0, roll => 0,
        },
    );

    my($pilot_total) = $#test_pilots;

    $ret .= $ocs{'header'}->($pilot_total);

    foreach my $p (@test_pilots)
    {
        $ret .= $ocs{'single'}->($p->{'callsign'},
                $p->{'server_ip'},
                $p->{'model'},
                $p->{'lat'}, $p->{'lon'}, $p->{'alt'},
                $p->{'head'}, $p->{'pitch'}, $p->{'roll'});
    }

    $ret .= $ocs{'tail'}->();

    return $ret;
}

# test_conv();

sub do_all_servers() {
    my ($i,$i2,$serv,$res);
    $res = '';
    for ($i = 1; $i < 15; $i++) {
        if ($i < 10) {
            $i2 = "0".$i;
        } else {
            $i2 = $i;
        }
        $serv = 
        $serv = "mpserver${i2}.flightgear.org";
        $act_server = $serv;
        $res = "\nDoing server $act_server\n";
        $res .= do_socket();
        $res .= "\n";
        if ($write_log) {
            print $LF $res;
        }
    }
    return "\n";
}

if ($testing) {
    if ($test_socket) {
        if ($do_def_serv) {
            $act_server = $def_server;
            $port = 5001;
            prt("Testing fgms 14 $act_server $port...\n");
            $output = do_socket();
        } elsif ($do_win7) {
            $act_server = "192.168.1.21";
            $port = 5001;
            prt("Testing Win7-PC $act_server $port...\n");
            $output = do_socket();
        } elsif ($do_all) {
            prt("Testing all do_all_servers()...\n");
            $output = do_all_servers();
        } elsif ($do_fgx) {
            #$act_server = "fgx.ch";
            $act_server = "217.150.241.100";
            #$port = 5011;
            $port = 5001;
            prt("Testing fgx $act_server $port...\n");
            $output = do_socket();
        } elsif ($do_dell01) {
            $act_server = "192.168.1.174";
            $port = 5001;
            prt("Testing Dell01 $act_server $port...\n");
            $output = do_socket();
        } elsif ($do_dell02) {
            $act_server = "192.168.1.105";
            $port = 5001;
            prt("Testing Dell02 $act_server $port...\n");
            $output = do_socket();
        } else {
            prt("Testing: Doing do_socket()...\n");
            $output = &do_socket();
        }
    } else {
        prt("Testing: Doing do_testing()...\n");
        $output = &do_testing();
    }
} else {
    prt("Doing do_socket()...\n");
    $output = &do_socket();
}


binmode(STDOUT, ":utf8");

print($output);
if ($write_log) {
    print $LF $output;
    print "Written to $log_file...\n";
}
print "SGD_MIN = $SGD_MIN\n";

#if ($testing) {
#    my $file = "tempxml.xml";
#    if (open OUT, ">$file") {
#        printf OUT $output;
#        close OUT;
#    }
#}

if ($write_log) {
    close $LF;
}
exit(0);

sub test_conv() {
    my $lat = 53.348596;
    my $lon = -2.276554;
    my $alt = 241.742828;
    my $ox = -2.904634;
    my $oy = 1.457308;
    my $oz = 0.992861;
    my ($head, $roll, $pitch);
    euler_get($lat, $lon, $ox, $oy, $oz, \$head, \$pitch, \$roll);
    print "Head $head, pitch $pitch, roll $roll\n";
    exit 1;
}

sub some_results {
    my $msg = <<EOF;
Testing all do_all_servers()...
Opening socket to mpserver01.flightgear.org:5001...
Done pilot count 55...
Opening socket to mpserver02.flightgear.org:5001...
Socket to mpserver02.flightgear.org:5001 FAILED
Opening socket to mpserver03.flightgear.org:5001...
Socket to mpserver03.flightgear.org:5001 FAILED
Opening socket to mpserver04.flightgear.org:5001...
Done pilot count 34...
Opening socket to mpserver05.flightgear.org:5001...
Socket to mpserver05.flightgear.org:5001 FAILED
Opening socket to mpserver06.flightgear.org:5001...
Done pilot count 54...
Opening socket to mpserver07.flightgear.org:5001...
Done pilot count 54...
Opening socket to mpserver08.flightgear.org:5001...
Done pilot count 54...
Opening socket to mpserver09.flightgear.org:5001...
Socket to mpserver09.flightgear.org:5001 FAILED
Opening socket to mpserver10.flightgear.org:5001...
Done pilot count 57...
Opening socket to mpserver11.flightgear.org:5001...
Opening socket to mpserver12.flightgear.org:5001...
Done pilot count 57...
Opening socket to mpserver13.flightgear.org:5001...
Done pilot count 54...
Opening socket to mpserver14.flightgear.org:5001...
Socket to mpserver14.flightgear.org:5001 FAILED
EOF

    return $msg;
}

# vim: set sw=4 sts=4 expandtab: #