Generated: Sun Aug 21 11:11:16 2011 from msfs-fp.pl 2010/11/23 15.3 KB.
#!/usr/bin/perl -w # NAME: msfs-fp.pl # AIM: Read and show details of the MSFS2002 FLight Plan file # 09/11/2010 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_file = ''; my $debug_on = 0; my $def_file = 'C:\Program Files\Microsoft Games\FS2002\flights\myflts\LFPZ2EHLE-vor.PLN'; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $verbosity = 0; my %shown_diff = (); 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" ); } } 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 get_data_points() { my @data = qw( title description type routetype cruising_altitude departure_id departure_position destination_id departure_name destination_name ); my %h = (); foreach (@data) { $h{$_} = 1; } return \%h; } sub get_sample_output() { my $data = <<EOF; [title] = [LFPZ to EHLE] [description] = [LFPZ, EHLE] [type] = [VFR] [routetype] = [1] [cruising_altitude] = [3500] [departure_id] = [LFPZ, N48* 48.95', E2* 3.83', +000371.00] [departure_position] = [12L] [destination_id] = [EHLE, N52* 27.09', E5* 30.69', -000009.71] [departure_name] = [St Cyr-L'ecole] [destination_name] = [Lelystad] [waypoint.0] = [LFPZ, A, N48* 48.95', E2* 3.83', +000371.00, ] [waypoint.1] = [LFMVM, V+LOCWAY, N49* 33.15', E2* 29.27', +000000.00, ] [waypoint.2] = [LFCMB, V+LOCWAY, N50* 13.69', E3* 9.09', +000000.00, ] [waypoint.3] = [EBNIK, V+LOCWAY, N51* 9.90', E4* 11.03', +000000.00, ] [waypoint.4] = [EHRTM, V+LOCWAY, N51* 58.42', E4* 28.86', +000000.00, ] [waypoint.5] = [EHPAM, V+LOCWAY, N52* 20.09', E5* 5.53', +000000.00, ] [waypoint.6] = [EHLE, A, N52* 27.09', E5* 30.69', -000009.71, ] EOF return $data; } sub split_cvs($) { my ($txt) = @_; my @arr =(); my ($len,$i,$ch,$qc,$tag); $len = length($txt); $qc = 0; $tag = ''; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); if ($qc) { $tag .= $ch; $qc = 0 if ($ch eq '"'); } elsif ($ch eq '"') { push(@arr,$tag) if (length($tag)); $tag = ''; $qc = 1; } elsif ($ch eq ',') { push(@arr,$tag) if (length($tag)); $tag = ''; } else { $tag .= $ch; } } push(@arr,$tag) if (length($tag)); return @arr; } sub get_degs_lat_or_lon($) { my ($txt) = @_; my @arr = split(/\s+/,$txt); my $cnt = 0; my $args = ''; my $degs = 0; my ($arg,$arg2,$deg1); foreach $arg (@arr) { $args .= ' ' if ($cnt); $args .= $arg; $cnt++; if ($cnt == 1) { $arg = substr($arg,1) if ($arg =~ /^\w/); $arg = substr($arg,0,length($arg)-1) if ($arg =~ /\D$/); $deg1 = $arg; $degs += $arg; #print "Arg 1 Degrees = $arg ($deg1) = $degs\n"; } elsif ($cnt == 2) { $arg = substr($arg,0,length($arg)-1) if ($arg =~ /\D$/); $arg2 = $arg; $arg2 =~ s/\'//; $degs += ($arg2 / 60); $deg1 = ($arg2 / 60); #print "Arg 2 Minutes = $arg ($deg1) = $degs\n"; } elsif ($cnt == 3) { $arg2 = $arg; $arg2 =~ s/\"//; $degs += ($arg2 / (60*60)); $deg1 = ($arg2 / (60*60)); #print "Arg 3 Seconds = $arg ($deg1) = $degs\n"; } else { $deg1 = 0; #print "Arg 4+ = $arg ($deg1) = $degs\n"; } } if ($txt =~ /(N|E)/i) { # as is } elsif ($txt =~ /(S|W)/i) { $degs *= -1; } return $degs; } sub get_d_ll($) { my ($pt) = @_; # [departure_id] = N48* 48.95', E2* 3.83', $pt = trim_all($pt); my $len = length($pt); my $NSEW = substr($pt,0,1); # NSEW my ($i,$ch,$val,$num,$ok,$msg); my $dlatlon = 200.0; my $degs = 0; my $mins = 0; my $bgnlet = ''; my $chkdegs = get_degs_lat_or_lon($pt); $ok = 0; $msg = "[v9] From: $pt:"; #if ($pt =~ /^w/) { # $bgnlet = substr($pt,0,1); # $pt = substr($pt,1); # $len = length($pt); #} $val = 0; # accumule a number for ($i = 1; $i < $len; $i++) { $ch = substr($pt,$i,1); if ($ch =~ /(\.|\d)/) { $val .= $ch; } else { $ok |= 1 if ($i > 1); last; } } $degs = $val; # collect the degrees $msg .= " Degs $degs"; $i++; # skip a space, or non-number for (; $i < $len; $i++) { $ch = substr($pt,$i,1); if ($ch =~ /(\.|\d)/) { $ok |= 2; last; } else { $val .= $ch; } } # $i++; # accumule a number $val = 0; for (; $i < $len; $i++) { $ch = substr($pt,$i,1); if ($ch =~ /(\.|\d)/) { $val .= $ch; $ok |= 4; } else { last; } } $mins += $val; $msg .= " Mins $mins"; if ($ok && ($NSEW =~ /[NSEW]/i)) { $dlatlon = $degs + ($mins / 60); if ($NSEW =~ /(S|W)/) { $dlatlon *= -1; } } $i = abs($dlatlon - $chkdegs); if ( $i > 0.000001) { if (! defined $shown_diff{$pt} ) { $shown_diff{$pt} = 1; prtw("Have DIFF [$dlatlon] to [$chkdegs] = [$i]! CHECK CALCS on [$pt]\n"); } } prt("$msg double = $dlatlon ($chkdegs)\n") if (VERB9()); return $dlatlon; } # 0 1 2 3 # [departure_id] = [LFPZ, N48* 48.95', E2* 3.83', +000371.00] # [destination_id] = [EHLE, N52* 27.09', E5* 30.69', -000009.71] sub get_ref_point($) { my ($equ) = @_; my @arr = split_cvs($equ); my $len = scalar @arr; my %h = (); my ($icao,$lat,$lon,$alt,$dlat,$dlon); if ($len == 4) { $icao = $arr[0]; $lat = $arr[1]; $lon = $arr[2]; $alt = $arr[3]; $dlat = get_d_ll($lat); $dlon = get_d_ll($lon); $h{$icao} = [ $dlat, $dlon, $lat, $lon, $alt ]; } else { pgm_exit(1,"ERROR: Did NOT split to 4... got [$len] [$equ]\n"); } return \%h } # 0 1 2 3 # [departure_id] = [LFPZ, N48* 48.95', E2* 3.83', +000371.00] # [destination_id] = [EHLE, N52* 27.09', E5* 30.69', -000009.71] sub add_ref_point($$$$) { my ($equ,$rpts,$type,$ricao) = @_; my @arr = split_cvs($equ); my $len = scalar @arr; #my %h = (); my ($icao,$lat,$lon,$alt,$dlat,$dlon); if ($len == 4) { $icao = $arr[0]; $lat = $arr[1]; $lon = $arr[2]; $alt = $arr[3]; $dlat = get_d_ll($lat); $dlon = get_d_ll($lon); ${$rpts}{$icao} = [ $dlat, $dlon, $lat, $lon, $alt, $type, -1 ]; ${$ricao} = $icao; # return ICAO return 1; } return 0; } sub add_way_point($$$) { my ($equ,$rpts,$ncnt) = @_; # [waypoint.1] = [LFMVM, V+LOCWAY, N49* 33.15', E2* 29.27', +000000.00, ] my @arr = split_cvs($equ); my $len = scalar @arr; #my %h = (); my ($icao,$lat,$lon,$alt,$dlat,$dlon,$type); if ($len == 5) { $icao = $arr[0]; $type = $arr[1]; $lat = $arr[2]; $lon = $arr[3]; $alt = $arr[4]; $dlat = get_d_ll($lat); $dlon = get_d_ll($lon); if (defined ${$rpts}{$icao}) { my $rpti = ${$rpts}{$icao}; # could CHECK the lat,lon... ${$rpti}[5] .= " $type"; } else { ${$rpts}{$icao} = [ $dlat, $dlon, $lat, $lon, $alt, $type, $ncnt ]; } return 1; } return 0; } sub mycmp_ascend { return -1 if (${$a}[0] < ${$b}[0]); return 1 if (${$a}[0] > ${$b}[0]); return 0; } sub show_ref_pts($) { my ($refpts) = @_; my ($icao,$rpti,$dlat,$dlon,$alt,$type,$ncnt,$ord,$dicao); my ($item,$dlatlon); my @arr = (); foreach $icao (keys %{$refpts}) { $rpti = ${$refpts}{$icao}; # 0 1 2 3 4 5 6 #${$rpts}{$icao} = [ $dlat, $dlon, $lat, $lon, $alt, $type, $ncnt ]; $alt = ${$rpti}[4]; $type = ${$rpti}[5]; $ncnt = ${$rpti}[6]; $ord = sprintf("%7d", $ncnt); push(@arr, [ $ncnt, $icao ]); } @arr = sort mycmp_ascend @arr; foreach $item (@arr) { $icao = ${$item}[1]; # (keys %{$refpts}) { next if ( ! defined ${$refpts}{$icao}); $dicao = $icao; $dicao .= " " while (length($dicao) < 6); $rpti = ${$refpts}{$icao}; # 0 1 2 3 4 5 6 #${$rpts}{$icao} = [ $dlat, $dlon, $lat, $lon, $freq, $type, $ncnt ]; $dlat = ${$rpti}[0]; $dlon = ${$rpti}[1]; $dlatlon = sprintf("[%0.6f,%0.6f]", $dlat, $dlon); $alt = ${$rpti}[4]; $type = ${$rpti}[5]; $ncnt = ${$rpti}[6]; $ord = sprintf("%7d", $ncnt); prt( "$ord: $dicao $dlatlon $alt $type\n" ); } } # LFMVM 49.0525 2.1545 # -latlon=49.0525,2.1545 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; my ($in_name,$in_dir) = fileparse($inf); prt("Processing $lncnt lines, from [$in_name]...\n"); my $rdps = get_data_points(); my ($line,$inc,$lnn,$item,$equ,$ncnt,$icao); $lnn = 0; $inc = ''; my %h = (); my $refpts = \%h; my ($rfrom,$rto,$ok,$rpti); $ok = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\[(.+)\]\s*$/) { $inc = $1; prt("$lnn: Section: $inc\n"); } elsif ($line =~ /(.+)\s*=\s*(.+)\s*$/) { $item = trim_all($1); $equ = trim_all($2); if (defined ${$rdps}{$item}) { # one of needed data points... if ($item =~ /departure_id/) { # [departure_id] = [LFPZ, N48* 48.95', E2* 3.83', +000371.00] $rfrom = get_ref_point($equ); if (add_ref_point($equ,$refpts,"begin",\$icao)) { if (defined ${$refpts}{$icao}) { $rpti = ${$refpts}{$icao}; ${$rpti}[6] = -2; # keep out of waypoint numbers, but not -1 (NOT SET) $ok |= 1; } } } elsif ($item =~ /destination_id/) { # [destination_id] = [EHLE, N52* 27.09', E5* 30.69', -000009.71] $rto = get_ref_point($equ); if (add_ref_point($equ,$refpts,"end",\$icao)) { if (defined ${$refpts}{$icao}) { $rpti = ${$refpts}{$icao}; ${$rpti}[6] = 9999999; # just the MAX in this array ;=)) $ok |= 2; } } } } elsif ($item =~ /^waypoint/) { # a way point if ($item =~ /^waypoint\.(\d+)$/) { $ncnt = $1; $ok |= 4 if (add_way_point($equ,$refpts,$ncnt)); } } else { prt("[$item] = [$equ]\n"); } } } show_ref_pts($refpts); } ######################################### ### MAIN ### parse_args(@ARGV); # prt( "$pgmname: in [$cwd]: Hello, World...\n" ); process_in_file($in_file); pgm_exit(0,"Normal exit(0)"); ######################################## sub give_help { prt("$pgmname: version 0.0.1 2010-09-11\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub deal_with_verbosity($) { my ($rav) = @_; my ($arg,$sarg,$i,$cnt); $cnt = scalar @{$rav}; #prt("Doing verbosity check of $cnt args...\n"); for ($i = 0; $i < $cnt; $i++) { $arg = ${$rav}[$i]; #prt("Checking [$arg]...\n"); if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if ($sarg =~ /^v/) { #prt("Got -v... [$arg]\n"); if ($sarg =~ /^v.*(\n+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1) } } prt( "[v1] Set verbosity to $verbosity\n") if (VERB1()); } } } } sub parse_args { my (@av) = @_; my ($arg,$sarg); deal_with_verbosity(\@av); 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/) { # already done } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; } 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"); } } # eof - template.pl