Generated: Sat Oct 24 16:35:20 2020 from groundnet.pl 2017/04/17 40.5 KB. text copy
#!/usr/bin/perl -w # NAME: groundnet.pl # AIM: Quite specific - Read a FG airport groundnet.xml and show info # 2017-04-17 - Squash some warnings! See 'number' replaced with 'index' # 25/06/2015 - Show help if no command # 14/06/2015 - search a variety of places for the ground net files # 30/08/2013 geoff mclane http://geoffair.net/mperl 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"; 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"; my $tmpdump = $temp_dir.$PATH_SEP."tempdump"; open_log($outfile); # user variables my $VERS = "0.0.3 2015-06-25"; ##my $VERS = "0.0.2 2015-06-14"; ##my $VERS = "0.0.1 2013-03-17"; my $load_log = 0; my $in_icao = ''; my $verbosity = 0; my $out_file = ''; ################################################################# # search places my $scenery = 'D:\Scenery\terrascenery\data\Scenery\Airports'; my $fgroot = 'X:\fgdata'; my $fgdata = $fgroot.'\Scenery\Airports'; my $tsroot = 'X:\fgsvnts'; my $tsdata = $tsroot.'\Airports'; ################################################################ my $xg_out = ''; my $add_parkpos = 0; my $def_rad = 30; my $add_names = 1; my $at_head = 0; my $add_info = 0; my $seg_color = 'blue'; my $box_color = 'blue'; my $hdg_color = 'white'; my $rsegxg = ''; my @gbounds = (); # ### DEBUG ### my $debug_on = 0; #my $def_icao = 'EBBR'; my $def_icao = 'KSFO'; ### 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"); } } } sub init_bounds($) { my $ra = shift; @{$ra} = (); # clear any previous push(@{$ra},400); # 0 min_lon push(@{$ra},400); # 1 min_lat push(@{$ra},-400); # 2 max_lon push(@{$ra},-400); # 3 max_lat } sub set_bounds($$$) { my ($ra,$lat,$lon) = @_; ${$ra}[0] = $lon if ($lon < ${$ra}[0]); ${$ra}[1] = $lat if ($lat < ${$ra}[1]); ${$ra}[2] = $lon if ($lon > ${$ra}[2]); ${$ra}[3] = $lat if ($lat > ${$ra}[3]); } sub valid_bounds($) { return 1; } sub get_bounds($) { my $ra = shift; my $rt = ref($ra); if ($rt eq 'ARRAY') { $rt = scalar @{$ra}; if ($rt != 4) { prtw("WARNING: get_bounds called, with ARRAY, but len=$rt! Should be 4\n"); return ""; } } else { prtw("WARNING: get_bounds called, but NOT an ARRAY! rt=$rt\n"); return ""; } my $xg = "color gray\n"; $xg .= "${$ra}[0] ${$ra}[1]\n"; # min_lon min_lat $xg .= "${$ra}[0] ${$ra}[3]\n"; # min_lon max_lat $xg .= "${$ra}[2] ${$ra}[3]\n"; # max_lon max_lat $xg .= "${$ra}[2] ${$ra}[1]\n"; # max_lon min_lat $xg .= "${$ra}[0] ${$ra}[1]\n"; # min_lon min_lat $xg .= "NEXT\n"; return $xg; } sub is_decimal($) { my $num = shift; return 1 if ($num =~ /^[-+]?[0-9]*\.?[0-9]+$/); return 0; } sub dmlat2degs($$) { my ($lat,$rd) = @_; my $ns = substr($lat,0,1); my $deg = substr($lat,1); my @arr = split(/\s+/,$deg); my $cnt = scalar @arr; if ($cnt == 2) { $deg = $arr[0]; if ($deg =~ /^\d+$/) { my $min = $arr[1]; if (is_decimal($min)) { $deg += ($min / 60); if ($ns eq 'N') { ${$rd} = $deg; return 1; } elsif ($ns eq 'S') { $deg *= -1; ${$rd} = $deg; return 1; } } } } prt("Warning: lat $lat failed to convert!\n"); return 0; } sub dmlon2degs($$) { my ($lon,$rd) = @_; my $ew = substr($lon,0,1); my $deg = substr($lon,1); my @arr = split(/\s+/,$deg); my $cnt = scalar @arr; if ($cnt == 2) { $deg = $arr[0]; if ($deg =~ /^\d+$/) { my $min = $arr[1]; if (is_decimal($min)) { $deg += ($min / 60); if ($ew eq 'E') { ${$rd} = $deg; return 1; } elsif ($ew eq 'W') { $deg *= -1; ${$rd} = $deg; return 1; } } } } prt("Warning: lon $lon failed to convert!\n"); return 0; } my @freq_types = qw( GROUND DEPARTURE AWOS APPROACH TOWER UNICOM CLEARANCE ); my %short_types =( 'GROUND' => 'GND', 'DEPARTURE' => 'DEP', 'APPROACH' => 'APP', 'TOWER' => 'TWR', 'UNICOM' => 'UNI', 'CLEARANCE' => 'CLR' ); sub get_freqs($) { my $ra = shift; # \@lines my %freqs = (); my ($i,$cnt,$line,$len,$off,$tmp); $cnt = scalar @{$ra}; for ($i = 0; $i < $cnt; $i++) { $line = trim_all(${$ra}[$i]); $len = length($line); next if ($len == 0); $off = index($line, '<frequencies>'); if ($off >= 0) { $line = substr($line,$off+13); $i++; last; } } if ($i < $cnt) { # get the freq block for (; $i < $cnt; $i++) { $tmp = trim_all(${$ra}[$i]); $len = length($tmp); next if ($len == 0); $off = index($tmp, '</frequencies>'); if ($off >= 0) { $line .= substr($tmp,0,$off) if ($off > 0); last; } else { $line .= $tmp; } } if ($i < $cnt) { prt("$line\n") if (VERB9()); $len = length($line); my $tag = ''; my $txt = ''; my ($ch,$intag,$last_tag,$rva); $intag = 0; for ($i = 0; $i < $len; $i++) { $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { #prt("Close tag\n"); if ($tag =~ /^\//) { $tag = substr($tag,1); if ($tag eq $last_tag) { if (length($txt)) { prt("$tag $txt\n") if (VERB5()); $freqs{$tag} = [] if (!defined $freqs{$tag}); $rva = $freqs{$tag}; push(@{$rva},$txt); } else { pgm_exit(1,"xml tag <$tag> with NO TEXT!\n"); } $txt = ''; } else { pgm_exit(1,"xml tag <$last_tag> NOT closed by <$tag>\n"); } } else { $last_tag = $tag; # this is what we are collecting } $intag = 0; } else { $tag .= $ch; } } elsif ($ch eq '<') { $intag = 1; #prt("Start tag\n"); $tag = ''; } else { $txt .= $ch; } } } else { prt("Failed to find </frequencies>!\n"); } } else { prt("Failed to find <frequencies>!\n"); } return \%freqs; } # # <TaxiWaySegments> # <arc begin="0" end="490" isPushBackRoute="1" name="" /> # <arc begin="490" end="0" isPushBackRoute="1" name="" /> # <arc begin="1" end="485" isPushBackRoute="1" name="" /> # <arc begin="485" end="1" isPushBackRoute="1" name="" /> # ... # NOTE: The repeated duplications sub get_segments($) { my $ra = shift; my %segs = (); $segs{arc} = []; my $start = '<TaxiWaySegments>'; my $end = '</TaxiWaySegments>'; my ($i,$cnt,$line,$len,$off,$tmp); $cnt = scalar @{$ra}; for ($i = 0; $i < $cnt; $i++) { $line = trim_all(${$ra}[$i]); $len = length($line); next if ($len == 0); $off = index($line, $start); if ($off >= 0) { $line = substr($line,$off+13); $i++; last; } } if ($i >= $cnt) { prt("Failed to find $start!\n"); return \%segs; } for (; $i < $cnt; $i++) { $tmp = trim_all(${$ra}[$i]); $len = length($tmp); next if ($len == 0); $off = index($tmp, $end); if ($off >= 0) { $line .= substr($tmp,0,$off) if ($off > 0); last; } else { $line .= " $tmp"; } } if ($i >= $cnt) { prt("Failed to find $end!\n"); return \%segs; } $len =length($line); prt("len $len $line\n") if (VERB9()); ####################################################### # process all the 'segments' my ($ch,$pc,$intag,$tag,$txt,$inats,$rpa,$tg,$tx); my ($dlat,$dlon,$index); $intag = 0; $inats = 0; my $hadbgn = 0; my $hadend = 0; $ch = ''; $rpa = $segs{arc}; # <arc begin="0" end="490" isPushBackRoute="1" name="" /> for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { $intag = 0; ###$txt =~ s/\s*\/$//; prt("$tag $txt\n") if (VERB9()); if ($tag eq 'arc') { my @a = space_split($txt); # split on spaces, honoring quotes #push(@{$rpa}, \@a); my %h = (); $hadbgn = 0; $hadend = 0; foreach $tmp (@a) { next if ($tmp eq '/'); my @a2 = split("=",$tmp); $cnt = scalar @a2; if ($cnt == 2) { $tg = $a2[0]; $tx = strip_quotes($a2[1]); if (defined $h{$tg}) { prtw("WARNING: tag $tg REPEATED in [$txt]!\n"); } $tx = ' ' if (length($tx) == 0); if ($tg eq 'begin') { if ($tx =~ /^\d+$/) { $hadbgn = 1 } } elsif ($tg eq 'end') { if ($tx =~ /^\d+$/) { $hadend = 1 } } elsif ($tg eq 'isPushBackRoute') { } elsif ($tg eq 'name') { } else { pgm_exit(1,"WHAT IS THIS [$tg]! *** FIX ME ***\n"); } $h{$tg} = $tx; } else { prtw("WARNING: tg $tag item $tmp did NOT split in 2 = $cnt\n"); } } push(@{$rpa}, \%h); if (($hadbgn == 0)||($hadend == 0)) { prtw("WARNING: NO begin/end [$tag $txt]\n"); } } else { prtw("WARNING: Skipped tag [$tag in $start\n"); } $tag = ''; $txt = ''; } else { if ($inats) { $txt .= $ch; # accumulat text after the tag } elsif ($ch =~ /\s/) { $inats = 1; } else { $tag .= $ch; # accumulate the first text - the tag } } } elsif ($ch eq '<') { $intag = 1; $inats = 0; $tag = ''; $txt = ''; } } $len = scalar @{$rpa}; prt("Got $len $start...\n"); return \%segs; } # eg D:\Scenery\terrascenery\data\Scenery\Airports\K\S\F\KSFO.groundnet.xml # <TaxiNodes> # <node index="209" lat="N37 36.386" lon="W122 23.011" isOnRunway="0" holdPointType="none" /> # <node index="210" lat="N37 36.434" lon="W122 22.707" isOnRunway="0" holdPointType="none" /> sub get_nodes($) { my $ra = shift; my %taxin = (); $taxin{Nodes} = []; my %indexs = (); my $start = '<TaxiNodes>'; my $end = '</TaxiNodes>'; ##$taxi{Segments} = []; my ($i,$cnt,$line,$len,$off,$tmp,$cline); $cnt = scalar @{$ra}; for ($i = 0; $i < $cnt; $i++) { $line = trim_all(${$ra}[$i]); $len = length($line); next if ($len == 0); $cline = $line; $off = index($line, $start); if ($off >= 0) { $i++; last; } } if ($i >= $cnt) { prt("Failed to find $start! in search of $cnt lines\n"); $i = 1; $line = $tmpdump.$i.".xml"; while (-f $line) { $i++; $line = $tmpdump.$i.".xml"; } write2file(join("",@{$ra})."\n",$line); prt("Dump of lines written to '$line\n"); return \%taxin; } for (; $i < $cnt; $i++) { $tmp = trim_all(${$ra}[$i]); $len = length($tmp); next if ($len == 0); $off = index($tmp, $end); if ($off >= 0) { $line .= substr($tmp,0,$off) if ($off > 0); last; } else { $line .= " $tmp"; } } if ($i >= $cnt) { prt("Failed to find $end!\n"); return \%taxin; } $len =length($line); prt("len $len $line\n") if (VERB9()); ####################################################### # process all the 'nodes' my ($ch,$pc,$intag,$tag,$txt,$inats,$rpa,$tg,$tx); my ($dlat,$dlon,$index); $intag = 0; $inats = 0; my $hadlat = 0; my $hadlon = 0; my $hadindex = 0; $ch = ''; $rpa = $taxin{Nodes}; for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { $intag = 0; ###$txt =~ s/\s*\/$//; prt("$tag $txt\n") if (VERB9()); if ($tag eq 'node') { my @a = space_split($txt); # split on spaces, honoring quotes #push(@{$rpa}, \@a); my %h = (); $hadlat = 0; $hadlon = 0; $hadindex = 0; foreach $tmp (@a) { next if ($tmp eq '/'); my @a2 = split("=",$tmp); $cnt = scalar @a2; if ($cnt == 2) { $tg = $a2[0]; $tx = strip_quotes($a2[1]); if (defined $h{$tg}) { prtw("WARNING: tag $tg REPEATED in [$txt]!\n"); } $tx = ' ' if (length($tx) == 0); if ($tg eq 'index') { if ($tx =~ /^\d+$/) { $index = '#'.$tx; $hadindex = 1 } } elsif ($tg eq 'lat') { if (dmlat2degs($tx,\$dlat)) { $hadlat = 1; } } elsif ($tg eq 'lon') { if (dmlon2degs($tx,\$dlon)) { $hadlon = 1; } } elsif ($tg eq 'isOnRunway') { } elsif ($tg eq 'holdPointType') { } else { pgm_exit(1,"WHAT IS THIS [$tg]! *** FIX ME ***\n"); } $h{$tg} = $tx; } else { prtw("WARNING: tg $tag item $tmp did NOT split in 2 = $cnt\n"); } } push(@{$rpa}, \%h); if (($hadindex == 0)||($hadlat == 0)||($hadlon == 0)) { prtw("WARNING: NO index/lat/lon [$tag $txt]\n"); } else { $indexs{$index} = [$dlat,$dlon]; } } else { if ($tag ne 'TaxiNodes') { prtw("WARNING: Skipped tag [$tag] in TaxiNodes\n"); } } $tag = ''; $txt = ''; } else { if ($inats) { $txt .= $ch; # accumulat text after the tag } elsif ($ch =~ /\s/) { $inats = 1; } else { $tag .= $ch; # accumulate the first text - the tag } } } elsif ($ch eq '<') { $intag = 1; $inats = 0; $tag = ''; $txt = ''; } } $taxin{Indexs} = \%indexs; $len = scalar @{$rpa}; prt("Got $len $start...\n"); return \%taxin; } # Example # <Parking index="127" type="gate" name="nq" number="127" lat="N50 53.939" # lon="E04 28.103" heading="156" radius="27" pushBackRoute="588" airlineCodes="" /> sub get_parking($) { my $ra = shift; my %park = (); my ($i,$cnt,$line,$len,$off,$tmp); $cnt = scalar @{$ra}; $park{Parking} = []; for ($i = 0; $i < $cnt; $i++) { $line = trim_all(${$ra}[$i]); $len = length($line); next if ($len == 0); $off = index($line, '<parkingList>'); if ($off >= 0) { $line = substr($line,$off+13); $i++; last; } } if ($i >= $cnt) { prt("Failed to find <parkingList>!\n"); return %park; } for (; $i < $cnt; $i++) { $tmp = trim_all(${$ra}[$i]); $len = length($tmp); next if ($len == 0); $off = index($tmp, '</parkingList>'); if ($off >= 0) { $line .= substr($tmp,0,$off) if ($off > 0); last; } else { $line .= " $tmp"; } } if ($i >= $cnt) { prt("Failed to find </parkingList>!\n"); return %park; } $len =length($line); prt("len $len $line\n") if (VERB9()); my ($ch,$pc,$intag,$tag,$txt,$inats,$rpa,$tg,$tx); $intag = 0; $inats = 0; my $hadname = 0; my $hadnum = 0; $ch = ''; $rpa = $park{Parking}; for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { $intag = 0; $txt =~ s/\s*\/$//; prt("$tag $txt\n") if (VERB9()); if ($tag eq 'Parking') { my @a = space_split($txt); # split on spaces, honoring quotes #push(@{$rpa}, \@a); my %h = (); $hadname = 0; $hadnum = 0; foreach $tmp (@a) { my @a2 = split("=",$tmp); $cnt = scalar @a2; if ($cnt == 2) { $tg = $a2[0]; $tx = strip_quotes($a2[1]); if (defined $h{$tg}) { prtw("WARNING: tag $tg REPEATED in [$txt]!\n"); } $tx = ' ' if (length($tx) == 0); $h{$tg} = $tx; if ($tg eq 'name') { $hadname = 1 } elsif ($tg eq 'number') { $hadnum = 1; } elsif ($tg eq 'index') { # 20170417 - seems 'index' used in place of 'number' $hadnum = 1; } } else { prtw("WARNING: tg $tag item $tmp did NOT split in 2 = $cnt\n"); } } push(@{$rpa}, \%h); if (($hadname == 0)||($hadnum == 0)) { prtw("WARNING: NO name/num-ind [$tag $txt]\n"); } } else { prtw("WARNING: Skipped tag [$tag in parkingList\n"); } $tag = ''; $txt = ''; } else { if ($inats) { $txt .= $ch; } elsif ($ch =~ /\s/) { $inats = 1; } else { $tag .= $ch; } } } elsif ($ch eq '<') { $intag = 1; $inats = 0; $tag = ''; $txt = ''; } } return \%park; } # $rnods # $rpa = $taxi{Nodes}; # if ($tg eq 'index') { f ($tx =~ /^\d+$/) { $index = $tx; $hadindex = 1 } # } elsif ($tg eq 'lat') { if (dmlat2degs($tx,\$dlat)) { $hadlat = 1; } # } elsif ($tg eq 'lon') { if (dmlon2degs($tx,\$dlon)) { $hadlon = 1; } # ] elsif ($tg eq 'isOnRunway') { # elsif ($tg eq 'holdPointType') { # $index = '#'.$tx; # $indexs{$index} = [$dlat,$dlon]; # $taxi{Indexs} = \%indexs; # $rsegs = # $rpa = $segs{arc}; # if ($tg eq 'begin') { if ($tx =~ /^\d+$/) { $hadbgn = 1 } # } elsif ($tg eq 'end') { if ($tx =~ /^\d+$/) { $hadend = 1 } # } elsif ($tg eq 'isPushBackRoute') { # } elsif ($tg eq 'name') { # push(@{$rpa}, \%h); sub get_seg_lines($$$) { my ($rnods,$rsegs,$rba) = @_; my $rindh = ${$rnods}{Indexs}; my $rsega = ${$rsegs}{arc}; my @arr = keys %{$rindh}; my $cnt = scalar @arr; my $len = scalar @{$rsega}; prt("Got $len segments, and $cnt indexes to process...\n"); my ($bgn,$end,$rh,$rlla1,$rlla2); my ($lat1,$lon1,$lat2,$lon2,$be,$eb); my %dupes = (); my $xg = ''; my $skipped = 0; my $segcnt = 0; foreach $rh (@{$rsega}) { $bgn = ${$rh}{begin}; $end = ${$rh}{end}; if (length($bgn) && length($end)) { $bgn = '#'.$bgn; $end = '#'.$end; $be = $bgn.'|'.$end; $eb = $end.'|'.$bgn; if ( ! defined $dupes{$be} && !defined $dupes{$eb} ) { $dupes{$be} = 1; $dupes{$eb} = 1; if (defined ${$rindh}{$bgn} && defined ${$rindh}{$end}) { $rlla1 = ${$rindh}{$bgn}; $lat1 = ${$rlla1}[0]; $lon1 = ${$rlla1}[1]; if (length($lat1) && length($lon1)) { $rlla2 = ${$rindh}{$end}; $lat2 = ${$rlla2}[0]; $lon2 = ${$rlla2}[1]; $xg .= "color $seg_color\n"; $xg .= "$lon1 $lat1\n"; $xg .= "$lon2 $lat2\n"; $xg .= "NEXT\n"; $segcnt++; set_bounds($rba,$lat1,$lon1); set_bounds($rba,$lat2,$lon2); } else { prt("Failed to get lat1,lon1 for index $bgn\n"); prt(Dumper($rlla1)); prt(Dumper($rindh)); $load_log = 1; pgm_exit(1," *** FIX ME ***\n"); } } else { $skipped++; if (VERB9()) { prt("$skipped: Skipping arc $bgn $end! "); prt("Missed bgn $bgn ") if (! defined ${$rindh}{$bgn}); prt("Missed end $end ") if (! defined ${$rindh}{$end}); prt("\n"); } } } } else { prt("Failed to get 'begin' and 'end'\n"); prt(Dumper($rh)); pgm_exit(1," *** FIX ME ***\n"); } } prt("Of $len segs, added $segcnt, skipped $skipped! "); prt("Use -v5+ to show list ") if (!VERB5()); prt("\n"); return $xg; } # build file name like 'D:\Scenery\terrascenery\data\Scenery\Airports\E\B\B\EBBR.groundnet.xml' sub process_in_icao($$$) { my ($icao,$dir,$rd) = @_; pgm_exit(1,"ERROR: Invalid ICAO [$icao]\n") if (length($icao) < 3); my ($ch,$i,$file,$key,$val,$ref,$name,$val2,$msg,$tmp); for ($i = 0; $i < 3; $i++) { $ch = substr($icao,$i,1); $dir .= $PATH_SEP.$ch; } $file = $dir.$PATH_SEP.$icao.".groundnet.xml"; if (!-f $file) { prt("Warning: Can NOT locate file [$file]\n"); return; } if (!open INF, "<$file") { prt("ERROR: Can NOT OPEN file [$file]\n"); return; } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Loaded [$file]... $lncnt lines...\n"); my $rnods = get_nodes(\@lines); my $rsegs = get_segments(\@lines); # need to convert 'segments' to lines init_bounds(\@gbounds); $rsegxg = get_seg_lines($rnods,$rsegs,\@gbounds); my $rf = get_freqs(\@lines); my @arr = sort keys(%{$rf}); foreach $key (@arr) { $val = ${$rf}{$key}; $key = $short_types{$key} if (defined $short_types{$key}); #$msg .= "$key: ".join(" ",@{$val})." "; $msg .= "$key: "; foreach $tmp (@{$val}) { $msg .= $tmp / 100; $msg .= " "; } } prt("$msg\n"); my $rp = get_parking(\@lines); my $rpa = ${$rp}{Parking}; # array of hash for Parking $val = scalar @{$rpa}; # prt("Got $val 'Parking' lines...\n"); my ($rh); my ($ph,$ll,$sec1,$sec2,$pos); my ($index,$numb,$line,$cnt,$type,@kys); my ($lat,$lon,$heading,$rad); my ($dlat,$dlon,$pp,$gotnn); my $shown_file = 0; $cnt = 0; my %hash = (); my %htypes = (); $cnt = 0; foreach $rh (@{$rpa}) { $cnt++; ###my @kys = sort keys(%{$rh}); ### prt(join(" ",@kys)."\n"); ###foreach $key (@kys) { ### $val = ${$rh}{$key}; undef($index); undef($name); undef($numb); undef($type); undef($lat); undef($lon); undef($heading); undef($rad); $heading = ${$rh}{heading} if (defined ${$rh}{heading}); $lat = ${$rh}{lat} if (defined ${$rh}{lat}); $lon = ${$rh}{lon} if (defined ${$rh}{lon}); $rad = ${$rh}{radius} if (defined ${$rh}{radius}); $index = ${$rh}{index} if (defined ${$rh}{index}); $name = ${$rh}{name} if (defined ${$rh}{name}); $numb = ${$rh}{number} if (defined ${$rh}{number}); $type = ${$rh}{type} if (defined ${$rh}{type}); if (length($lat) && length($lon) && length($heading)) { if (dmlat2degs($lat,\$dlat) && dmlon2degs($lon,\$dlon)) { $rad = $def_rad if (!defined $rad); if (length($name) && length($numb)) { #next if ($name =~ /Startup\s+Location/); next if ($name =~ /Start/i); #push(@arr,"$name$numb"); $hash{"$name$numb"} = [$dlat, $dlon, $heading, $rad]; } elsif (length($name)) { next if ($name =~ /Start/i); $hash{"$name"} = [$dlat, $dlon, $heading, $rad]; } else { prt("Record $cnt does not have a 'name' or 'number'!\n"); } } $htypes{$type} = 1 if ($type); } else { $msg = ''; if (!$shown_file) { $msg .= "File: $file\n"; } $shown_file++; $msg .= "WARNING: Record $cnt does not have a 'lat', 'lon' and 'heading'!\n"; $tmp = ''; $tmp .= "name=$name " if ($name); $tmp .= "no=$numb " if ($numb); $tmp .= "lat=$lat " if ($lat); $tmp .= "lon=$lon " if ($lon); $tmp .= "hdg=$heading " if ($heading); $msg .= "$tmp\n" if (length($tmp)); prtw($msg); } } @arr = keys(%hash); $cnt = scalar @arr; $type = scalar keys(%htypes); $tmp = join(", ", sort keys(%htypes)); prt("Got $val 'Parking' hashes... $cnt with unque name/number, $type types, $tmp, excluding 'Startup...'\n"); if (VERB2()) { foreach $rh (@{$rpa}) { @kys = sort keys(%{$rh}); ### prt(join(" ",@kys)."\n"); $gotnn = 0; if (defined ${$rh}{name} && defined ${$rh}{number} ) { $pp = ${$rh}{name}.${$rh}{number}; #if ($pp ne "\"Startup Location\"") if (${$rh}{name} =~ /Startup\s+Location/i) { # skip these... } else { prt("--parkpos=$pp "); $gotnn = 1; } } foreach $key (@kys) { $val = ${$rh}{$key}; if (($key eq 'lat') || ($key eq 'lon')) { if ($val =~ /^([NSEW])(\d+)\s+(\d+)\.(\d+)$/) { $ph = $1; $ll = $2; $sec1 = $3; $sec2 = $4; $pos = $ll + ($sec1 / 60); # add in minutes $pos += ($sec2 / 1000) / 60; $pos = -$pos if (($ph eq 'W') || ($ph eq 'S')); $pos = sprintf("%.6f",$pos); prt("--$key=$pos "); #prt("$key=\"$val\" "); } else { prt("CHECK $key=\"$val\" "); } } elsif ($key eq 'pushBackRoute') { } elsif ($key eq 'airlineCodes') { } elsif (($key eq 'name')||($key eq 'number')) { if (VERB5() && !$gotnn) { prt("$key=\"$val\" "); } } elsif ($key eq 'heading') { $val = int($val + 0.5); $val = sprintf("%03u",$val); prt("--$key=$val "); } elsif (VERB5()) { prt("$key=\"$val\" "); } } prt("\n"); } } else { $line = ''; foreach $tmp (sort @arr) { $line .= "$tmp "; if (length($line) > 100) { prt("$line\n"); $line = ''; } } prt("$line\n") if (length($line)); } ${$rd} = 1; # signal DONE this ICAO return \%hash; } sub get_rectange($$$$$$) { my ($clat,$clon,$hdg,$rad,$name,$rb) = @_; my ($res); my ($lat1, $lon1, $az1); my ($lat2, $lon2, $az2); my $hrad = $rad / 2.0; my $rhdg = $hdg + 180.0; if ($rhdg >= 360.0) { $rhdg -= 360.0; } # // get tow ends using heading and reciprocal $res = fg_geo_direct_wgs_84( $clat, $clon, $hdg, $hrad, \$lat1, \$lon1, \$az1 ); $res = fg_geo_direct_wgs_84( $clat, $clon, $rhdg, $hrad, \$lat2, \$lon2, \$az2 ); #// setup heading to 'right' and 'left' my $hdg1 = $hdg + 90.0; if ($hdg1 >= 360.0) { $hdg1 -= 360.0; } my $hdg2 = $hdg - 90.0; if ($hdg2 < 0.0) { $hdg2 += 360.0; } my ($lata, $lona, $aza); my ($latb, $lonb, $azb); my ($latc, $lonc, $azc); my ($latd, $lond, $azd); #// generate the four corners $res = fg_geo_direct_wgs_84( $lat1, $lon1, $hdg1, $hrad, \$lata, \$lona, \$aza ); $res = fg_geo_direct_wgs_84( $lat1, $lon1, $hdg2, $hrad, \$latb, \$lonb, \$azb ); $res = fg_geo_direct_wgs_84( $lat2, $lon2, $hdg1, $hrad, \$latd, \$lond, \$azd ); $res = fg_geo_direct_wgs_84( $lat2, $lon2, $hdg2, $hrad, \$latc, \$lonc, \$azc ); #// fill out the boundary set_bounds( $rb, $lata, $lona ); set_bounds( $rb, $latb, $lonb ); set_bounds( $rb, $latc, $lonc ); set_bounds( $rb, $latd, $lond ); set_bounds( $rb, $lat1, $lon1 ); set_bounds( $rb, $lat2, $lon2 ); #// generate the Xgraph stream my $xg = ''; #// ******************************************************************* #// seems default precision is quite small - with very BAD results #xg << std::setprecision(def_precision); #// ******************************************************************* if ($name && $add_names && length($name)) { if ($at_head) { $xg .= "anno $lon1 $lat1"; } else { $xg .= "anno $clon $clat"; } $xg .= " $name"; if ($add_info) { $xg .= " r=$rad h=$hdg"; } $xg .= "\n"; } $xg .= "color $box_color\n"; $xg .= "$lona $lata\n"; $xg .= "$lonb $latb\n"; $xg .= "$lonc $latc\n"; $xg .= "$lond $latd\n"; $xg .= "$lona $lata\n"; $xg .= "NEXT\n"; $xg .= "color $hdg_color\n"; $xg .= "$lon1 $lat1\n"; $xg .= "$lon2 $lat2\n"; $xg .= "NEXT\n"; return $xg; } sub out_hash_2_xg($$$$) { my ($rh,$out,$xg2,$rba) = @_; my $xg = ''; my @arr = sort keys %{$rh}; my ($name,$ra,$lat,$lon,$hdg,$rad); #my @bounds = (); #init_bounds(\@bounds); foreach $name (@arr) { $ra = ${$rh}{$name}; $lat = ${$ra}[0]; $lon = ${$ra}[1]; $hdg = ${$ra}[2]; $rad = ${$ra}[3]; #$xg .= get_rectange($lat,$lon,$hdg,$rad,$name,\@bounds); $xg .= get_rectange($lat,$lon,$hdg,$rad,$name,$rba); } $xg = get_bounds($rba).$xg2.$xg; write2file($xg,$out); prt("Written hash to $out. Use pv.bat (PolyView2D) to view\n"); return $xg; } sub process_dirs() { # directories to search my @dirsall = (); if (-d $scenery) { push(@dirsall,$scenery); } if (-d $fgdata) { push(@dirsall,$fgdata); } if (-d $tsdata) { push(@dirsall,$tsdata); } ###my @dirs = ( $scenery ); my $icao = $in_icao; my ($dir,$rh,$cnt,$xg2); my %h = (); my %h2 = (); my %h3 = (); my $done = 0; foreach $dir (@dirsall) { if (-d $dir) { $h{$dir} = process_in_icao($icao,$dir,\$done); $h2{$dir} = $rsegxg; my @a = @gbounds; $h3{$dir} = \@a; last if ($done); } else { prt("Can NOT 'stat' dir $dir\n"); } } # compare the hashes collected my @arr = keys %h; $cnt = scalar @arr; prt("Got $cnt parkpos hashes...\n"); my ($key,$tmp,$rba); $cnt = 0; my $xg = ''; foreach $key (@arr) { $rh = $h{$key}; $xg2 = $h2{$key}; $rba = $h3{$key}; $cnt++; $xg_out = $temp_dir.$PATH_SEP."temp.$cnt.xg"; if ($cnt > 1) { # my $box_color = 'blue'; # my $hdg_color = 'white'; if ($cnt == 2) { $box_color = 'brown'; $hdg_color = 'yellow'; } else { $box_color = 'green'; $hdg_color = 'red'; } } $tmp = out_hash_2_xg($rh,$xg_out,$xg2,$rba); $xg .= "# dir $key\n"; $xg .= $tmp; } if ($cnt > 1) { $cnt++; $xg_out = $temp_dir.$PATH_SEP."temp.$cnt.xg"; write2file($xg,$xg_out); prt("Written all to $xg_out\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); process_dirs(); 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 =~ /^d/) { need_arg(@av); shift @av; $sarg = $av[0]; $scenery = $sarg; if (! -d $scenery) { pgm_exit(1,"ERROR: Can NOT locate $scenery!\n"); } prt("Set scenery path to [$scenery].\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_icao = $arg; prt("Set input to [$in_icao]\n") if (VERB1()); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_icao) == 0) { $in_icao = $def_icao; prt("Set DEFAULT input to [$in_icao]\n"); } } if (length($in_icao) == 0) { give_help(); pgm_exit(1,"ERROR: No input ICAO found in command!\n"); } } sub give_help { prt("\n"); prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] ICAO\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"); prt(" --data <path> (-d) = Set new data path. (def=$scenery)\n"); prt("\n"); prt("Aim: Given an ICAO, search for the file - \n"); prt(" ${scenery}${PATH_SEP}I${PATH_SEP}C${PATH_SEP}A${PATH_SEP}ICAO.groundnet.xml\n"); prt(" and if found, display contents.\n"); } # eof - groundnet.pl