Generated: Sun Mar 2 17:20:32 2014 from xpnav.pl 2013/11/23 20 KB. text copy
#!/usr/bin/perl -w # NAME: xpnav.pl # AIM: SPECIALISED: Just reading x-plane earth_nav.dat, and check every entry # 23/11/2013 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) 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"; # 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.1 2013-03-17"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_file = ''; # ### DEBUG ### my $debug_on = 0; my $def_file = 'def_file'; ### 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); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; 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"); } } } my $out_base = 'apt1000'; my @files_written = (); my $do_nav_filter = 0; my @navlist = (); my $out_path = $temp_dir.$PATH_SEP."temp-apts"; my $FGROOT = "D:/FG/xplane/1000"; my $NAV_FILE = "$FGROOT/earth_nav.dat"; # the NAV, NDB, etc. data file my $navdat = $NAV_FILE; sub trimall($) { # version 20061127 my ($ln) = shift; chomp $ln; # remove CR (\n) $ln =~ s/\r$//; # remove LF (\r) $ln =~ s/\t/ /g; # TAB(s) to a SPACE $ln =~ s/\s\s/ /g while ($ln =~ /\s\s/); # all double space to SINGLE $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space return $ln; } sub look_like_icao($) { my $icao = shift; my $up = uc($icao); my $len = length($icao); if (($len == 4) && ($up eq $icao)) { return 1; } return 0; } # How can I tell if a string is a number? # The simplest method is: # if ($string == "$string") { # # It is a number # } # Note the use of the == operator to compare the string to its numeric value. # However, this approach is dangerous because the $string might contain arbitrary # code such as @{[system "rm -rf /"]} which would be executed as a result of the # interpolation process. For safety, use this regular expression: # if ($var =~ /(?=.)M{0,3}(C[MD]|D?C{0,3})(X[CL]|L?X{0,3})(I[XV]|V?I{0,3})/) { # print "$var contains a number.\b"; # } # contains digits,commas and 1 period AND # does not contain alpha's, more than 1 period # commas or periods at the beggining and ends of # each line AND # is not null sub IsANumber($) { my $var = shift; if ( ( $var =~ /(^[0-9]{1,}?$)|(\,*?)|(\.{1})/ ) && !( $var =~ /([a-zA-Z])|(^[\.\,]|[\.\,]$)/ ) && ($var ne '') ) { return 1; } return 0; } sub looks_like_rwy($) { my $rwy = shift; if (length($rwy) > 0) { my $ch = substr($rwy,0,1); if (IsANumber($ch)) { # or perhaps if ($ch == "$ch") return 1; } } return 0; } # sort by type sub mycmp_ascend_n0 { return -1 if (${$a}[0] < ${$b}[0]); return 1 if (${$a}[0] > ${$b}[0]); return 0; } sub load_nav_file { prt("\nLoading $navdat file ...\n"); mydie("ERROR: Can NOT locate [$navdat]!\n") if ( !( -f $navdat) ); open NIF, "<$navdat" or mydie( "ERROR: CAN NOT OPEN $navdat...$!...\n" ); my @nav_lines = <NIF>; close NIF; my $cnt = scalar @nav_lines; prt("Loaded $cnt line...\n"); return \@nav_lines; } # ============================================================ # 20131123 - new tests added mainly for 6 GS and 12 VOR-DME sub looks_like_number($) { my $txt = shift; $txt = substr($txt,1) if ($txt =~ /^-/); # remove any beginning minus sign return 1 if ($txt =~ /^\d+$/); return 0; } sub looks_like_freq($) { my $txt = shift; my $len = length($txt); return 0 if ($len < 5); # expect at least 5 digits return looks_like_number($txt); } sub looks_like_id($) { my $txt = shift; my $len = length($txt); return 0 if ($len < 2); # expect at least 2 chars my $utx = uc($txt); return 0 if ($utx ne $txt); return 1; } sub looks_like_bearing($) { my $txt = shift; return 1 if (IsANumber($txt)); return 0; } # 300327.389 sub looks_like_gs($) { my $txt = shift; my $len = length($txt); return 0 if ($len != 10); return IsANumber($txt); } # ============================================================ ################################################################################## ### Load x-plane earth_nav.dat - all added to @navlist ############################## sub parse_nav_lines($) { my $rnava = shift; my $max = scalar @{$rnava}; # add to my @navlist = (); my ($i,$line,$lnn,@arr,$acnt,$type,$len,$vnav); my ($nlat,$nlon,$feet,$freq,$rng,$bear,$id,$icao,$name,$rwy); my (@sorted,$ra,$diff,$o_file,$tmp,$tmp2); $lnn = 0; prt("Processing $max line of NAV data...\n"); for ($i = 0; $i < $max; $i++) { $line = ${$rnava}[$i]; chomp $line; $line = trimall($line); $len = length($line); $lnn++; next if ($len == 0); if ($lnn < 3) { if ($lnn == 2) { $o_file = $out_path.$PATH_SEP.'VERSION.nav.txt'; write2file("$line\n",$o_file); push(@files_written,['VERSION.nav.txt',1,51]); prt(substr($line,0,50)."..., written to [$o_file]\n"); } next; } @arr = split(/\s+/,$line); $acnt = scalar @arr; $type = $arr[0]; if ($type == 99) { prt("$lnn: Reached EOF (99)\n"); last; } #0 1 2 3 4 5 6 7 8 9 10 #CD LAT LON ELEV FREQ RNG BEARING ID NAME RWY NAME # FT NM. GS Ang ICAO #2 47.63252778 -122.38952778 0 362 50 0.0 BF NOLLA NDB #3 47.43538889 -122.30961111 354 11680 130 19.0 SEA SEATTLE VORTAC #4 47.42939200 -122.30805600 338 11030 18 180.343 ISNQ KSEA 16L ILS-cat-I #6 47.46081700 -122.30939400 425 11030 10 300180.343 ISNQ KSEA 16L GS if ($acnt < 9) { prt("Split only yielded $acnt!\n"); prt("$lnn: [$line]\n"); pgm_exit(1,""); } $nlat = $arr[1]; $nlon = $arr[2]; $feet = $arr[3]; $freq = $arr[4]; $rng = $arr[5]; $bear = $arr[6]; $id = $arr[7]; $icao = $arr[8]; $name = $icao; $rwy = ''; if ($type == 2) { # 2 NDB - (Non-Directional Beacon) Includes NDB component of Locator Outer Markers (LOM) # 2 47.63252778 -122.38952778 0 362 50 0.0 BF NOLLA NDB $icao = ''; $name = join(' ', splice(@arr,8)); } elsif ($type == 3) { # 3 VOR - (including VOR-DME and VORTACs) Includes VORs, VOR-DMEs and VORTACs # 3 47.43538889 -122.30961111 354 11680 130 19.0 SEA SEATTLE VORTAC $icao = ''; $name = join(' ', splice(@arr,8)); } elsif ($type == 4) { # 4 ILS - LOC Localiser component of an ILS (Instrument Landing System) # 0 1 2 3 4 5 6 7 8 9 10 # 4 47.42939200 -122.30805600 338 11030 18 180.343 ISNQ KSEA 16L ILS-cat-I if ($acnt < 11) { prt("Split only yielded $acnt!\n"); prt("$lnn: [$line] SKIPPING\n"); next; } $rwy = $arr[9]; $name = $arr[10]; } elsif ($type == 5) { # 5 LOC - Localiser component of a localiser-only approach Includes for LDAs and SDFs # 0 1 2 3 4 5 6 7 8 9 10 # 5 40.03460600 -079.02328100 2272 10870 18 236.086 ISOZ 2G9 25 LOC # 5 67.01850600 -050.68207200 165 10955 18 61.600 ISF BGSF 10 LOC if ($acnt < 11) { prt("Split only yielded $acnt!\n"); prt("$lnn: [$line] SKIPPING\n"); next; } $rwy = $arr[9]; $name = $arr[10]; } elsif ($type == 6) { # 6 GS - Glideslope component of an ILS Frequency shown is paired frequency, not the DME channel # 0 1 2 3 4 5 6 7 8 9 10 # 6 47.46081700 -122.30939400 425 11030 10 300180.343 ISNQ KSEA 16L GS # 0 1 2 3 4 5 6 7 8 # 6 40.75644400 016.94085000 1184 *NF* 10 300321.163 LIBV 32L GS # Got 4 WARNINGS... # 0 1 2 3 4 5 6 7 8 # WARNING:16455: [6 40.75644400 016.94085000 1184 10 300321.163 LIBV 32L GS] SKIPPING split 9 # WARNING:16827: [6 24.01447200 121.61319400 52 10 320026.187 RCYU 03 GS] SKIPPING split 9 # 0 1 2 3 4 5 6 7 8 9 # WARNING:16758: [6 28.27461100 068.45741900 185 10 300327.389 MCCT OPJA 33 GS] SKIPPING split 10 # WARNING:16812: [6 22.74861100 121.09566700 143 10 300038.513 MFNN RCFN 04 GS] SKIPPING split 10 # $feet = $arr[3]; # $freq = $arr[4]; # $rng = $arr[5]; # $bear = $arr[6]; # $id = $arr[7]; # $icao = $arr[8]; if ($acnt < 11) { if (($acnt == 9) && looks_like_number($feet) && looks_like_number($freq) && looks_like_gs($rng) && look_like_icao($bear) && looks_like_rwy($id) && ($icao eq 'GS')) { $rwy = $id; # [7] is runway $tmp = $freq; $freq = '10099'; # set dummy freq $tmp2 = $bear; $bear = $rng; $rng = $tmp; # [4] is range $tmp = $icao; $icao = $tmp2; $id = $icao; $name = 'GS'; prt("CHECK: $type,$nlat,$nlon,a=$feet,f=$freq,r=$rng,b=$bear,id=$id,icao=$icao,rw=$rwy,nm=$name\n"); } elsif (($acnt == 10) && looks_like_number($feet) && looks_like_number($freq) && looks_like_gs($rng) && looks_like_id($bear) && look_like_icao($id) && looks_like_rwy($icao) && ($arr[9] eq 'GS')) { $tmp = $freq; $freq = '10099'; # dummy freq $tmp2 = $rng; $rng = $tmp; $tmp = $bear; $bear = $tmp2; $tmp2 = $id; $id = $tmp; $tmp = $icao; $icao = $tmp2; $rwy = $tmp; $name = 'GS'; prt("CHECK: $type,$nlat,$nlon,a=$feet,f=$freq,r=$rng,b=$bear,id=$id,icao=$icao,rw=$rwy,nm=$name\n"); } else { prtw("WARNING:$lnn: [$line] SKIPPING split $acnt\n"); next; } } else { $rwy = $arr[9]; $name = $arr[10]; } } elsif ($type == 7) { # 7 OM - Outer markers (OM) for an ILS Includes outer maker component of LOMs if ($acnt < 11) { prtw("WARNING:$lnn: [$line] SKIPPING split $acnt\n"); next; } $rwy = $arr[9]; $name = $arr[10]; } elsif ($type == 8) { # 8 MM - Middle markers (MM) for an ILS # 8 47.47223300 -122.31102500 433 0 0 180.343 ---- KSEA 16L MM if ($acnt < 11) { prtw("WARNING:$lnn: [$line] SKIPPING split $acnt\n"); next; } $rwy = $arr[9]; $name = $arr[10]; } elsif ($type == 9) { # 9 IM - Inner markers (IM) for an ILS if ($acnt < 11) { prtw("WARNING:$lnn: [$line] SKIPPING split $acnt\n"); next; } $rwy = $arr[9]; $name = $arr[10]; } elsif ($type == 12) { # 12 DME - including the DME component of an ILS, VORTAC or VOR-DME Frequency display suppressed on X-Plane’s charts # 0 1 2 3 4 5 6 7 8 9 10 # 12 47.43433300 -122.30630000 369 11030 18 0.000 ISNQ KSEA 16L DME-ILS # 12 47.43538889 -122.30961111 354 11680 130 0.0 SEA SEATTLE VORTAC DME # exceptions # 0 1 2 3 4 5 6 7 8 # 12 49.22907200 007.41789200 1177 11480 60 0.0 ZWN ZWEIBRUCKEN VOR-DME # $feet = $arr[3]; # $freq = $arr[4]; # $rng = $arr[5]; # $bear = $arr[6]; # $id = $arr[7]; # $icao = $arr[8]; if (($acnt > 10) && look_like_icao($icao) && looks_like_rwy($arr[9])) { $rwy = $arr[9]; $name = $arr[10]; } elsif (looks_like_number($feet) && looks_like_freq($freq) && looks_like_number($rng) && looks_like_bearing($bear) && looks_like_id($id)) { $icao = ''; # this is NOT an ICAO $name = join(' ', splice(@arr,8)); } else { prtw("WARNING:$lnn: [$line] SKIPPING split $acnt\n"); next; } } elsif ($type == 13) { # 13 Stand-alone DME, or the DME component of an NDB-DME Frequency will displayed on X-Plane’s charts # 0 1 2 3 4 5 6 7 8 # 13 57.10393300 009.99280800 57 11670 199 0.0 AAL AALBORG TACAN # 13 68.71941900 -052.79275300 172 10875 25 0.0 AS AASIAAT DME $icao = ''; $name = join(' ', splice(@arr,8)); } else { prt("$lnn: INVALID [$line]\n"); next; } ############################################################################## # 0 1 2 3 4 5 6 7 8 9 10 push(@navlist,[$type,$nlat,$nlon,$feet,$freq,$rng,$bear,$id,$icao,$rwy,$name]); ############################################################################## } $type = scalar @navlist; prt("Collected $type navaids, before filtering...\n"); filter_nav_list() if ($do_nav_filter); @sorted = sort mycmp_ascend_n0 @navlist; $o_file = $out_path.$PATH_SEP.$out_base."-nav.csv"; $diff = scalar @sorted; prt("Loaded $diff navaids... writing to $o_file\n"); $line = "type,lat,lon,feet,freq,rng,bear,id,icao,rwy,\"name\"\n"; # 0 1 2 3 4 5 6 7 8 9 10 # push(@navlist,[$type,$nlat,$nlon,$feet,$freq,$rng,$bear,$id,$icao,$rwy,$name]); for ($i = 0; $i < $diff; $i++) { $ra = $sorted[$i]; $type = ${$ra}[0]; $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; $feet = ${$ra}[3]; $freq = ${$ra}[4]; $rng = ${$ra}[5]; $bear = ${$ra}[6]; $id = ${$ra}[7]; $icao = ${$ra}[8]; $rwy = ${$ra}[9]; $name = ${$ra}[10]; $line .= "$type,$nlat,$nlon,$feet,$freq,$rng,$bear,$id,$icao,$rwy,\"$name\"\n"; } push(@files_written,[$out_base."-nav.csv",$diff,length($line)]); write2file($line,$o_file); prt("nav CSV written to [$o_file]\n"); } ######################################### ### MAIN ### ##parse_args(@ARGV); ##process_in_file($in_file); parse_nav_lines(load_nav_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); 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); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n") if (VERB1()); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if ((length($in_file) == 0) && $debug_on) { $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 <file> (-o) = Write output to this file.\n"); } # eof - template.pl