Generated: Sat Oct 12 17:22:57 2013 from fg_server_xml2.pl 2012/05/24 38.3 KB. text copy
#!/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}&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}&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/"/\"/g; $str =~ s/'/\'/g; $str =~ s/\&/\&/g; $str =~ s/>/\>/g; $str =~ s/</\</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: #