#!/usr/bin/perl -w # NAME: fp-smooth.pl # AIM: Take an XML flight plan and try to smooth it out use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use XML::DOM; use XML::Simple; use Data::Dumper; use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.5 2015-06-20"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_file = ''; my $CDATROOT="C:/FG/fgdata"; my $XDROOT="X:\\fgdata"; if (-d $XDROOT) { $CDATROOT=$XDROOT; } # ============================================================================= # This NEEDS to be adjusted to YOUR particular default location of these files. my $FGROOT = (exists $ENV{'FG_ROOT'})? $ENV{'FG_ROOT'} : $CDATROOT; #my $FGROOT = (exists $ENV{'FG_ROOT'})? $ENV{'FG_ROOT'} : "C:/FG/27/data"; # file spec : http://data.x-plane.com/file_specs/Apt810.htm my $APTFILE = "$FGROOT/Airports/apt.dat.gz"; # the airports data file my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # the NAV, NDB, etc. data file # add these files my $FIXFILE = "$FGROOT/Navaids/fix.dat.gz"; # the FIX data file my $AWYFILE = "$FGROOT/Navaids/awy.dat.gz"; # Airways data # ============================================================================= my $g_aptdat = $APTFILE; my $g_navdat = $NAVFILE; my $g_fixfile = $FIXFILE; my $g_awyfile = $AWYFILE; # ### DEBUG ### my $debug_on = 1; my $def_file = 'X:\fgdata\Routes\EDDM-YSSY-beech99-1-EDDM-LGAL.xml'; ### program variables my @warnings = (); my $cwd = cwd(); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } my $MY_F2M = 0.3048; my $MY_M2F = 3.28083989501312335958; my $MY_M2NM = 0.0005399568034557235; # apt.dat.gz CODES - see http://x-plane.org/home/robinp/Apt810.htm for DETAILS my $aln = '1'; # airport line my $rln = '10'; # runways/taxiways line my $sealn = '16'; # Seaplane base header data. my $heliln = '17'; # Heliport header data. my $twrln = '14'; # Tower view location. my $rampln = '15'; # Ramp startup position(s) my $bcnln = '18'; # Airport light beacons my $wsln = '19'; # windsock # Radio Frequencies # AWOS (Automatic Weather Observation System), ASOS (Automatic Surface Observation System) my $minatc = '50'; # ATIS (Automated Terminal Information System). AWIS (Automatic Weather Information Service) my $unicom = '51'; # Unicom or CTAF (USA), radio (UK) - open channel for pilot position reporting at uncontrolled airports. my $cleara = '52'; # Clearance delivery. my $goundf = '53'; # ground my $twrfrq = '54'; # like 12210 TWR my $appfrq = '55'; # like 11970 ROTTERDAM APP my $maxatc = '56'; # Departure. my %off2name = ( 0 => 'ATIS', 1 => 'Unicom', 2 => 'Clearance', 3 => 'Ground', 4 => 'Tower', 5 => 'Approach', 6 => 'Departure' ); # offset 10 in runway array my %runway_surface = ( 1 => 'Asphalt', 2 => 'Concrete', 3 => 'Turf/grass', 4 => 'Dirt', 5 => 'Gravel', 6 => 'H-Asphalt', # helepad (big 'H' in the middle). 7 => 'H-Concrete', # helepad (big 'H' in the middle). 8 => 'H-Turf', # helepad (big 'H' in the middle). 9 => 'H-Dirt', # helepad (big 'H' in the middle). 10 => 'T-Asphalt', # taxiway - with yellow hold line across long axis (not available from WorldMaker). 11 => 'T-Concrete', # taxiway - with yellow hold line across long axis (not available from WorldMaker). 12 => 'Dry Lakebed', # (eg. at KEDW Edwards AFB). 13 => 'Water' # runways (marked with bobbing buoys) for seaplane/floatplane bases (available in X-Plane 7.0 and later). ); # ===================================================================================================== my $lastln = '99'; # end of file my @g_aptlist = (); my $totaptcnt = 0; my $totrwycnt = 0; # LOAD apt.dat.gz # details see : http://data.x-plane.com/file_specs/Apt810.htm # Line codes used in apt.dat (810 version and 1000 version) # Airport Line - eg # 0 1 2 3 4 5++ # 1 1050 0 0 YGIL Gilgandra # ID AMSL Twr Bld ICAO Name # Code (apt.dat) Used for # 1 Airport header data. # 16 Seaplane base header data. No airport buildings or boundary fences will be rendered in X-Plane. # 17 Heliport header data. No airport buildings or boundary fences will be rendered in X-Plane. # 10 Runway or taxiway at an airport. # 14 Tower view location. # 15 Ramp startup position(s) # 18 Airport light beacons (usually "rotating beacons" in the USA). Different colours may be defined. # 19 Airport windsocks. # 50 to 56 Airport ATC (Air Traffic Control) frequencies. # runway # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 # 10 -31.696928 148.636404 15x 162.00 4204 0000.0000 0000.0000 98 121121 5 0 2 0.25 0 0000.0000 # rwy lat lon num true feet displament/extension wid lights surf shld mark smooth signs VASI sub load_apt_data() { my ($i,$max,$msg); my $aptdat = $g_aptdat; prt("Loading $aptdat file ...\n"); # if (VERB1()); pgm_exit(1, "ERROR: Can NOT locate $aptdat ...$!...\n") if ( !( -f $aptdat) ); ###open IF, "<$aptdat" or mydie("OOPS, failed to open [$aptdat] ... check name and location ...\n"); open IF, "gzip -d -c $aptdat|" or mydie( "ERROR: CAN NOT OPEN $aptdat...$!...\n" ); my @lines = ; close IF; $max = scalar @lines; prt("[v9] Got $max lines to scan...\n") if (VERB9()); my ($add,$alat,$alon); $add = 0; my ($off,$atyp,$az,@arr,@arr2,$rwyt,$glat,$glon,$rlat,$rlon); my ($line,$apt,$diff,$rwycnt,$icao,$name,@runways,$version); my ($aalt,$actl,$abld,$ftyp,$cfrq,$frqn,@freqs); my ($len,$type); my ($rwid,$surf,$rwy1,$rwy2,$elat1,$elon1,$elat2,$elon2,$az1,$az2,$s,$res); $off = 0; $az = 0; $glat = 0; $glon = 0; $apt = ''; $rwycnt = 0; @runways = (); @freqs = (); $msg = ''; #'[v1] '; #$msg .= "Search ICAO [$apticao]..."; $msg .= "Got $max lines, for airports,rwys,txwys... "; for ($i = 0; $i < $max; $i++) { $line = $lines[$i]; $line = trim_all($line); if ($line =~ /\s+Version\s+/i) { @arr2 = split(/\s+/,$line); $version = $arr2[0]; $msg .= "Version $version"; $i++; last; } } prt("$msg\n"); # if (VERB1()); for ( ; $i < $max; $i++) { $line = $lines[$i]; $line = trim_all($line); $len = length($line); next if ($len == 0); ###prt("$line\n"); my @arr = split(/\s+/,$line); $type = $arr[0]; if (($line =~ /^$aln\s+/)|| # start with '1' ($line =~ /^$sealn\s+/)|| # = '16'; # Seaplane base header data. ($line =~ /^$heliln\s+/)) { # = '17'; # Heliport header data. # 0 1 2 3 4 # 17 126 0 0 EH0001 [H] VU medisch centrum # ID ALT C B NAME++ if (length($apt)) { if ($rwycnt > 0) { $totrwycnt += $rwycnt; # average position $alat = $glat / $rwycnt; $alon = $glon / $rwycnt; $off = -1; $az = 400; @arr2 = split(/ /,$apt); $atyp = $arr2[0]; # airport, heleiport, or seaport $aalt = $arr2[1]; # Airport (general) ALTITUDE AMSL $actl = $arr2[2]; # control tower $abld = $arr2[3]; # buildings $icao = $arr2[4]; # ICAO $name = join(' ', splice(@arr2,5)); # Name ##prt("$diff [$apt] (with $rwycnt runways at [$alat, $alon]) ...\n"); ##prt("$diff [$icao] [$name] ...\n"); #push(@g_aptlist, [$diff, $icao, $name, $alat, $alon, -1, 0, 0, 0, $icao, $name, $off, $dist, $az]); my @f = @freqs; my @r = @runways; # 0 1 2 3 4 5 6 7 push(@g_aptlist, [$atyp, $icao, $name, $alat, $alon, $aalt, \@f, \@r]); ### prt("[v9] $icao, $name, $alat, $alon, $aalt, $rwycnt runways\n") if (VERB9()); } else { prtw("WARNING: Airport with NO runways! $icao, $name, $alat, $alon, $aalt\n"); } } $apt = $line; $rwycnt = 0; # reset runway count @runways = (); # clear RUNWAY list @freqs = (); # clear frequencies $glat = 0; $glon = 0; $totaptcnt++; # count another AIRPORT } elsif ($line =~ /^$rln\s+/) { # 10 36.962213 127.031071 14x 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 # 10 36.969145 127.020106 xxx 221.51 329 0.0 0.0 75 161161 1 0 0 0.25 0 $rlat = $arr[1]; $rlon = $arr[2]; $rwyt = $arr[3]; # text 'xxx'=taxiway, 'H1x'=heleport, else a runway ###prt( "$line [$rlat, $rlon]\n" ); if ( $rwyt ne "xxx" ) { $glat += $rlat; $glon += $rlon; $rwycnt++; my @ar = @arr; push(@runways, \@ar); $totrwycnt++; } } elsif ($line =~ /^5(\d+)\s+/) { # frequencies $ftyp = $1; $cfrq = $arr[1]; $frqn = $arr[2]; $add = 0; if ($ftyp == 0) { $add = 1; # ATIS } elsif ($ftyp == 1) { $add = 1; # Unicom } elsif ($ftyp == 2) { $add = 1; # clearance } elsif ($ftyp == 3) { $add = 1; # ground } elsif ($ftyp == 4) { $add = 1; # tower } elsif ($ftyp == 5) { $add = 1; # approach } elsif ($ftyp == 6) { $add = 1; # departure } if ($add) { my @af = @arr; push(@freqs, \@af); # save the freq array } else { pgm_exit(1, "WHAT IS THIS [5$ftyp $cfrq $frqn] [$line]\n FIX ME!!!"); } } elsif ($line =~ /^$lastln\s?/) { # 99, followed by space, count 0 or more ... prt( "Reached END OF FILE ... \n" ) if (VERB9()); last; } elsif ($type == 14) { # Tower view location(s). } elsif ($type == 15) { # parking Ramp startup position(s) } elsif ($type == 18) { # 18 Airport light beacons (usually "rotating beacons" in the USA). Different colours may be defined. } elsif ($type == 19) { # 19 Airport windsocks. # =============================================================================== } elsif ($type == 20) { # 20 22.32152700 114.19750500 224.10 0 3 {@Y,^l}31-13{^r} } elsif ($type == 21) { # 21 22.31928000 114.19800800 3 134.09 3.10 13 PAPI-4R } elsif ($type == 100) { # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 # typ lat lon mrk bearing alt-ft # 10 36.962213 127.031071 14x 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 # version 1000 runway # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 # 100 29.87 3 0 0.00 1 2 1 16 43.91080605 004.90321905 0.00 0.00 2 0 0 0 34 43.90662331 004.90428974 0.00 0.00 2 0 0 0 $rwid = $arr[1]; # WIDTH in meters? NOT SHOWN $surf = $arr[2]; # add surface type $rwy1 = $arr[8]; $elat1 = $arr[9]; $elon1 = $arr[10]; $rwy2 = $arr[17]; $elat2 = $arr[18]; $elon2 = $arr[19]; $res = fg_geo_inverse_wgs_84 ($elat1,$elon1,$elat2,$elon2,\$az1,\$az2,\$s); $s = int($s * $MY_M2F); $rlat = ($elat1 + $elat2) / 2; $rlon = ($elon1 + $elon2) / 2; $glat += $rlat; $glon += $rlon; $rwycnt++; # 0 1=lat 2=lon 3=s 4=hdg 5=len 6=offsets 7=stopway 8=wid 9=lights 10=surf 11 12 13 14 15 # 10 36.962213 127.031071 14x 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 # 11=shoulder 12=marks 13=smooth 14=signs 15=GS angles # 0 3 0.25 0 0300.0300 # 0 1 2 3 4 5 $rwy2 = [100,$rlat,$rlon,$rwy1,$az1,$s,6,7,8,9,$surf,11,12,13,14,15]; # push(@runways, \@arr); push(@runways,$rwy2); } elsif ($type == 101) { # Water runways # Water runways # 0 1 2 3 4 5 6 7 8 # 101 243.84 0 16 29.27763293 -089.35826258 34 29.26458929 -089.35340410 # 101 22.86 0 07 29.12988952 -089.39561501 25 29.13389936 -089.38060001 $elat1 = $arr[4]; $elon1 = $arr[5]; $elat2 = $arr[7]; $elon2 = $arr[8]; $surf = 13; $res = fg_geo_inverse_wgs_84 ($elat1,$elon1,$elat2,$elon2,\$az1,\$az2,\$s); $s = int($s * $MY_M2F); $rwy1 = int(($az1 / 10) + 0.5); $rlat = sprintf("%.8f",(($elat1 + $elat2) / 2)); $rlon = sprintf("%.8f",(($elon1 + $elon2) / 2)); $glat += $rlat; $glon += $rlon; $rwycnt++; $rwy2 = [101,$rlat,$rlon,$rwy1,$az1,$s,6,7,8,9,$surf,11,12,13,14,15]; # push(@waterways, \@a2); push(@runways,$rwy2); } elsif ($type == 102) { # Heliport # 0 1 2 3 4 5 6 7 8 9 10 11 # 102 H2 52.48160046 013.39580674 355.00 18.90 18.90 2 0 0 0.00 0 # 102 H3 52.48071507 013.39937648 2.64 13.11 13.11 1 0 0 0.00 0 $rwy1 = $arr[1]; $elat1 = $arr[2]; $elon1 = $arr[3]; $az1 = $arr[4]; $s = int($arr[5] * $MY_M2F); $surf = 6; $rlat = sprintf("%.8f",$elat1); $rlon = sprintf("%.8f",$elon1); $glat += $rlat; $glon += $rlon; $rwycnt++; $rwy2 = [102,$rlat,$rlon,$rwy1,$az1,$s,6,7,8,9,$surf,11,12,13,14,15]; push(@runways,$rwy2); } elsif ($type == 110) { # 110 2 0.00 134.10 runway sholder } elsif ($type == 111) { # 111 22.30419700 114.21613100 } elsif ($type == 112) { # 112 22.30449500 114.21644400 22.30480900 114.21677000 51 102 } elsif ($type == 113) { # 113 22.30370300 114.21561700 } elsif ($type == 114) { # 114 43.29914799 -008.38013558 43.29965322 -008.37970933 } elsif ($type == 115) { # 115 22.31009400 114.21038500 } elsif ($type == 116) { # 116 43.30240028 -008.37799316 43.30271076 -008.37878407 } elsif ($type == 120) { # 120 hold lines W A13 } elsif ($type == 130) { # 130 Airport Boundary } elsif ($type == 1000) { # 1000 Northerly flow } elsif ($type == 1001) { # 1001 KGRB 270 020 999 } elsif ($type == 1002) { # 1002 KGRB 0 } elsif ($type == 1003) { # 1003 KGRB 0 } elsif ($type == 1004) { # 1004 0000 2400 } elsif ($type == 1100) { # 1100 36 12654 all heavy|jets|turboprops|props 000360 000360 Northerly } elsif ($type == 1101) { # 1101 36 left } elsif ($type == 1200) { # ???? } elsif ($type == 1201) { # 1201 42.75457409 -073.80880021 both 2110 _start } elsif ($type == 1202) { # 1202 2110 2112 twoway taxiway } elsif ($type == 1204) { # 1204 arrival 01,19 } elsif ($type == 1300) { # 1300 30.32875704 -009.41140596 323.85 misc jets|props Ramp # =============================================================================== } else { pgm_exit(1,"Line type $type NOT USED [$line]\n*** FIX ME ***"); } } # do any LAST entry $add = 0; $off = -1; $az = 0; if (length($apt) && ($rwycnt > 0)) { $alat = $glat / $rwycnt; $alon = $glon / $rwycnt; $off = -1; $az = 400; #$off = near_given_point( $alat, $alon, \$dist, \$az ); #$dlat = abs( $c_lat - $alat ); #$dlon = abs( $c_lon - $alon ); #$diff = int( ($dlat * 10) + ($dlon * 10) ); @arr2 = split(/ /,$apt); $atyp = $arr2[0]; $aalt = $arr2[1]; $actl = $arr2[2]; # control tower $abld = $arr2[3]; # buildings $icao = $arr2[4]; $name = join(' ', splice(@arr2,5)); ###prt("$diff [$apt] (with $rwycnt runways at [$alat, $alon]) ...\n"); ###prt("$diff [$icao] [$name] ...\n"); ###push(@g_aptlist, [$diff, $icao, $name, $alat, $alon]); ##push(@g_aptlist, [$diff, $icao, $name, $alat, $alon, -1, 0, 0, 0, $icao, $name, $off, $dist, $az]); my @f = @freqs; my @r = @runways; # 0 1 2 3 4 5 6 7 push(@g_aptlist, [$atyp, $icao, $name, $alat, $alon, $aalt, \@f, \@r]); $totaptcnt++; # count another AIRPORT } my $cnt = scalar @g_aptlist; prt("Done scan of $max lines for $cnt airports, $totrwycnt runways...\n"); } sub find_ap_icao($) { my ($find_icao) = @_; # user ICAO my $rapts = \@g_aptlist; # find AIRPORT my $cnt = scalar @{$rapts}; ## 0 1 2 3 4 5 6 7 #push(@g_aptlist, [$diff, $icao, $name, $alat, $alon, $aalt, \@f, \@r]); my ($i,$atyp,$icao,$name,$alat,$alon,$aalt,$rfreq,$rrwys,$rwycnt,$len); prt("[v1] Searching $cnt airports for ICAO [$find_icao]...\n") if (VERB1()); my $minn = 0; my $fndcnt = 0; for ($i = 0; $i < $cnt; $i++) { $icao = ${$rapts}[$i][1]; $name = ${$rapts}[$i][2]; if ($icao eq $find_icao) { $atyp = ${$rapts}[$i][0]; $alat = ${$rapts}[$i][3]; $alon = ${$rapts}[$i][4]; $aalt = ${$rapts}[$i][5]; $rfreq = ${$rapts}[$i][6]; $rrwys = ${$rapts}[$i][7]; $rwycnt = scalar @{$rrwys}; ###$name = cased_name($name) if (!$name_as_is); prt("Found $icao, $name, $alat, $alon, $aalt ft, $rwycnt runways\n"); # if (VERB1()); return $i; } } prt("No airport found with ICAO of $find_icao!\n"); return -1; } sub show_airport($) { my ($ind) = shift; my $rapts = \@g_aptlist; # find AIRPORT my $cnt = scalar @{$rapts}; my ($i,$atyp,$icao,$name,$alat,$alon,$aalt,$rfreq,$rrwys,$rwycnt,$len,$ra); my ($lat1,$lon1,$hdg1,$surf,$rwy1,$typ); if (($ind >= 0)&&($ind < $cnt)) { $i = $ind; $icao = ${$rapts}[$i][1]; $name = ${$rapts}[$i][2]; $atyp = ${$rapts}[$i][0]; $alat = ${$rapts}[$i][3]; $alon = ${$rapts}[$i][4]; $aalt = ${$rapts}[$i][5]; $rfreq = ${$rapts}[$i][6]; $rrwys = ${$rapts}[$i][7]; $rwycnt = scalar @{$rrwys}; foreach $ra (@{$rrwys}) { # 0, 1 2 3 4 5 10 #$rwy2 = [10,$rlat,$rlon,$rwy1,$az1,$s,6,7,8,9,$surf,11,12,13,14,15]; # 07 : 40.85249200,25.94171100 25 : 40.85924700,25.97081700 b=73/253 l=8419 ft (Asphalt) # typ = 10 old style 810, 100 1000 vers, 101 water, 102 hele $typ = ${$ra}[0]; $lat1 = ${$ra}[1]; $lon1 = ${$ra}[2]; $rwy1 = ${$ra}[3]; $hdg1 = ${$ra}[4]; $len = ${$ra}[5]; $surf = ${$ra}[10]; if (defined $runway_surface{$surf}) { $surf = $runway_surface{$surf}; } $hdg1 = int($hdg1 + 0.5); if ($typ == 102) { # helipad prt("$rwy1 : $lat1,$lon1 $surf\n"); } else { prt("$rwy1 : $lat1,$lon1 $len $hdg1 $surf\n"); } } } } sub add_if_not_in_list($$) { # \@icaos,$icao my ($ra,$icao); my ($tmp); foreach $tmp (@{$ra}) { return if ($tmp eq $icao); } push(@{$ra},$icao); } #$VAR1 = { # 'destination' => { # 'airport' => { 'content' => 'LGAL', 'type' => 'string' } # }, # 'version' => { 'content' => '2', 'type' => 'int' }, # 'route' => { 'wp' => [ # { # 'icao' => { 'content' => 'EDDM', 'type' => 'string' }, # 'lat' => { 'content' => '48.364822', 'type' => 'double' }, # 'lon' => { 'content' => '11.794361', 'type' => 'double' }, # 'departure' => { 'content' => 'true', 'type' => 'bool' }, # 'type' => { 'content' => 'basic', 'type' => 'string' } # }, # { # 'alt-restrict' => { 'content' => 'at', 'type' => 'string' }, # 'n' => '1', # 'lat' => { 'content' => '47.818611', 'type' => 'double' }, # 'altitude-ft' => { 'content' => '5000', 'type' => 'double' }, # 'lon' => { 'content' => '12.987689', 'type' => 'double' }, # 'type' => { 'content' => 'navaid', 'type' => 'string' }, # 'ident' => { 'content' => 'SI', 'type' => 'string' } # }, # ....................... # { # 'alt-restrict' => { 'content' => 'at', 'type' => 'string' }, # 'n' => '14', # 'lat' => { 'ontent' => '40.857500', 'type' => 'double' }, # 'altitude-ft' => { 'content' => '5000', 'type' => 'double' }, # 'lon' => { 'content' => '25.944167', 'type' => 'double' }, # 'type' => { 'content' => 'navaid', 'type' => 'string' }, # 'ident' => { 'content' => 'ALP', 'type' => 'string' } # }, # { # 'n' => '15', # 'lat' => { 'content' => '40.855869', 'type' => 'double' }, # 'lon' => { 'content' => '25.956264', 'type' => 'double' }, # 'approach' => { 'content' => 'true', 'type' => 'bool' }, # 'type' => { 'content' => 'basic', 'type' => 'string' }, # 'ident' => { 'content' => 'LGAL', 'type' => 'string' } # } # ] # }, # 'departure' => { # 'airport' => { 'content' => 'EDDM', 'type' => 'string' } # } # }; sub process_in_file($) { my ($inf) = @_; if (! -f $inf) { pgm_exit(1,"ERROR: Unable to stat '$inf'!\n"); } my $xml = new XML::Simple; # (ForceArray => 0); my $data = $xml->XMLin($inf); my ($rh,$rh2,$dep,$arr,$ra,$cnt,$lnn,$icao,$lat,$lon,$rh3,$type,$num,$alt,$id); my ($deplat,$deplon,$arrlat,$arrlon,$msg); #prt(Dumper($data)); #$load_log = 1; $dep = ''; $arr = ''; my @icaos = (); if (defined ${$data}{departure}) { $rh = ${$data}{departure}; #prt(Dumper($rh)); if (defined ${$rh}{airport}) { $rh2 = ${$rh}{airport}; #prt(Dumper($rh2)); if (defined ${$rh2}{content}) { $dep = ${$rh2}{content}; } } } if (defined ${$data}{destination}) { $rh = ${$data}{destination}; #prt(Dumper($rh)); if (defined ${$rh}{airport}) { $rh2 = ${$rh}{airport}; #prt(Dumper($rh2)); if (defined ${$rh2}{content}) { $arr = ${$rh2}{content}; } } } if (length($dep)) { prt("deparure airport $dep\n"); push(@icaos,$dep); } if (length($arr)) { prt("arrival airport $arr\n"); push(@icaos,$arr); } $cnt = 0; my ($res,$az1,$az2,$s,$dir); my ($key,$val,$itm,$tmp); my ($lastlat,$lastlon); if (defined ${$data}{route}) { $rh = ${$data}{route}; if (defined ${$rh}{wp}) { $ra = ${$rh}{wp}; $cnt = scalar @{$ra}; } } my @arrofhash = (); my $totdist = 0; if ($cnt) { $lnn = 0; prt("route wp $cnt\n"); foreach $rh2 (@{$ra}) { $lnn++; my %h = (); $type = ' '; if (defined ${$rh2}{type}{content}) { $type = ${$rh2}{type}{content}; $h{'type'} = $type; } $num = ' '; if (defined ${$rh2}{n}) { $num = ${$rh2}{n}.' '; $h{'n'} = ${$rh2}{n}; } $lat = 400; if (defined ${$rh2}{lat}{content}) { $lat = ${$rh2}{lat}{content}; $h{'lat'} = $lat; } $lon = 400; if (defined ${$rh2}{lon}{content}) { $lon = ${$rh2}{lon}{content}; $h{'lon'} = $lon; } $alt = -9999; if (defined ${$rh2}{'altitude-ft'}{content}) { $alt = ${$rh2}{'altitude-ft'}{content}; $h{'alt'} = $alt; } $msg ="$lnn: $num $type $lat $lon $alt "; if (defined ${$rh2}{icao}) { $rh3 = ${$rh2}{icao}; if (defined ${$rh3}{content}) { $icao = ${$rh3}{content}; $msg .= "$icao "; $h{icao} = $icao; add_if_not_in_list(\@icaos,$icao); } } elsif (defined ${$rh2}{ident}) { $rh3 = ${$rh2}{ident}; if (defined ${$rh3}{content}) { $id = ${$rh3}{content}; $msg .= "$id "; $h{id} = $id; if ($type eq 'basic') { add_if_not_in_list(\@icaos,$id); } } } if ((defined ${$rh2}{departure}{content})&& (${$rh2}{departure}{content} eq 'true')) { $msg .= "departure"; $h{dep} = 'true'; $deplat = $lat; $deplon = $lon; } if ((defined ${$rh2}{approach}{content})&& (${$rh2}{approach}{content} eq 'true')) { $msg .= "approach"; $h{app} = 'true'; $arrlat = $lat; $arrlon = $lon; } if ($lnn > 1) { $res = fg_geo_inverse_wgs_84 ($lastlat,$lastlon,$lat,$lon,\$az1,\$az2,\$s); $totdist += $s; $itm = int((($s * $MY_M2NM) + 0.05) * 10) / 10; $dir = int($az1 + 0.5); $msg .= " dist $itm nm, on $dir degs"; $val = @arrofhash[-1]; ${$val}{x_dist} = $itm; ${$val}{x_hdg} = $dir; } prt("$msg\n"); push(@arrofhash,\%h); $lastlat = $lat; $lastlon = $lon; } } if ($deplat && $deplon && $arrlat && $arrlon) { $res = fg_geo_inverse_wgs_84 ($deplat,$deplon,$arrlat,$arrlon,\$az1,\$az2,\$s); $itm = int((($s * $MY_M2NM) + 0.05) * 10) / 10; $dir = int($az1 + 0.5); prt("from $deplat,$deplon to $arrlat,$arrlon $itm nm, on $dir degs.\n"); } $cnt = scalar @arrofhash; $lnn = 0; prt("\nCollected $cnt wps, as follows...\n"); foreach $val (@arrofhash) { $lnn++; my @arr2 = sort keys %{$val}; prt("$lnn: "); foreach $itm (@arr2) { $tmp = ${$val}{$itm}; prt("$itm=$tmp "); } prt("\n"); } my $show_aps = 0; if ($show_aps && @icaos) { my %found = (); $cnt = scalar @icaos; prt("Got $cnt a/p ICAO, ".join(" ",@icaos).", loading apt.dat...\n"); load_apt_data(); foreach $icao (@icaos) { $itm = find_ap_icao($icao); if ($itm ne -1) { show_airport($itm); } $found{$icao} = $itm; } } } sub process_in_file2($) { my ($inf) = @_; if (! -f $inf) { pgm_exit(1,"ERROR: Unable to stat '$inf'!\n"); } my $parser = XML::DOM::Parser->new(); my $doc = $parser->parsefile($inf); prt(Dumper($doc)); # looks too difficult $load_log = 1; } sub process_in_file1($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = $1; prt("$lnn: $inc\n"); } } } ######################################### ### MAIN ### parse_args(@ARGV); #load_apt_data(); process_in_file($in_file); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); my $verb = VERB2(); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } $verb = VERB2(); prt("Verbosity = $verbosity\n") if ($verb); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if ($verb); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if ($verb); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n") if ($verb); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_file) == 0) { $in_file = $def_file; prt("Set DEFAULT input to [$in_file]\n"); } } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write output to this file.\n"); } # eof - template.pl