#!/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