#!/usr/bin/perl -w # NAME: fg_runways.pl # AIM: Read the xml threshold files # 08/04/2013 geoff mclane http://geoffair.net/mperl # 2016-12-04 - review use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) 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"; # 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_dir = ''; my $in_file = ''; my $in_icao = ''; my $in_root = ''; my $fg_scenery = 'G:\S'; my $verbosity = 0; my $out_file = ''; # ### DEBUG ### my $debug_on = 0; # my $def_dir = 'C:\FG\fgdata'; my $def_dir = 'D:\Scenery\terrascenery\data'; # my $test_file = 'D:\Scenery\terrascenery\data\Scenery\Airports\7\0\V\70VA.threshold.xml'; my $test_file = 'G:\S\Airports\L\S\T\LSTZ.threshold.xml'; ##my $test_file = 'D:\Scenery\terrascenery\data\Scenery\Airports\L\S\T\LSTZ.threshold.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 %icao_hash = (); my %body_hash = (); my %thresholds = (); my $show_runways = 1; sub show_thresholds_hash() { my ($key,$ra,$rcnt,$rllh,$msg,$rev); foreach $key (keys %thresholds) { $ra = $thresholds{$key}; $rcnt = scalar @{$ra}; prt("$key has $rcnt runways\n"); if ($show_runways) { my ($min_lat,$min_lon,$max_lat,$max_lon); my ($i,$ra2,$lat,$lon,$rwy,$hdg,$ra3); $min_lat = 91; $max_lat = -91; $min_lon = 181; $max_lon = -181; my %rwyhash = (); for ($i = 0; $i < $rcnt; $i++) { # push(@{$ra4}, [$rwy, $lat, $lon, $hdg, $displ_m, $stopw_m] ); $ra2 = ${$ra}[$i]; #// extract one $rwy = ${$ra2}[0]; $lat = ${$ra2}[1]; $lon = ${$ra2}[2]; $hdg = ${$ra2}[3]; $min_lat = $lat if ($lat < $min_lat); $max_lat = $lat if ($lat > $max_lat); $min_lon = $lon if ($lon < $min_lon); $max_lon = $lon if ($lon > $max_lon); $rwyhash{$rwy} = [] if (!defined $rwyhash{$rwy}); $ra3 = $rwyhash{$rwy}; # 0 1 2 push(@{$ra3}, [$lat,$lon,$hdg]); } prt("Bounding box $min_lat,$min_lon to $max_lat,$max_lon\n"); $rcnt = scalar keys(%rwyhash); prt("With $rcnt runway markings...\n"); foreach $key (keys %rwyhash) { $ra3 = $rwyhash{$key}; $rcnt = scalar @{$ra3}; $msg = ''; for ($i = 0; $i < $rcnt; $i++) { $rllh = ${$ra3}[$i]; $lat = ${$rllh}[0]; $lon = ${$rllh}[1]; $hdg = ${$rllh}[2]; $msg .= "$lat,$lon,$hdg "; } $rwy = $key; $rev = ''; if ($rwy =~ /^(\d+)(\w*)$/) { $rev = ($1 > 18) ? $1 - 18 : $1 + 18; $rev = '0'.$rev if ($rev < 10); if (defined $2) { $rev .= 'L' if ($2 eq 'R'); $rev .= 'R' if ($2 eq 'L'); $rev .= 'C' if ($2 eq 'C'); } } # only for display $rev .= ' ' while (length($rev) < 3); $key .= ' ' while (length($key) < 3); prt("Ryw $key - $msg - $rcnt cnt... rev. $rev\n"); } } } } # the 'key' is the ICAO # the 'ff' is the path 'ICAO.threshold.xml' file # For display output only... # the 'kcnt' just indicate the file number seq - 0,1,2 # the 'ra2cnt' the runway count seq - 0, 1, 2, sub load_xml_file($$$$) { my ($key,$ff,$kcnt,$ra2cnt) = @_; my $xml = new XML::Simple; my $data = $xml->XMLin($ff); if (! defined ${$data}{'runway'}) { prt("$kcnt: File [$ff] NOT valid 'ICAO.threshold.xml' file!\n"); return; } my $ref_array = ${$data}{'runway'}; # an ARRAY of 'thresholds' HASHES my $rhcnt = 0; my $rt = ref $ref_array; prt("$kcnt: File [$ff] as $rt...\n"); # if (VERB9()); # 'displ-m' => '91', # 'lat' => '37.6117064652036', # 'hdg-deg' => '297.91', # 'stopw-m' => '0', # 'rwy' => '28L', # 'lon' => '-122.358344777098' my ($displ_m,$lat,$hdg,$stopw_m,$rwy,$lon); my ($rh,$ra3,$ra3cnt,$rh3); my $dm = 'displ-m'; my $la = 'lat'; my $hd = 'hdg-deg'; my $sw = 'stopw-m'; my $rw = 'rwy'; my $lo = 'lon'; $thresholds{$key} = [] if (!defined $thresholds{$key}); my $ra4 = $thresholds{$key}; if ($rt eq 'HASH') { $rhcnt++; if (defined ${$ref_array}{'threshold'}) { $ra3 = ${$ref_array}{'threshold'}; $ra3cnt = 0; foreach $rh3 (@{$ra3}) { # should be 2 ends $ra3cnt++; $rwy = ${$rh3}{$rw}; $lat = ${$rh3}{$la}; $lon = ${$rh3}{$lo}; $hdg = ${$rh3}{$hd}; $displ_m = (defined ${$rh3}{$dm}) ? ${$rh3}{$dm} : 0; $stopw_m = (defined ${$rh3}{$sw}) ? ${$rh3}{$sw} : 0; if (defined $rwy && defined $lat && defined $lon && defined $hdg) { prt("$kcnt:$ra2cnt:$rhcnt:$ra3cnt: $key $rwy $lat $lon $hdg $displ_m $stopw_m\n") if (VERB5()); push(@{$ra4}, [$rwy, $lat, $lon, $hdg, $displ_m, $stopw_m] ); } else { prt("$kcnt:$ra2cnt:$rhcnt:$ra3cnt: $key FAILED!\n"); prt(Dumper($rh3)); pgm_exit(1,"FAILED 2 $ff\n"); } } } else { prt("OOPS! No 'threshold' defined!\n"); prt(Dumper($rh)); pgm_exit(1,"FAILED 1 $ff\n"); } return; } foreach $rh (@{$ref_array}) { #prt(Dumper($rh)); $rhcnt++; if (defined ${$rh}{'threshold'}) { $ra3 = ${$rh}{'threshold'}; $ra3cnt = 0; foreach $rh3 (@{$ra3}) { # should be 2 ends $ra3cnt++; $rwy = ${$rh3}{$rw}; $lat = ${$rh3}{$la}; $lon = ${$rh3}{$lo}; $hdg = ${$rh3}{$hd}; $displ_m = (defined ${$rh3}{$dm}) ? ${$rh3}{$dm} : 0; $stopw_m = (defined ${$rh3}{$sw}) ? ${$rh3}{$sw} : 0; if (defined $rwy && defined $lat && defined $lon && defined $hdg) { prt("$kcnt:$ra2cnt:$rhcnt:$ra3cnt: $key $rwy $lat $lon $hdg $displ_m $stopw_m\n") if (VERB5()); push(@{$ra4}, [$rwy, $lat, $lon, $hdg, $displ_m, $stopw_m] ); } else { prt("$kcnt:$ra2cnt:$rhcnt:$ra3cnt: $key FAILED!\n"); prt(Dumper($rh3)); pgm_exit(1,"FAILED 2 $ff\n"); } } } else { prt("OOPS! No 'threshold' defined!\n"); prt(Dumper($rh)); pgm_exit(1,"FAILED 1 $ff\n"); } } ### prt(Dumper($data)); ### pgm_exit(1,"Found $ff\n"); } sub show_icao_hash() { my @arr = keys %icao_hash; my $kcnt = scalar @arr; prt("Got $kcnt ICAO entries in hash...\n"); my @arr2 = keys %body_hash; my $bcnt = scalar @arr2; prt("with $bcnt xml type files - "); # .join(" ",@arr2)."\n"); my ($cnt,$body,$ra,$key,$ra2,$ff,$xml,$data,$ref_array,$rh); my ($ra3,$rh3,$ra2cnt,$ra3cnt,$rhcnt); my ($ra4); # 'displ-m' => '91', # 'lat' => '37.6117064652036', # 'hdg-deg' => '297.91', # 'stopw-m' => '0', # 'rwy' => '28L', # 'lon' => '-122.358344777098' my ($displ_m,$lat,$hdg,$stopw_m,$rwy,$lon); my $dm = 'displ-m'; my $la = 'lat'; my $hd = 'hdg-deg'; my $sw = 'stopw-m'; my $rw = 'rwy'; my $lo = 'lon'; foreach $body (@arr2) { $cnt = $body_hash{$body}; prt("$body=$cnt "); } prt("\n"); $kcnt = 0; foreach $key (@arr) { $kcnt++; ###next if ($key ne 'KSFO'); ###next if (defined $exceptions{$key}); $ra = $icao_hash{$key}; # 0 1 # push(@{$ra}, [$body,$ff]); $ra2cnt = 0; foreach $ra2 (@{$ra}) { $ra2cnt++; $body = ${$ra2}[0]; $ff = ${$ra2}[1]; if ($body eq 'threshold') { load_xml_file($key,$ff,$kcnt,$ra2cnt); } } } } sub get_icao_xml($); # EXCEPTION: LKTB-groundnet.xml sub get_icao_xml($) { my $dir = shift; if (! opendir(DIR,"$dir")) { prtw("WARNING: Unable to open dir $dir!\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$dcnt,$icao,$body,$ra); my @dirs = (); my $fcnt = 0; ut_fix_directory(\$dir); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { if ($file =~ /^(\w+)\.(.+)\.xml$/) { $icao = $1; $body = $2; $icao_hash{$icao} = [] if (!defined $icao_hash{$icao}); $ra = $icao_hash{$icao}; push(@{$ra}, [$body,$ff]); if (defined $body_hash{$body}) { $body_hash{$body}++; } else { $body_hash{$body} = 1; } } elsif ($file =~ /^(\w+)-(.+)\.xml$/) { $icao = $1; $body = $2; $icao_hash{$icao} = [] if (!defined $icao_hash{$icao}); $ra = $icao_hash{$icao}; push(@{$ra}, [$body,$ff]); if (defined $body_hash{$body}) { $body_hash{$body}++; } else { $body_hash{$body} = 1; } } else { prtw("WARNING: What is this? [$ff] [$file] FIX ME\n"); } $fcnt++; } else { prtw("WARNING: Check this item [$ff] [$file]!\n"); } } $dcnt = scalar @dirs; foreach $dir (@dirs) { get_icao_xml($dir); } } sub get_groundnet_list($) { my $dir = shift; if (! opendir(DIR,"$dir")) { prtw("WARNING: Unable to open dir $dir!\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$dcnt); my @dirs = (); my $fcnt = 0; ut_fix_directory(\$dir); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { $fcnt++; } else { prtw("WARNING: Check this item [$ff] [$file]!\n"); } } $dcnt = scalar @dirs; prt("Found $fcnt files, and $dcnt directories in [$dir]...\n"); foreach $dir (@dirs) { get_icao_xml($dir); } } sub process_in_dir($) { my $dir = shift; if (! opendir(DIR,"$dir")) { prtw("WARNING: Unable to open dir $dir!\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$dcnt); my @dirs = (); my $fcnt = 0; my $aidir = ''; my $apdir = ''; my $scdir = ''; ut_fix_directory(\$dir); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); if ($file eq 'AI') { ut_fix_directory(\$ff); $ff .= 'airports'; if (-d $ff) { $aidir = $ff; } } elsif ($file eq 'Airports') { $apdir = $ff; } elsif ($file eq 'Scenery') { ut_fix_directory(\$ff); $ff .= 'Airports'; if (-d $ff) { $scdir = $ff; } } } elsif (-f $ff) { $fcnt++; } else { prtw("WARNING: Check this item [$ff] [$file]!\n"); } } $dcnt = scalar @dirs; prt("Found $fcnt files, and $dcnt directories...\n"); prt("Found 'AI' directory [$aidir]\n") if (length($aidir)); prt("Found 'Airports' directory [$apdir]\n") if (length($apdir)); if (length($scdir)) { prt("Found 'Scenery/Airports' directory [$scdir]\n"); get_groundnet_list($scdir); } } sub load_file($) { my $ff = shift; if (-f $ff) { prt("Loading file '$ff'...\n"); my ($file,$dir) = fileparse($ff); my ($icao,$body,$ra); if ($file =~ /^(\w+)\.(.+)\.xml$/) { $icao = $1; $body = $2; $icao_hash{$icao} = [] if (!defined $icao_hash{$icao}); $ra = $icao_hash{$icao}; push(@{$ra}, [$body,$ff]); if (defined $body_hash{$body}) { $body_hash{$body}++; } else { $body_hash{$body} = 1; } if ($body ne 'threshold') { prtw("WARNING: File name [$file] does not appear to be of form ICAO.threshold.xml!\nbut will attempt a load...\n"); } load_xml_file($icao,$ff,0,0); } elsif ($file =~ /^(\w+)-(.+)\.xml$/) { $icao = $1; $body = $2; $icao_hash{$icao} = [] if (!defined $icao_hash{$icao}); $ra = $icao_hash{$icao}; push(@{$ra}, [$body,$ff]); if (defined $body_hash{$body}) { $body_hash{$body}++; } else { $body_hash{$body} = 1; } if ($body ne 'threshold') { prtw("WARNING: File name [$file] does not appear to be of form ICAO.threshold.xml!\nbut will attempt a load...\n"); } load_xml_file($icao,$ff,0,0); } else { prtw("WARNING: File name [$file] does not appear to be of form ICAO.threshold.xml!\nbut will attempt a load...\n"); load_xml_file("UNKNONW",$in_file,0,0); } } } sub find_icao($$) { my ($icao,$root) = @_; if (! -d $root) { pgm_exit(1,"ERROR: Unable to find ROOT directory [$root]! Check name, location...\n"); } my $len = length($icao); if ( !(($len == 3) || ($len == 4)) ) { pgm_exit(1,"ERROR: Expect a 3 or 4 character ICAO '$icao'! Got $len. Check value...\n"); } my @arr = (); my ($i,$ch); my $path = $root.$PATH_SEP.'Airports'; if (! -d $path) { pgm_exit(1,"ERROR: Unable to find ROOT directory '$path'! Check name, location...\n"); } for ($i = 0; $i < $len; $i++) { $ch = substr($icao,$i,1); push(@arr,$ch); if ($i < 3) { $path .= $PATH_SEP.$ch; } } my $file = $path.$PATH_SEP."$icao.threshold.xml"; if (-f $file) { load_file($file); } else { prt("Finding '$icao', in '$root', file $file FAILED\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); if (length($in_icao)) { find_icao($in_icao,$in_root); } elsif (length($in_file)) { load_file($in_file); } elsif (length($in_dir)) { process_in_dir($in_dir); } ###show_icao_hash(); show_thresholds_hash(); 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 { # what do we have here? if (-f $arg) { $in_file = $arg; } elsif (-d $arg) { $in_dir = $arg; prt("Set direcotry input to [$in_dir]\n") if (VERB1()); } elsif ((length($arg) == 4)||(length($arg) == 3)) { $in_icao = $arg; prt("Set ICAO input to [$in_icao]\n") if (VERB1()); } } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if ((length($in_file) == 0) && length($test_file) && ( -f $test_file )) { $in_file = $test_file; prt("Set DEFAULT input file to [$in_file]\n"); #} elsif ((length($in_dir) == 0) && length($def_dir) && ( -d $def_dir )) { # $in_dir = $def_dir; # prt("Set DEFAULT input directory to [$in_dir]\n"); } $load_log = 2; } if ((length($in_dir) == 0)&&(length($in_file) == 0)&&(length($in_icao) == 0)) { pgm_exit(1,"ERROR: No inputs found in command!\n"); } if (length($in_file) && (! -f $in_file)) { pgm_exit(1,"ERROR: Unable to find file [$in_file]! Check name, location...\n"); } if (length($in_dir) && (! -d $in_dir)) { pgm_exit(1,"ERROR: Unable to find in directory [$in_dir]! Check name, location...\n"); } if (length($in_root) && (! -d $in_root)) { pgm_exit(1,"ERROR: Unable to find ROOT directory [$in_root]! Check name, location...\n"); } if (length($in_icao)) { if (length($in_root) == 0) { $in_root = $fg_scenery; } if (! -d $in_root) { pgm_exit(1,"ERROR: Unable use ICAO '$in_icao', without scenery ROOT directory [$in_root]!\n"); } } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] fg-root-dir or 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"); } sub info() { my $txt = < perl -MCPAN -e shell cpan> install XML::Simple File: D:\\Scenery\\terrascenery\\data\\Scenery\\Airports\\7\\0\\V\\70VA.threshold.xml \$VAR1 = { 'runway' => { 'threshold' => [ { 'displ-m' => '0', 'lat' => '37.0739669185387', 'hdg-deg' => '54.00', 'stopw-m' => '0', 'rwy' => '06', 'lon' => '-79.8297582101689' }, { 'displ-m' => '0', 'lat' => '37.0768690288565', 'hdg-deg' => '234.00', 'stopw-m' => '0', 'rwy' => '24', 'lon' => '-79.824751694029' } ] } }; File: D:\\Scenery\\terrascenery\\data\\Scenery\\Airports\\K\\S\\F\\KSFO.threshold.xml ie \$ref_array = \${\$data}{'runway'}; # an ARRAY of 'thresholds' HASHES so foreach \$rh (\@{\$ref_array}) { then \$VAR1 = { 'runway' => [ { 'threshold' => [ { 'displ-m' => '150', 'lat' => '37.6089861020029', 'hdg-deg' => '27.70', 'stopw-m' => '0', 'rwy' => '01L', 'lon' => '-122.382198312909' }, { 'displ-m' => '107', 'lat' => '37.6272055903445', 'hdg-deg' => '207.70', 'stopw-m' => '0', 'rwy' => '19R', 'lon' => '-122.370122207455' } ] }, { 'threshold' => [ { 'displ-m' => '73', 'lat' => '37.6068179874086', 'hdg-deg' => '27.71', 'stopw-m' => '0', 'rwy' => '01R', 'lon' => '-122.380713288884' }, { 'displ-m' => '0', 'lat' => '37.6278236033164', 'hdg-deg' => '207.71', 'stopw-m' => '0', 'rwy' => '19L', 'lon' => '-122.366784743638' } ] }, { 'threshold' => [ { 'displ-m' => '91', 'lat' => '37.6287336332232', 'hdg-deg' => '117.90', 'stopw-m' => '0', 'rwy' => '10L', 'lon' => '-122.39339042147' }, { 'displ-m' => '91', 'lat' => '37.6135315946418', 'hdg-deg' => '297.90', 'stopw-m' => '0', 'rwy' => '28R', 'lon' => '-122.357141284717' } ] }, { 'threshold' => [ { 'displ-m' => '91', 'lat' => '37.6252893238143', 'hdg-deg' => '117.91', 'stopw-m' => '0', 'rwy' => '10R', 'lon' => '-122.390718180036' }, { 'displ-m' => '91', 'lat' => '37.6117064652036', 'hdg-deg' => '297.91', 'stopw-m' => '0', 'rwy' => '28L', 'lon' => '-122.358344777098' } ] } ] }; EOF return $txt; } # eof - template.pl