Generated: Sat Oct 24 16:35:28 2020 from showscenery.pl 2020/05/24 24.1 KB. text copy
#!/usr/bin/perl -w # NAME: showscenery.pl # AIM: Give a FG sceenery directory, list available chunks, and airports ICAO.btg.gz file # 20/05/2020 - Review, and add several new features # 2016-11-25 - Initial cut use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::stat; use LWP::Simple; use Cwd; my $perl_dir = 'C:\GTools\perl'; my $DIR_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 = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2011-11-03"; my $load_log = 0; my $in_directory = ''; my $verbosity = 0; my $out_xml = ''; my $server = 'http://flightgear.sourceforge.net/scenery'; my $dirfile = '.dirindex'; my $no_chunk = 0; my $split_chunk = 0; my $root_file = $perl_dir.$DIR_SEP."temprootdi.txt"; my $xg_file = $perl_dir.$DIR_SEP."tempgrid.xg"; my @expected_dirs = qw( Airports Models Objects Terrain ); my @repo_dirs = qw( CVS .svn .git .hg ); my $debug_on = 0; my $def_file = 'X:\fgsvnts'; #my $def_file = 'C:\FG\30\terrasync'; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $bounding = ''; my $g_total_bytes = 0; my $g_total_files = 0; my $g_total_dirs = 0; my $g_total_air = 0; my $g_min_lon = 400; my $g_min_lat = 400; my $g_max_lat = -400; my $g_max_lon = -400; my $split_cnt = 0; sub reset_min_max() { $g_min_lon = 400; $g_min_lat = 400; $g_max_lat = -400; $g_max_lon = -400; } sub set_min_max($$) { my ($lon,$lat) = @_; $g_min_lon = $lon if ($lon < $g_min_lon); $g_min_lat = $lat if ($lat < $g_min_lat); $g_max_lon = $lon if ($lon > $g_max_lon); $g_max_lat = $lat if ($lat > $g_max_lat); } 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 get_xg_10x10_grid() { my $xg = "# World 10x10 grid\n"; $xg .= "color gray\n"; my ($x,$y); for ($x = -180; $x <= 180; $x += 10) { $xg .= "$x 90\n"; $xg .= "$x -90\n"; $xg .= "NEXT\n"; } for ($y = -90; $y <= 90; $y += 10) { $xg .= "-180 $y\n"; $xg .= "180 $y\n"; $xg .= "NEXT\n"; } return $xg; } sub is_in_expected($) { my $item = shift; my ($test); foreach $test (@expected_dirs) { return 1 if ($test eq $item); } return 0; } sub is_repo_dir($) { my $item = shift; my ($test); foreach $test (@repo_dirs) { return 1 if ($test eq $item); } return 0; } sub process_id_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 ($version,$idpath); my ($line,$inc,$lnn,$len,@arr,$key); $lnn = 0; my @idirs = (); my @ifiles = (); foreach $line (@lines) { chomp $line; $lnn++; $line = trim_all($line); $len = length($line); next if ($len == 0); next if ($line =~ /^\#/); @arr = split(':',$line); $len = scalar @arr; $key = $arr[0]; if ($key eq 'version') { if ($len > 1) { $version = $arr[1]; } else { pgm_exit(1,"Error:$lnn: File '$inf' has bad line!\n". "$line\n"); } } elsif ($key eq 'path') { $idpath = '.'; if ($len > 1) { $idpath = $arr[1]; } } elsif ($key eq 'd') { if ($len > 2) { push(@idirs, [$arr[1],$arr[2]] ); } else { pgm_exit(1,"Error:$lnn: File '$inf' has bad line!\n". "$line\n"); } } elsif ($key eq 'f') { if ($len > 3) { push(@ifiles, [$arr[1],$arr[2],$arr[3]] ); } else { pgm_exit(1,"Error:$lnn: File '$inf' has bad line!\n". "$line\n"); } } } my %h = (); if (defined $version && defined $idpath) { $h{version} = $version; $h{path} = $idpath; $h{files} = \@ifiles; $h{dirs} = \@idirs; } return \%h; } sub scan_model_folder($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($i,$ff,$item,$filecnt,$dircnt); my @dirs = (); $filecnt = 0; $dircnt = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; $ff = $func->($dir.$item); if (-f $ff) { $filecnt++; } elsif (-d $ff) { next if (is_repo_dir($item)); $dircnt++; push(@dirs,$ff); } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } } sub scan_airport_folder($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($i,$ff,$item,$filecnt,$dircnt); my @dirs = (); $filecnt = 0; $dircnt = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; $ff = $func->($dir.$item); if (-f $ff) { $filecnt++; } elsif (-d $ff) { next if (is_repo_dir($item)); $dircnt++; push(@dirs,$ff); } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } } sub process_each_degree($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($nm,$dr) = fileparse($dir); my ($i,$ff,$item,$filecnt,$dircnt,$degcnt); my @dirs = (); my @fils = (); $filecnt = 0; $dircnt = 0; $degcnt = 0; my $stgcnt = 0; my $btgcnt = 0; my $hashcnt = 0; my $aircnt = 0; my $tot_size = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); my ($ew,$lon,$ns,$lat); my $msg = ''; my $xg = "# Chunk/_1x1_/* files\n"; for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; next if ($item eq '.'); next if ($item eq '..'); $ff = $func->($dir.$item); my $sb = stat($ff); my $size = $sb->size; if (-f $ff) { # skip some files if ($item eq 'dirsizes.txt') { } elsif ($item =~ /\.old$/) { } elsif ($item =~ /\.bak$/) { } elsif ($item =~ /\.xg$/) { } elsif ($item =~ /\.stg$/) { $stgcnt++; } elsif ($item =~ /\.btg\.gz$/) { $btgcnt++; prt("BTG: $ff\n") if (VERB9()); my $n = $item; $n =~ s/\.btg\.gz$//; if (length($n) >= 6) { # is an INDEX.stg or .btg.gz } else { $aircnt++; $g_total_air++; prt("AIR: $ff\n") if (VERB5()); } } elsif ($item =~ /^\./) { $hashcnt++; } else { # what are these... $filecnt++; push(@fils,$ff); } $tot_size += $size; $g_total_bytes += $size; $g_total_files++; } elsif (-d $ff) { next if (is_repo_dir($item)); # At this depth, should NOT be any directories $dircnt++; prtw("Warning: Unparsed dir '$item'! $ff What is this?\n"); } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } # prt("Dir '$dir' contains degree $degcnt\n"); # prt("Degree '$nm' contains - hash $hashcnt, BTG $btgcnt, STG $stgcnt, others $filecnt\n"); $btgcnt = sprintf("%3d",$btgcnt); $stgcnt = sprintf("%3d",$stgcnt); $aircnt = sprintf("%3d",$aircnt); $tot_size = get_nn($tot_size); $tot_size = ' '.$tot_size while (length($tot_size) < 14); prt("Degree '$nm' - BTG $btgcnt, STG $stgcnt, hash $hashcnt, MISC $filecnt, total $tot_size bytes, AIR $aircnt.\n"); return $xg; } # process each TILE, within a CHUNK sub process_each_chunk($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($nm,$dr) = fileparse($dir); my ($i,$ff,$item,$filecnt,$dircnt,$degcnt); my @dirs = (); my @fils = (); $filecnt = 0; $dircnt = 0; $degcnt = 0; my $stgcnt = 0; my $btgcnt = 0; my $aircnt = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); my ($ew,$lon,$ns,$lat,$lat1,$lon1); my $msg = ''; my $xg = "# Chunk/Tiles $icnt\n"; $xg .= "color blue\n"; for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; next if ($item eq '.'); next if ($item eq '..'); $ff = $func->($dir.$item); if (-f $ff) { # skip some files if ($item eq 'dirsizes.txt') { } elsif ($item =~ /\.old$/) { } elsif ($item =~ /\.bak$/) { } elsif ($item =~ /\.xg$/) { } elsif ($item =~ /\.stg$/) { $stgcnt++; } elsif ($item =~ /\.btg\.gz$/) { $btgcnt++; } else { # what are these... $filecnt++; push(@fils,$ff); } } elsif (-d $ff) { next if (is_repo_dir($item)); $dircnt++; if ($item =~ /^(e|w){1}(\d{3})(n|s){1}(\d{2})$/) { $ew = $1; $lon = $2; $ns = $3; $lat = $4; $lon *= -1 if ($ew eq 'w'); $lat *= -1 if ($ns eq 's'); ### $xg .= "anno $lon $lat $item\n"; $lon1 = $lon + 1; $lat1 = $lat + 1; $xg .= "$lon $lat\n"; $xg .= "$lon1 $lat\n"; $xg .= "$lon1 $lat1\n"; $xg .= "$lon $lat1\n"; $xg .= "$lon $lat\n"; $xg .= "NEXT\n"; $degcnt++; $msg .= " $item"; push(@dirs,$ff); set_min_max($lon,$lat); set_min_max($lon1,$lat1); } else { prtw("Warning: Unparsed dir '$item'! What is this?\n"); } } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } $g_total_dirs += $degcnt; # prt("Dir '$dir' contains btg.gz $btgcnt, stg $stgcnt\n"); #prt("Chunk '$nm' contains $degcnt degree dirs.\n"); prt("Chunk '$nm' contains $degcnt 1x1 deg. dirs.\n"); foreach $dir (@dirs) { process_each_degree($dir); } return $xg; } sub scan_terrain_folder($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($i,$ff,$item,$filecnt,$dircnt,$chunkcnt,$ofile); my @dirs = (); my @fils = (); $filecnt = 0; $dircnt = 0; $chunkcnt = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); my ($ew,$lon,$ns,$lat,$lon1,$lat1); my $msg = ''; my $xg = "# Terrain Chunks\n"; $xg .= "color yellow\n"; for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; next if ($item eq '.'); next if ($item eq '..'); $ff = $func->($dir.$item); if (-f $ff) { # skip some files if ($item eq 'dirsizes.txt') { # only keeps size } elsif ($item =~ /\.old$/) { } elsif ($item =~ /\.bak$/) { } elsif ($item =~ /\.xg$/) { } else { # what are these... $filecnt++; push(@fils,$ff); } } elsif (-d $ff) { next if (is_repo_dir($item)); $dircnt++; if ($item =~ /^(e|w){1}(\d{3})(n|s){1}(\d{2})$/) { $ew = $1; $lon = $2; $ns = $3; $lat = $4; $lon *= -1 if ($ew eq 'w'); $lat *= -1 if ($ns eq 's'); ### $xg .= "anno $lon $lat $item\n"; if (!$no_chunk) { $lon1 = $lon + 10; $lat1 = $lat + 10; $xg .= "$lon $lat\n"; $xg .= "$lon1 $lat\n"; $xg .= "$lon1 $lat1\n"; $xg .= "$lon $lat1\n"; $xg .= "$lon $lat\n"; $xg .= "NEXT\n"; $lon1 = $lon + 5; $lat1 = $lat + 5; $xg .= "anno $lon1 $lat1 $item\n"; } if ($chunkcnt == 0) { $msg = "Terrain Chunks:"; } $chunkcnt++; $msg .= " $item"; if ($split_chunk) { $xg .= process_each_chunk($ff); # TILES, within a CHUNK $g_total_dirs++; $split_cnt++; $ofile = "$xg_file$split_cnt"; my ($n,$d) = fileparse($ofile); rename_2_old_bak($ofile); write2file($xg,$ofile); prt("Written xg file '$ofile'\n"); if ($g_min_lon != 400) { prt("$n:BBox: $g_min_lon,$g_min_lat,$g_max_lon,$g_max_lat\n"); $bounding .= "$n:BBox: $g_min_lon,$g_min_lat,$g_max_lon,$g_max_lat\n"; } reset_min_max(); $xg = ''; } else { push(@dirs,$ff); } } else { prtw("Warning: Unparsed dir '$item'! What is this?\n"); } } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } if (length($msg)) { prt("$msg ($chunkcnt), files $filecnt\n") if ($chunkcnt); if ($filecnt) { foreach $item (@fils) { prt("$item\n"); } } } $dircnt = scalar @dirs; $g_total_dirs += $dircnt; foreach $ff (@dirs) { $xg .= process_each_chunk($ff); # TILES, within a CHUNK } if ($g_total_files) { $msg = "Scanned ".get_nn($g_total_dirs)." dirs, "; $msg .= "found ".get_nn($g_total_files)." files, total ".get_nn($g_total_bytes)." bytes."; prt("$msg\n"); } return $xg; } sub scan_object_folder($) { my $dir = shift; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $icnt = scalar @files; my $func = \&path_u2d; my ($i,$ff,$item,$filecnt,$dircnt,$chunkcnt); my @dirs = (); $filecnt = 0; $dircnt = 0; $chunkcnt = 0; $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); my ($ew,$lon,$ns,$lat); my $msg = ''; for ($i = 0; $i < $icnt; $i++) { $item = $files[$i]; $ff = $func->($dir.$item); if (-f $ff) { $filecnt++; } elsif (-d $ff) { next if (is_repo_dir($item)); $dircnt++; if ($item =~ /^(e|w){1}(\d{3})(n|s){1}(\d{2})$/) { $ew = $1; $lon = $2; $ns = $3; $lat = $4; if ($chunkcnt == 0) { $msg = "Object Chunks:"; } $chunkcnt++; $msg .= " $item"; push(@dirs,$ff); } else { # what is this } } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } if (length($msg)) { prt("$msg ($chunkcnt)\n") if ($chunkcnt); } } sub process_in_dir($) { my $dir = shift; if (!opendir(DIR,$dir)) { pgm_exit(1,"ERROR: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my $fcnt = scalar @files; prt("Got $fcnt items from directory [$dir]\n"); my ($i,$item,$ff,$isok,$dcnt); my $func = \&path_u2d; my $filecnt = 0; my $dircnt = 0; my @dirs = (); $dir .= $DIR_SEP if (!($dir =~ /(\\|\/)$/)); for ($i = 0; $i < $fcnt; $i++) { $item = $files[$i]; next if (($item eq '.')||($item eq '..')); $ff = $func->($dir.$item); if (-f $ff) { $filecnt++; } elsif (-d $ff) { $dircnt++; next if (is_repo_dir($item)); $isok = is_in_expected($item); if ($isok) { push(@dirs,[$ff,$item]); } else { prt("Unknown directory item [$item]. Expected ".join("|",@expected_dirs)."\n"); } } else { prtw("WARNING: Skipping [$item] [$ff]! WHAT IS THIS?\n"); } } $dcnt = scalar @dirs; prt("Got $dircnt directories, $dcnt expected, $filecnt files...\n"); $g_total_dirs += $dcnt; my $txg = ''; for ($i = 0; $i < $dcnt; $i++) { $ff = $dirs[$i][0]; $item = $dirs[$i][1]; if ($item eq 'Models') { # what - count *.ac files scan_model_folder($ff); } elsif ($item eq 'Airports') { # count the ICAO.threshold.xml files scan_airport_folder($ff); } elsif ($item eq 'Terrain') { # show chunks available $txg .= scan_terrain_folder($ff); } elsif ($item eq 'Objects') { # also chunks scan_object_folder($ff); } else { prtw("WARNING: Uncased item [$item] [$ff]\n"); } } if (length($txg)) { my $xg = ''; #get_xg_10x10_grid(); $xg .= $txg; rename_2_old_bak($xg_file); write2file($xg,$xg_file); prt("Written xg file '$xg_file'\n"); } if ($g_min_lon != 400) { prt("BBox $g_min_lon,$g_min_lat,$g_max_lon,$g_max_lat\n"); } if (length($bounding)) { prt("Bounding boxes... foreach split chunks...\n"); prt($bounding); } } sub get_terrascene() { my ($url,$data); if (! -f $root_file) { $url = $server . '/' . $dirfile; # = '.dirindex'; $data = get($url); prt("$data\n"); write2file($data,$root_file); prt("Written to root '$root_file'..."); } if (! -f $root_file) { pgm_exit(1,"Error: Unable to create '$root_file'!\n"); } my $rh = process_id_file($root_file); if (! defined ${$rh}{version}) { pgm_exit(1,"Error: Unable to process '$root_file'!\n"); } my ($path,$rda,$rfa,$dc,$fc,$dir,$ra); $path = ${$rh}{path}; $rda = ${$rh}{dirs}; $rfa = ${$rh}{files}; $dc = scalar @{$rda}; $fc = scalar @{$rfa}; prt("Path '$path', dirs $dc, files $fc\n"); foreach $ra (@{$rda}) { $dir = ${$ra}[0]; $url = $server . '/' . $dir . '/' . $dirfile; # = '.dirindex'; prt("Fetch '$url'\n"); } pgm_exit(1,"TEMP EXIT"); } ######################################### ### MAIN ### parse_args(@ARGV); #get_terrascene(); process_in_dir($in_directory); pgm_exit(0,""); ######################################## sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-dir\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(" --xg <file> (-x) = Write xg output to this file. (def=$xg_file)\n"); prt(" --no-chunk (-n) = Do not add the CHUNK ouline. (def=$no_chunk)\n"); prt(" --split (-s) = Write each chunk to separate xg files. (def=$split_chunk)\n"); } 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/) { $load_log = 1; prt("Set to load log at end.\n") if (VERB1()); # } elsif ($sarg =~ /^o/) { # need_arg(@av); # shift @av; # $sarg = $av[0]; # $out_xml = $sarg; # prt("Set out file to [$out_xml].\n") if (VERB1()); } elsif ($sarg =~ /^x/) { need_arg(@av); shift @av; $sarg = $av[0]; $xg_file = $sarg; prt("Set xg out file to [$xg_file].\n") if (VERB1()); } elsif ($sarg =~ /^n/) { $no_chunk = 1; prt("Set no chunk outline in xg file.\n") if (VERB1()); } elsif ($sarg =~ /^s/) { $split_chunk = 1; prt("Split chunks to different xg files.\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { if (length($in_directory)) { pgm_exit(1,"Aleady have in dir '$in_directory'! What is this '$arg'?\n"); } $in_directory = $arg; prt("Set input to [$in_directory]\n"); } shift @av; } if ((length($in_directory) == 0) && $debug_on) { $in_directory = $def_file; } if (length($in_directory) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -d $in_directory) { pgm_exit(1,"ERROR: Unable to find directory [$in_directory]! Check name, location...\n"); } } # eof - showscenery.pl