Generated: Mon Aug 29 19:34:27 2016 from fgchkaircraft.pl 2016/08/20 47.1 KB. text copy
#!perl -w # NAME: fgchkaircraft.pl # AIM: Check 'data/Aircraft' folder for valid aircraft ... # 09/10/2014 - UGH: Excluded some because 'Only XML version 1.0 supported. Saw: '1.1'' # 17/03/2013 - Output to CSV, or json # 22/12/2012 - Output the MAXIMUM aircraft name # 25/06/2012 - Review, and UI improvements # 07/12/2008 - added 'status' # 11/7/2008 - geoff mclane - http://geoffair.net/fg use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use XML::Simple; use Data::Dumper; 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 'lib_xml.pl' or die "Unable to load 'lib_xml.pl' Check paths in \@INC...\n"; ### require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n"; ### require 'fgscanvc.pl' or die "Unable to load fgscanvc.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"; open_log($outfile); # user variables my $VERS = "0.0.4 2013-04-04"; ###$VERS = "0.0.3 2012-06-25"; my $load_log = 0; my $verbosity = 0; my $fg_root = ''; my $in_folder = ''; my @warnings = (); my $tempxml = $temp_dir.$PATH_SEP.'tempxml2.xml'; # =================================================== my $out_xml = $temp_dir.$PATH_SEP.'tempxml.xml'; my $out_csv = $temp_dir.$PATH_SEP.'tempcsv.csv'; my $out_json = $temp_dir.$PATH_SEP.'tempjson.json'; my $out_mods = $temp_dir.$PATH_SEP.'tempmods.txt'; my $out_sets = $temp_dir.$PATH_SEP.'tempsets.csv'; # =================================================== my $pretty_json = 1; my $input_air_text = 'C:\FG\17\air-list.txt'; my $out_air_xml = $temp_dir.$PATH_SEP.'tempair.xml'; my $out_air_csv = $temp_dir.$PATH_SEP.'tempair.csv'; my $out_air_json = $temp_dir.$PATH_SEP.'tempair.json'; # OPTIONS my $ord_byfdm = 0; my $ord_author = 0; my $ord_status = 0; my $add_model_file = 1; # DEBUG my $debug_on = 1; my $def_root = 'D:\FG\fgaddon'; ##my $def_root = 'C:\FG\fgdata'; ##my $def_file = $def_root.'\Aircraft\747-200\747-200-set.xml'; ##my $def_file = 'C:\FG\fgdata\Aircraft\AG-14\AG-14-set.xml'; my $def_dir = $def_root.$PATH_SEP.'Aircraft'; ###my $def_dir = 'C:\FG\fgdata-2.9.0\Aircraft'; my $dbg_cac01 = 0; # show information during processing ... my $dbg_cac02 = 1; # write a tempxml.txt file of all files processed my $dbg_cac03 = 1; # show FAILED folders my $dbg_cac04 = 0; # show warning, even when NO warnings my $dbg_cac05 = 0; # show entry and exit of stages # program variables my ($act_name,$act_dir); my %air_hash = (); # Cub-set.xml f104-set.xml excluded because they are XML 1.1 my %skip_files = ( 'SenecaII-panelonly-set.xml' => 1, 'Cub-set.xml' => 1, 'f104-set.xml' => 1, 'J3Cub-set.xml' => 1, 'NTPS-Eng-set.xml' => 1, 'Pterosaur-set.xml' => 1 ); ############################## ### SUB ONLY sub is_a_skip_file($) { my $fil = shift; if (defined $skip_files{$fil}) { $skip_files{$fil}++; return 1 } return 0; } sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings { my ($dbg) = shift; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } elsif ($dbg || $dbg_cac04) { prt("No warnings issued.\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; if ($tx =~ /\n$/) { prt($tx); $tx =~ s/\n$//; } else { prt("$tx\n"); } push(@warnings,$tx); } sub mycmp_decend_asc { if (${$a}[0] lt ${$b}[0]) { # prt( "+[".${$a}[0]."] lt [".${$b}[0]."]\n" ) if $verb3; return 1; } if (${$a}[0] gt ${$b}[0]) { # prt( "-[".${$a}[0]."] gt [".${$b}[0]."]\n" ) if $verb3; return -1; } # prt( "=[".${$a}[0]."] = [".${$b}[0]."]\n" ) if $verb3; return 0; } sub mycmp_ascend_asc { return -1 if (${$a}[0] lt ${$b}[0]); return 1 if (${$a}[0] gt ${$b}[0]); return 0; } sub mycmp_ascend_asc_nc { return -1 if (lc(${$a}[0]) lt lc(${$b}[0])); return 1 if (lc(${$a}[0]) gt lc(${$b}[0])); return 0; } sub mycmp_ascend_a5 { return -1 if (${$a}[5] lt ${$b}[5]); return 1 if (${$a}[5] gt ${$b}[5]); return 0; } sub mycmp_ascend_a4 { return -1 if (${$a}[4] lt ${$b}[4]); return 1 if (${$a}[4] gt ${$b}[4]); return 0; } sub mycmp_ascend_a3 { return -1 if (${$a}[3] lt ${$b}[3]); return 1 if (${$a}[3] gt ${$b}[3]); return 0; } # sort Aa - Zz sub mycmp_nocase { return 1 if (lc($a) gt lc($b)); return -1 if (lc($a) lt lc($b)); return 0; } ########################################## ### CSV format # Some 'rules' # 1: Trimmed text only # 2: Add double quotes only if string contains '"' or ',' chars # 3: If contains double quotes, then these are doubled sub get_csv($) { my $txt = shift; $txt = trim_all($txt); if (($txt =~ /,/)||($txt =~ /"/)) { my ($len,$ntxt,$c,$i); $len = length($txt); $ntxt = '"'; # open double quotes for ($i = 0; $i < $len; $i++) { $c = substr($txt,$i,1); $ntxt .= '"' if ($c eq '"'); # double up any double quotes $ntxt .= $c; # add character } $txt = $ntxt . '"'; # add close double quotes } return $txt; } ################################################ ### json format # Characters '"', '\', and '/' are escaped with '\' sub get_json($) { my $txt = shift; my $len = length($txt); my ($i,$ch); my $json = ''; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); $json .= "\\" if (($ch eq '"')||($ch eq "\\")||($ch eq '/')) ; $json .= $ch; } return $json; } ################################################ ### xml format # Characters '"', '\', and '/' are escaped with '\' sub get_xml($) { my $txt = shift; my $len = length($txt); my ($i,$ch); my $xml = ''; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); $xml .= "\\" if (($ch eq '"')||($ch eq "\\")||($ch eq '/')) ; $xml .= $ch; } return $xml; } sub get_model_file($); sub get_model_file($) { my ($inf) = @_; prt("Processing [$inf]...\n") if (VERB9()); if (! -f $inf) { prtw("WARNING: Can NOT locate [$inf]!\n"); return; } my $xml = XMLin($inf); my ($ff,$sim,$mod,$tmp); my ($name,$dir) = fileparse($inf); ut_fix_directory(\$dir); my $rt = ref($xml); my $path = ''; if ($rt eq 'HASH') { if (defined ${$xml}{'sim'}) { $sim = ${$xml}{'sim'}; $rt = ref($sim); if ($rt eq 'HASH') { if (defined ${$sim}{'model'}) { $mod = ${$sim}{'model'}; $rt = ref($mod); if ($rt eq 'HASH') { if (defined ${$mod}{'path'}) { $path = ${$mod}{'path'}; $rt = ref($path); if ($rt eq 'HASH') { $path = ''; } elsif ($rt eq 'ARRAY') { $path = ''; } } } elsif ($rt eq 'ARRAY') { foreach $tmp (@{$mod}) { $rt = ref($tmp); if ($rt eq 'HASH') { if (defined ${$tmp}{'path'}) { $path = ${$tmp}{'path'}; $rt = ref($path); if ($rt eq 'HASH') { $path = ''; } elsif ($rt eq 'ARRAY') { $path = ''; } else { last; } } } } } else { prt("\$mod = \${\$xml}{'sim'}{'model'}; NOT a HASH/ARRAY! got [$rt]\n"); } } elsif (defined ${$xml}{'include'}) { my $inc = ${$xml}{'include'}; prt("Got an include file [$inc]\n") if (VERB9()); $rt = ref($inc); if ($rt eq '') { $ff = $fg_root.$PATH_SEP.$inc; $ff = $dir.$inc; if (-f $ff) { return get_model_file($ff); } if (-f $ff) { return get_model_file($ff); } } else { prt("Found 'include' as [$rt]\n") if (VERB9()); } #} else { # prt("\$sim = \${\$xml}{'sim'}{'model'}; NOT defined\n"); } prt("\${\$xml}{'sim'}{'model'} nor {'include'}; NOT defined\n") if (length($path) == 0); } else { prt("\$sim = \${\$xml}{'sim'}; NOT a HASH! got $rt\n"); } } else { prt("Failed to find 'sim' in the HASH ref from $inf!\n"); } } else { prt("Failed to get a HASH ref from $inf! got $rt\n"); } #if (defined ${$xml}{'sim'}{'model'}{'path'}) { # my $path = ${$xml}{'sim'}{'model'}{'path'}; if (length($path)) { $ff = $fg_root.$PATH_SEP.$path; if (-f $ff) { my ($n2,$d2,$e2) = fileparse($ff, qr/\.[^.]*/); ut_fix_directory(\$d2); if ($e2 eq '.ac') { prt("Got MODEL .ac file $ff\n") if (VERB9()); ###system("ac3dview $ff"); return $ff; } else { prt("Loading MODEL XML $ff\n") if (VERB9()); my $xml2 = XMLin($ff); if (defined ${$xml2}{'path'}) { my $path2 = ${$xml2}{'path'}; my $ff2 = $d2.$path2; ut_fix_rpath_per_os(\$ff2); if (-f $ff2) { prt("Got MODEL .ac file $ff2\n") if (VERB9()); return $ff2; } else { prt("Failed to find 'path' in $ff\n"); } } else { prt("Failed to find 'path' in $ff\n"); } } } else { prt("Failed to find model file $ff\n"); } } else { prt("Failed to find \${\$xml}{'sim'}{'model'}{'path'}) in $inf!\n"); } return ""; } # Output of the HASH reference in various forms sub show_hash_ref { my ($hr) = shift; my ($key, $val, $itm, $msg, $max, $i, $len, $maxname, $csv,$json,$indent); my ($n1,$d1,$n2,$d2,$i2,$rate); my $maxlen = 10; my $desc = ''; my $auth = ''; my $fdm = ''; my $dir = ''; my $txt = ''; my $stat = ''; my $ord = ''; my $mfil = ''; my $mxline = 75; my $mxfdm = 7; if ($ord_byfdm) { $ord = "FDM"; # @oks = sort mycmp_ascend_a4 @ok; } elsif ($ord_author) { $ord = "AUTHOR"; #@oks = sort mycmp_ascend_a3 @ok; } elsif ($ord_status) { $ord = "STATUS"; #@oks = sort mycmp_ascend_a5 @ok; } else { $ord = "Alphabetic"; #@oks = sort mycmp_ascend_asc_nc @ok; } $maxname = ''; $key = 'OK'; if (defined $$hr{$key}) { $val = $$hr{$key}; $max = scalar @{$val}; for ($i = 0; $i < $max; $i++) { $itm = $$val[$i][0]; $fdm = $$val[$i][4]; $len = length($itm); if ($len > $maxlen) { $maxlen = $len; $maxname = $itm; } $mxfdm = length($fdm) if (length($fdm) > $mxfdm); } } # 14bis , fdm=<def.> , <unknown>, desc=14bis Santos DUMONT, auth=Emmanuel BARANGER (3D), dir=C:\FG\fgdata\Aircraft\14bis\14bis-set.xml # 757-200,fdm=yasim, alpha, desc=Boeing 757-200, auth=Liam Gathercole (3d), Skyop (FDM, instruments, systems, etc.), Isais Prestes (3d cockpit shell), # dir=C:\FG\fgdata\Aircraft\757-200\757-200-set.xml $csv = "aero,status,rating,fdm,description,authors,set_file"; $csv .= ",model_file" if ($add_model_file); $csv .= "\n"; $json = '{"success":true,"generator":"'.$pgmname.'","updated":"'.lu_get_YYYYMMDD_hhmmss_UTC(time()).' UTC",'."\n"; $json .= '"aircraft":['."\n"; $indent = ' '; my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; my %mod_dupes = (); my $new_line = 1; foreach $key (keys %{$hr}) { $msg = ''; $val = $$hr{$key}; $max = scalar @{$val}; $desc = ''; $txt = ''; prt( "\n$key aircraft = $max, ordered by $ord\n" ); $xml .= "<air_list count=\"".$max."\">\n"; for ($i = 0; $i < $max; $i++) { $i2 = $i + 1; # 0 1 2 3 4 5 6 7 8 #push(@failed, [$fl, $fl, $desc, $auth, $fdm, $status, $rating, \@includes, $model_file]); #push(@failed, [$fl, $fl, "", "", "", "", ""]); $itm = trim_all($$val[$i][0]); $dir = trim_all($$val[$i][1]); $desc = trim_all($$val[$i][2]); $auth = trim_all($$val[$i][3]); $fdm = trim_all($$val[$i][4]); $stat = trim_all($$val[$i][5]); $mfil = ${$val}[$i][8]; if ($key eq 'OK') { $mod_dupes{$mfil} = 1 if (length($mfil)); $rate = trim_all($$val[$i][6]); $csv .= get_csv($itm).','; $csv .= get_csv($stat).','; $csv .= get_csv($rate).','; $csv .= get_csv($fdm).','; $csv .= get_csv($desc).','; $csv .= get_csv($auth).','; ($n1,$d1) = fileparse($dir); $d1 =~ s/(\\|\/)$//; ($n2,$d2) = fileparse($d1); $d2 = $n2.'/'.$n1; ut_fix_rpath_per_os(\$d2); $csv .= get_csv($d2); $csv .= ','.get_csv($mfil) if ($add_model_file); $csv .= "\n"; if ($pretty_json) { $json .= $indent.'{'."\n"; $json .= $indent.'"aero":"'.get_json($itm).'"'; if (length($stat)) { $json .= ','; $json .= "\n"; $json .= $indent.'"status":"'.get_json($stat).'"'; } if (length($rate)) { $json .= ','; $json .= "\n"; $json .= $indent.'"rating":"'.get_json($rate).'"'; } if (length($fdm)) { $json .= ','; $json .= "\n"; $json .= $indent.'"fdm":"'.get_json($fdm).'"'; } if (length($desc)) { $json .= ','; $json .= "\n"; $json .= $indent.'"desc":"'.get_json($desc).'"'; } if (length($auth)) { $json .= ','; $json .= "\n"; $json .= $indent.'"authors":"'.get_json($auth).'"'; } if (length($d2)) { $json .= ','; $json .= "\n"; $json .= $indent.'"file":"'.get_json($d2).'"'; } if ($add_model_file && length($mfil)) { $json .= ','; $json .= "\n"; $json .= $indent.'"model":"'.get_json($mfil).'"'; } $json .= "\n"; $json .= $indent.'}'."\n"; $json .= $indent.',' if ($i2 < $max); $json .= "\n"; } else { $json .= '{"aero":"'.get_json($itm).'"'; $json .= ',"status":"'.get_json($stat).'"' if (length($stat)); $json .= ',"rating":"'.get_json($rate).'"' if (length($rate)); $json .= ',"fdm":"'.get_json($fdm).'"' if (length($fdm)); $json .= ',"desc":"'.get_json($desc).'"' if (length($desc)); $json .= ',"authors":"'.get_json($auth).'"' if (length($auth)); $json .= ',"file":"'.get_json($d2).'"' if (length($d2)); $json .= ',"model":"'.get_json($mfil).'"' if (length($mfil) && $add_model_file); $json .= '}'; $json .= ',' if ($i2 < $max); $json .= "\n" if ($new_line); } # build XML $xml .= "<aircraft"; $xml .= ' aero="'.get_xml($itm).'"'; $xml .= ' status="'.get_xml($stat).'"' if (length($stat)); $xml .= ' rating="'.get_xml($rate).'"' if (length($rate)); $xml .= ' fdm="'.get_xml($fdm).'"' if (length($fdm)); $xml .= ' desc="'.get_xml($desc).'"' if (length($desc)); $xml .= ' authors="'.get_xml($auth).'"' if (length($auth)); $xml .= ' file="'.get_xml($d2).'"' if (length($d2)); $xml .= ' model="'.get_xml($mfil).'"' if (length($mfil) && $add_model_file); $xml .= "/>\n"; # just for DISPLAY ONLY $dir = '<same>' if ($itm eq $dir); $itm .= ' ' while (length($itm) < $maxlen); $desc = '<none>' if (length($desc) == 0); $auth = '<unknown>' if (length($auth) == 0); $fdm = '<def.>' if (length($fdm) == 0); $fdm .= ' ' while (length($fdm) < $mxfdm); $stat = '<unknown>' if (length($stat) == 0); prt("$itm , fdm=$fdm , $stat, desc=$desc, auth=$auth, dir=$dir\n"); } else { $txt .= ', ' if length($txt); $txt .= "[$itm]"; if (length($txt) > $mxline) { $msg .= "$txt\n"; $txt = ''; } } } $xml .= "</air_list>\n"; if ($key eq 'FAILED') { if ($dbg_cac03) { $msg .= $txt if length($txt); prt( "No Aircraft/folder/<aircraft>-set.xml file found in ...\n" ); prt( "$msg\n" ); } } prt( "$key listed $max by $ord\n" ); } $json .= "]}\n"; prt("Maximum arcraft name length is $maxlen for [$maxname]\n"); my @arr = sort mycmp_nocase keys( %mod_dupes ); my $mods = ''; foreach $mfil (@arr) { $mods .= "$mfil\n"; } if (length($mods)) { write2file($mods,$out_mods); prt("MODELS found written to [$out_mods]\n"); } write2file($xml,$out_xml); prt("XML output written to [$out_xml]\n"); write2file($csv,$out_csv); prt("CSV output written to [$out_csv]\n"); write2file($json,$out_json); prt("JSON output written to [$out_json]\n"); } ############################################################# ### Process ONE folder seeking - # (a) sub-directories to recursively process that folder # (b) find '*-set.xml' files, and # 1: push the 'air' part of (air)-set.xml to @{$aircraft} # 2: push the full path to the file to @{$setfil} # ============================================================ sub process_folder($$$$) { my ($ff, $setfiles, $aircraft, $lev) = @_; my ($df, $setfil, $air, @dfiles); my @dirs = (); if ( opendir( DIR, $ff) ) { @dfiles = readdir(DIR); close DIR; foreach $df (@dfiles) { next if (($df eq '.') || ($df eq '..')); next if ($df eq 'CVS'); next if ($df eq '.svn'); next if (is_a_skip_file($df)); $setfil = $ff . "\\" . $df; if (-d $setfil) { # skip directories, OR push(@dirs,$setfil); } elsif ($lev == 0) { if ($df =~ /^(.+)-set.xml$/) { $air = $1; # got an <aircraft>-set.xml file push(@$aircraft,$air); push(@$setfiles,$setfil); } } } } foreach $ff (@dirs) { process_folder( $ff, $setfiles, $aircraft, $lev + 1 ); } } # expect like # <rating> # <FDM type="int">3</FDM> # <systems type="int">3</systems> # <cockpit type="int">4</cockpit> # <model type="int">4</model> # </rating> # probably SHOULD check the ORDER, but for now.... sub get_rate_num($) { my $txt = shift; $txt = trim_all($txt); if ($txt =~ /</) { return ''; } return $txt; } ################################################################ ### process an XML set file ################################################################ sub process_set_file($$$) { my ($setfil,$rok,$air) = @_; my $desc = ''; my $auth = ''; my $fdm = ''; my $status = ''; my %lnmap = (); my ($lnnum, $xln, @attribs, %atthash, $tag); my ($inc,$ff); my %hash = (); ($act_name,$act_dir) = fileparse($setfil); $air = $act_name; $air =~ s/-set.xml$//; prt("Processing $setfil file...\n") if (VERB1()); my $rating = ''; my @includes = (); my $model_file = ''; if (open INF, "<$setfil") { my @lines = <INF>; close INF; my $xlncnt = scalar @lines; @lines = xml_array_to_lines(\%lnmap, @lines); # this re-lines the array my $lncnt = scalar @lines; if ($dbg_cac02) { # this is really ONLY FOR DEBUG append2file( "\n<!-- FILE: $setfil, $lncnt lines -->\n",$tempxml ); append2file( join("\n",@lines),$tempxml ); append2file( "\n",$tempxml ); prt("Written $lncnt xml lines to [$tempxml]\n") if (VERB9()); } my $inpl = 0; my $insim = 0; my $indesc = 0; my $inauth = 0; my $infdm = 0; my $instatus = 0; my $lnnum = 0; my $inrating = 0; my $inmodel = 0; my $inpath = 0; my $modfile = ''; my $inident = 0; my ($line); $model_file = get_model_file($setfil) if ($add_model_file); # process an XML file, line by line foreach $line (@lines) { $lnnum++; $xln = $lnmap{$lnnum}; @attribs = space_split($line); # split on 'space', but honour quoted text $tag = $attribs[0]; prt("$xln: tag [$tag] line [$line]\n") if ($dbg_cac05); if ($tag && length($tag)) { if ($inpl) { if ($tag =~ /^<\/PropertyList/) { $inpl = 0; } elsif ($insim) { if ($indesc) { if ($tag =~ /^<\/description>/) { $indesc = 0; prt("$xln: End description\n") if ($dbg_cac05); } else { $desc .= ' ' if length($desc); $desc .= $line; } } elsif ($inauth) { if ($tag =~ /^<\/author>/) { $inauth = 0; } else { $auth .= ' ' if length($auth); $auth .= $line; } } elsif ($infdm) { if ($tag =~ /^<\/flight-model>/) { $infdm = 0; } else { $fdm .= ' ' if length($fdm); $fdm .= $line; } } elsif ($instatus) { if ($tag =~ /^<\/status>/) { $instatus = 0; } else { $status .= ' ' if length($status); $status .= $line; } } elsif ($inrating) { if ($tag =~ /^<\/rating>/) { $inrating = 0; } else { $rating .= get_rate_num($line); } } else { if ($tag =~ /^<\/sim>/) { $insim = 0; prt("$xln: End sim\n") if ($dbg_cac05); } elsif ($tag =~ /^<description>/) { $indesc = 1; prt("$xln: Bgn description\n") if ($dbg_cac05); } elsif ($tag =~ /^<author>/) { $inauth = 1; } elsif ($tag =~ /^<flight-model>/) { $infdm = 1; } elsif ($tag =~ /^<status>/) { $instatus = 1; } elsif ($tag =~ /^<rating>/) { $inrating = 1; } } } elsif (($tag =~ /^<sim>/)||($tag =~ /^<sim\b/)) { $insim = 1; prt("$xln: Bgn sim\n") if ($dbg_cac05); } elsif (($tag =~ /^<ident>/)||($tag =~ /^<ident\b/)) { $inident = 1; } elsif ($inident) { if ($tag =~ /^<\/ident>/) { $inident = 0; } } elsif (($tag =~ /^<model>/)||($tag =~ /^<model\b/)) { $inmodel = 1; prt("$xln: Bgn model [$act_name]\n"); # if ($dbg_cac05); } elsif ($inmodel) { if ($inpath) { if ($tag =~ /^<\/path>/) { $inpath = 0; prt("$xln: End path [$act_name]\n"); # if ($dbg_cac05); } else { $modfile = $tag; prt("$xln: Model file $modfile\n"); # if ($dbg_cac05); } } elsif ($tag =~ /^<path>/) { $inpath = 1; prt("$xln: Bgn path [$act_name]\n"); # if ($dbg_cac05); } elsif ($tag =~ /^<\/model>/) { prt("$xln: End model [$act_name]\n"); # if ($dbg_cac05); $inmodel = 0; } } } elsif ($tag =~ /^<PropertyList/) { %atthash = array_2_hash_on_equals(@attribs); $inpl = 1; prt("$xln: Bgn PropertyList\n") if ($dbg_cac05); if (defined $atthash{'include'}) { $inc = strip_quotes($atthash{'include'}); $ff = $act_dir.$inc; if (-f $ff) { push(@includes,$ff); } else { prtw("WARNING: Can NOT locate INCLUDE file [$inc] [$ff]\n"); } } } elsif ($tag =~ /^<model/) { } } } } else { prtw( "WARNING: Failed to open $setfil ...\n" ); } # note the $air may NOT be the ACTUAL directory name # 0 1 2 3 4 5 6 7 8 push(@{$rok}, [$air, $setfil, $desc, $auth, $fdm, $status, $rating, \@includes, $model_file]); ###$hash{'OK'} = [@oks]; $hash{'OK'} = $rok; return %hash; } ################################################# ### Process an INPUT fg aircraft folder ### Collect the SET files for post processing ################################################# sub process_aircraft_folder { my ($inf) = shift; my @ok = (); my @failed = (); my %hash = (); my (@dfiles, $df); my (@setfiles, @aircraft, $i, $setcnt); prt( "Processing $inf folder ...\n" ); write2file( "Processing $inf folder ...\n",$tempxml ) if ($dbg_cac02); my $dotcnt = 0; my $mxdots = 70; my ($fl,$ff,$air,$setfil); @setfiles = (); @aircraft = (); $setcnt = 0; if ( opendir( DIR, $inf ) ) { my @files = readdir(DIR); closedir DIR; # maybe get all the ???-set.xml files ... # ==================================== foreach $fl (@files) { next if (($fl eq '.') || ($fl eq '..')); next if ($fl eq 'CVS'); next if ($fl eq '.svn'); $ff = $inf . "\\" . $fl; $setcnt = 0; $air = $fl; if (-d $ff) { # maybe the FOLDER contains ???-set.xml file(s) ... my @arr = (); process_folder( $ff, \@arr, \@aircraft, 0 ); $setcnt = scalar @arr; if ($setcnt) { push(@setfiles,@arr); if ($dbg_cac01) { prt( "$fl = ok\n" ); } else { prt( '.' ); $dotcnt++; if ($dotcnt > $mxdots) { prt("\n"); $dotcnt = 0; } } } else { prt( "$fl = NOT FOUND $setfil\n" ) if ($dbg_cac01); # 0 1 2 3 4 5 6 #push(@failed, [$fl, $fl, $desc, $auth, $fdm, $status, $rating]); push(@failed, [$fl, $fl, "", "", "", "", ""]); } } } prt("\n") if (!$dbg_cac01 && $dotcnt); } else { pgm_exit(1, "ERROR: Unable to open $inf ...\n" ); } $setcnt = scalar @setfiles; my $list = "air,setfile\n"; for ($i = 0; $i < $setcnt; $i++) { $air = $aircraft[$i]; $setfil = $setfiles[$i]; $list .= "$air,$setfil\n"; } write2file($list,$out_sets); prt("Begin processing $setcnt *-set.xml files... list $out_sets\n"); ###pgm_exit(1,"TEMP EXIT\n"); for ($i = 0; $i < $setcnt; $i++) { $air = $aircraft[$i]; $setfil = $setfiles[$i]; process_set_file($setfil,\@ok,$air); } $hash{'FAILED'} = [ @failed ]; my @oks = (); if ($ord_byfdm) { @oks = sort mycmp_ascend_a4 @ok; } elsif ($ord_author) { @oks = sort mycmp_ascend_a3 @ok; } elsif ($ord_status) { @oks = sort mycmp_ascend_a5 @ok; } else { # default alphabetic @oks = sort mycmp_ascend_asc_nc @ok; } $hash{'OK'} = [ @oks ]; return %hash; } ################################################ ### Process the SET file as soon as it is FOUND sub process_aircraft_folder_OK { my ($inf) = shift; my @ok = (); my @failed = (); my %hash = (); my (@dfiles, $df); my (@setfiles, @aircraft, $i, $setcnt); prt( "Processing $inf folder ...\n" ); write2file( "Processing $inf folder ...\n",$tempxml ) if ($dbg_cac02); my $dotcnt = 0; my $mxdots = 70; my ($fl,$ff,$air,$setfil); if ( opendir( DIR, $inf ) ) { my @files = readdir(DIR); closedir DIR; # maybe get all the ???-set.xml files ... # ==================================== foreach $fl (@files) { next if (($fl eq '.') || ($fl eq '..')); next if ($fl eq 'CVS'); $ff = $inf . "\\" . $fl; $setcnt = 0; $air = $fl; if (-d $ff) { # maybe the FOLDER contains ???-set.xml file(s) ... @setfiles = (); @aircraft = (); $setcnt = 0; process_folder( $ff, \@setfiles, \@aircraft, 0 ); $setcnt = scalar @setfiles; if ($setcnt) { ### prt("Begin processing $setcnt *-set.xml files...\n"); if ($dbg_cac01) { prt( "$fl = ok\n" ); } else { prt( '.' ); $dotcnt++; if ($dotcnt > $mxdots) { prt("\n"); $dotcnt = 0; } } for ($i = 0; $i < $setcnt; $i++) { $air = $aircraft[$i]; $setfil = $setfiles[$i]; process_set_file($setfil,\@ok,$air); } } else { prt( "$fl = NOT FOUND $setfil\n" ) if ($dbg_cac01); # 0 1 2 3 4 5 6 #push(@failed, [$fl, $fl, $desc, $auth, $fdm, $status, $rating]); push(@failed, [$fl, $fl, "", "", "", "", ""]); } } } prt("\n") if (!$dbg_cac01 && $dotcnt); } else { prtw( "ERROR: Unable to open $inf ...\n" ); } $hash{'FAILED'} = [ @failed ]; my @oks = (); if ($ord_byfdm) { @oks = sort mycmp_ascend_a4 @ok; } elsif ($ord_author) { @oks = sort mycmp_ascend_a3 @ok; } elsif ($ord_status) { @oks = sort mycmp_ascend_a5 @ok; } else { # default alphabetic @oks = sort mycmp_ascend_asc_nc @ok; } $hash{'OK'} = [ @oks ]; return %hash; } sub mycmp_decend { return -1 if (lc($a) lt lc($b)); return 1 if (lc($a) gt lc($b)); return 0; } #sub mycmp_decend { # return 1 if (lc(${$a}[0]) lt lc(${$b}[0])); # return -1 if (lc(${$a}[0]) gt lc(${$b}[0])); # return 0; #} sub show_air_hash($) { my $rh = shift; my @arr = keys %{$rh}; my ($model,$val,$cnt,$acnt,$min,$len,$msg); @arr = sort mycmp_decend @arr; $min = 0; foreach $model (@arr) { $len = length($model); $min = $len if ($len > $min); } $cnt = 0; # foreach $model (sort keys %air_hash) { my ($desc,$type,$size,$rate,$lnn,$max); # stats my $not_done = 0; my $not_rated = 0; my $no_rating = 0; my %hsize = (); my %htype = (); my %hrate = (); my $json = '{"success":true,"source":"'; $json .= $pgmname; $json .= '","last_updated":"'; $json .= lu_get_YYYYMMDD_hhmmss_UTC(time()); $json .= ' UTC","aircraft":['; $json .= "\n"; $max = scalar @arr; $cnt = 0; my $xml = '<?xml version="1.0" encoding="UTF-8"?>'."\n"; $xml .= '<air_list count="'.$max.'">'."\n"; my $csv = "model,desc,type,size,rating\n"; foreach $model (@arr) { $cnt++; $acnt = sprintf("%3d",$cnt); # $air_hash{$model} = # 0 1 2 3 # [$desc,$type,$size,$rate,$lnn,0,0]; $val = ${$rh}{$model}; $desc = ${$val}[0]; $type = ${$val}[1]; $size = ${$val}[2]; $rate = ${$val}[3]; $msg = ''; $json .= '{"model":"'.$model.'"'; $json .= ',"desc":"'.get_json($desc).'"'; $json .= ',"type":"'.get_json($type).'"' if (length($type)); $json .= ',"size":"'.get_json($size).'"' if (length($size)); $json .= ',"rating":"'.get_json($rate).'"' if (length($rate)); $json .= "}"; $json .= "," if ($cnt < $max); $json .= "\n"; $xml .= '<aircraft model="'.$model.'"'; $xml .= ' desc="'.get_xml($desc).'"'; $xml .= ' type="'.get_xml($type).'"' if (length($type)); $xml .= ' size="'.get_xml($size).'"' if (length($size)); $xml .= ' rating="'.get_xml($rate).'"' if (length($rate)); $xml .= "/>\n"; $csv .= $model.','.get_csv($desc).','.get_csv($type).','.get_csv($size).','.get_csv($rate)."\n"; if (length($type) && length($size)) { if (defined $htype{$type}) { $htype{$type}++; } else { $htype{$type} = 1; } if (defined $hsize{$size}) { $hsize{$size}++; } else { $hsize{$size} = 1; } if (length($rate)) { if (defined $hrate{$rate}) { $hrate{$rate}++; } else { $hrate{$rate} = 1; } } else { $msg = " NO RATING"; $no_rating++; } } else { $not_done++; $msg = " NOT DONE"; } # ===== output ===== $model .= ' ' while (length($model) < $min); prt("$acnt: $model: ".join(",",@{$val})."$msg\n") if (VERB5()); } prt("Processed $cnt models... $not_done not dones, $no_rating no rating\n"); @arr = sort keys(%htype); $len = scalar @arr; prt("Used $len 'types'...\n"); prt(join(", ",@arr)."\n"); @arr = sort keys(%hsize); $len = scalar @arr; prt("Used $len 'sizes'...\n"); prt(join(", ",@arr)."\n"); if (defined $hrate{'NR'}) { $len = $hrate{'NR'}; prt("Found $len aircraft NOT rated\n"); } $json .= "]}\n"; if (length($out_air_json)) { write2file($json,$out_air_json); prt("Written JSON to [$out_air_json]\n"); } $xml .= '</air_list>'."\n"; if (length($out_air_xml)) { write2file($xml,$out_air_xml); prt("Written XML to [$out_air_xml]\n"); } if (length($out_air_csv)) { write2file($csv,$out_air_csv); prt("Written CSV to [$out_air_csv]\n"); } } # ; 4| 33| 93| 105| 115|FDM/Sys/Cock/Mod my $column1 = 4; my $column2 = 93; my $column3 = 105; my $column4 = 115; sub load_input_air_text() { if (length($input_air_text) == 0) { prtw("WARNING: No input air-text file given!\n"); return; } if (! open(INP, "<$input_air_text") ) { prtw("WARNING: Unable to open input air-text file [$input_air_text]!\n"); return; } my @lines = <INP>; close INP; my $lncnt = scalar @lines; prt("Processing $lncnt lines from [$input_air_text]...\n"); my ($line,$len,$lnn,$ch,$pc,$off,$noff,$len2); my ($model,$desc,$type,$size,$rate,$modcnt,$rpts,$val); $lnn = 0; my $off1 = 4; my $off2 = 33; my $off3 = 93; my $off4 = 105; my $off5 = 114; $modcnt = 0; $rpts = 0; foreach $line (@lines) { $lnn++; chomp $line; $len = length($line); next if ($len == 0); next if ($line =~ /^\s+$/); next if ($line =~ /^;/); $model = ''; $desc = ''; $type = ''; $size = ''; $rate = ''; $off = 4; $noff = 33; if ($len > 4) { $pc = substr($line,2,1); $ch = substr($line,3,1); if ($pc =~ /^\s+$/) { if ($ch =~ /^\s+$/) { prtw("$lnn: FAILED 3=sp [$line]\n"); } else { # valid begin... } } else { prtw("$lnn: FAILED 2=$pc [$line]\n"); } $len2 = $len > $off2 ? $off2 - $off1 - 1 : $len - $off1 + 1; $model = trim_all(substr($line,$off-1,$len2)); } $off = 33; $noff = 93; if ($len > 33) { $pc = substr($line,33-2,1); $ch = substr($line,33-1,1); if ($pc =~ /^\s+$/) { if ($ch =~ /^\s+$/) { prtw("$lnn: FAILED 32=sp [$line]\n"); } else { # valid begin... } } else { prtw("$lnn: FAILED 31=$pc [$line]\n"); } $len2 = $len > $off3 ? $off3 - $off2 - 1 : $len - $off2 + 1; $desc = trim_all(substr($line,$off-1,$len2)); } $off = 93; $noff = 105; if ($len > 93) { $pc = substr($line,93-2,1); $ch = substr($line,93-1,1); #--------------------------- if ($pc =~ /^\s+$/) { if ($ch =~ /^\s+$/) { prtw("$lnn: FAILED 92=sp [$line]\n"); } else { # valid begin... } } else { prtw("$lnn: FAILED 91=$pc [$line]\n"); } #--------------------------- $len2 = $len > $off4 ? $off4 - $off3 - 1 : $len - $off3 + 1; $type = trim_all(substr($line,$off-1,$len2)); } $off = 105; $noff = 114; if ($len > 105) { $pc = substr($line,105-2,1); $ch = substr($line,105-1,1); # ============================ if ($pc =~ /^\s+$/) { if ($ch =~ /^\s+$/) { prtw("$lnn: FAILED 104=sp [$line]\n"); } else { # valid begin... } } else { prtw("$lnn: FAILED 105=$pc [$line]\n"); } # ============================ $len2 = $len > $off5 ? $off5 - $off4 - 1 : $len - $off4 + 1; $size = trim_all(substr($line,$off-1,$len2)); } $off = 114; if ($len > $off) { $pc = substr($line,$off-2,1); $ch = substr($line,$off-1,1); # ********************************** if ($pc =~ /^\s+$/) { if ($ch =~ /^\s+$/) { prtw("$lnn: FAILED ".($off-1)."=sp [$line]\n"); } else { # valid begin... } } else { prtw("$lnn: FAILED ".($off-2)."=$pc [$line]\n"); } # ********************************** $rate = substr($line,$off-1); # get end of line } prt("$lnn: [$model] [$desc] [$type] [$size] [$rate]\n") if (VERB9()); if (defined $air_hash{$model}) { $rpts++; $val = $air_hash{$model}; prt("$lnn: [$model] [$desc] [$type] [$size] [$rate]\n"); prt("Is a repeat of\n"); prt("$model: ".join(",",@{$val})."\n"); } else { $air_hash{$model} = [$desc,$type,$size,$rate,$lnn,0,0]; $modcnt++; } } prt("Collected $modcnt models, repeats $rpts\n"); show_air_hash(\%air_hash); # if (VERB5()); ###pgm_exit(1,"TEMP EXIT"); } # MAIN ############################################################ parse_args(@ARGV); ###load_input_air_text(); $| = 1; # set no print output buffering my %h = (); if (-d $in_folder) { %h = process_aircraft_folder($in_folder); # get LIST from ALL <aircraft>-set.xml files } elsif (-f $in_folder) { my @a = (); if ($dbg_cac02) { write2file( "Processing $in_folder file...\n",$tempxml ); ### prt("Writting xml to $tempxml\n"); } %h = process_set_file($in_folder,\@a,$in_folder); } show_hash_ref( \%h ); # output the list if ($dbg_cac02) { # this is really ONLY FOR DEBUG prt("Written ALL xml lines to [$tempxml]\n"); } 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,$msg); 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 =~ /^s/) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg eq 'fdm') { $ord_byfdm = 1; } elsif ($sarg eq 'author') { $ord_author = 1; } elsif ($sarg eq 'status') { $ord_status = 1; } else { pgm_exit(1,"ERROR: Sort order can only be fdm|author|status, NOT [$sarg]\n"); } prt("Set SORT order per [$sarg]\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { if (-d $arg) { $in_folder = $arg; prt("Set input to [$in_folder]\n") if (VERB1()); } elsif (-f $arg) { $in_folder = $arg; prt("Set input to [$in_folder]\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Input [$arg] is neither folder, nor file!\n"); } } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_folder) == 0) { #$in_folder = $def_file; $in_folder = $def_dir; prt("Set DEFAULT input to [$in_folder]\n"); ###$load_log = 2; $verbosity = 1; } } $fg_root = $def_root; if (length($fg_root) == 0) { if (-d $def_root) { $fg_root = $def_root; } else { prt("Default root of $def_root is NOT VALID directory\n"); pgm_exit(1,"Set root with '-r path' command!\n"); } } if (length($in_folder) == 0) { pgm_exit(1,"ERROR: No input folder found in command!\n"); } if ((! -d $in_folder) && (! -f $in_folder)) { pgm_exit(1,"ERROR: Unable to find in folder or file [$in_folder]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-folder\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(" --sort ord (-s) = Sort order. Options are fdm|author|status. Default is alphabetic on model.\n"); prt(" --root path (-r) = Set FG_ROOT folder. (def=$def_root)\n"); #prt(" --out <file> (-o) = Write output to this file.\n"); } # eof - fgchkaircraft.pl