Generated: Mon Aug 29 19:34:26 2016 from fg-ac.pl 2014/10/28 72.4 KB. text copy
#!/usr/bin/perl -w # NAME: fg-ac.pl # AIM: Given a FG data directory, enumerate the AIRCRAFT found # 23/10/2014 - Revisit... # 05/12/2010 - Update - move good functions to a 'lib_xml.pl' # 2010-01-09 - initial cut - geoff - bugs: report@geoffair.info # #<PropertyList> # <sim> # <flight-model>yasim</flight-model> # <status>alpha</status> # <author>Lee Elliott</author> # <aero>MiG-15bis-yasim</aero> # other things... #BEGIN { # @INC = qw(/etc/perl /usr/local/lib/perl5/site_perl/5.10.1 /usr/local/lib/perl5/5.10.1 /usr/lib/perl5 /usr/share/perl5 #/usr/local/share/perl/5.8.8 /usr/lib/perl/5.8 /home/geoff/bin); #} use strict; use warnings; use File::Basename; use Cwd; my $perl_root = 'C:\GTools\perl'; #unshift(@INC, '/home/geoff/bin'); #require "logfileu.pl" or die "ERROR: Unable to load logfileu.pl"; unshift(@INC, $perl_root); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n"; require 'lib_xml.pl' or die "Unable to load 'lib_xml.pl'! Check location and \@INC content.\n"; #require "logfile.pl" or die "ERROR: Unable to load logfile.pl"; #require "xmlgparse.pl" or die "ERROR: Unable to load xmlgparse.pl"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\/|\\)/) { my @tmpsp = split(/(\/|\\)/,$pgmname); $pgmname = $tmpsp[-1]; } #my $outfile = "/tmp/temp.".$pgmname.".txt"; my $outfile = $perl_root."\\temp.".$pgmname.".txt"; my $output_file = $perl_root."\\tempair.txt"; my $set_file_list = $perl_root."\\tempset.txt"; open_log($outfile); my $os = $^O; prt("$pgmname: Running in $os...\n"); my $VERS = "0.0.3 2014-10-23"; ###my $VERS = "0.0.2 2010-12-05"; my $inp_dir = "X:\\fgdata"; #my $inp_dir = "F:\\fgdata"; #my $inp_dir = "C:\\FGCVS\\FlightGear\\data"; #my $inp_dir = "/home/geoff/fg/fg7/fgfs/data"; # Just as a reminder: Last year's FlightGear 1.9.1 came out with the following # selection of aircraft: # Airliner : Boeing 777-200 # World War II Fighter : A6M2 "Zero" # Small TurboProp : b1900d # Helicopter : bo105 # Small Prop : Cessna 172p # Small Business Jet : Cessna Citation X # Ultralight : Moyes Dragonfly # Aerotowing Capable / Seaplane : DeHavilland Dhc2 # Omnipowerful Jet Fighter : F-14b # Light Prop : Piper j3cub # Light Twin Prop : SenecaII # Historic Warbird : Sopwidth Camel # Not of this Earth : UFO # Airship : Zeppelin-NT # 2010-12-18 Changed "j3cub/j3cub-set.xml" to "Cub/Cub-set.xml", and 'j3cub' to 'Cub', and some others.... my @rel_ac = qw(777-200ER A6M2 b1900d bo105 c172p citation dragonfly dhc2w f-14b Cub senecaII sopwithCamel ufo ZLT-NT); my @rel_ac_set = ("777-200/777-200ER-set.xml", "A6M2/A6M2-jsbsim-set.xml", "b1900d/b1900d-set.xml", "bo105/bo105-set.xml", "c172p/c172p-set.xml", "CitationX/CitationX-set.xml", "Dragonfly/Dragonfly-set.xml", "dhc2/dhc2W-set.xml", "f-14b/f-14b-set.xml", "Cub/Cub-set.xml", "SenecaII/SenecaII-panelonly-set.xml", "sopwithCamel/sopwithCamel-YASim-set.xml", "ufo/ufo-set.xml", "ZLT-NT/ZLT-NT-set.xml"); my %rel_aircraft = ( '777-200ER' => "Modern Day Airliner (Boeing)", 'A6M2' => "World War II Fighter", 'b1900d' => "Twin Propliner", 'bo105' => "Helicopter", 'c172p' => "Single Engine GA", 'citation' => "Twin Small Turbo Jet", 'dragonfly' => "Ultralight", 'dhc2w' => "Rugged Bushplane (Dehavilland)", 'f-14b' => "Modern Fighter", 'Cub' => "Light Towplane", 'senecaII' => "Small twin piston prop", 'sopwithCamel' => "Historic aricraft", 'ufo' => "Secret", 'ZLT-NT' => "Advanced lighter-than-air vehicle" ); # features my $load_log = 1; my $max_path_len = 35; my $show_parse_options = 0; my $do_new_stuff = 0; my $conv_pre_text_cr = 1; my $thorn_list = 'C:\Documents and Settings\Geoff McLane\My Documents\FG\aircraft-02.txt'; my %g_thorn_list = (); sub load_thorn_list($) { my ($inf) = @_; my $rtl = \%g_thorn_list; my ($line,$len,@arr,$ac,$val,$had_val,$pval,$tmp,$lnn,$ra); $val = 9999; $had_val = 0; if (open INF, "<$inf") { my @lines = <INF>; close INF; foreach $line (@lines) { $lnn++; $line = trim_all($line); $len = length($line); next if ($len == 0); if ($line =~ /^\#\s+----\s+(\d+)\s+---/) { $tmp = $1; $pval = $val; $val = $tmp; $had_val = 1; if ($val > $pval) { pgm_exit(1,"$lnn: Got value [$val], previous $pval OUT oF ORDER\n"); } } next if ($line =~ /^\#/); if ($had_val) { my @air = (); @arr = split(/,/,$line); foreach $ac (@arr) { $ac = trim_all($ac); next if (length($ac) == 0); #$g_thorn_list{$ac} = 1; push(@air,$ac); } if (@air) { ${$rtl}{$val} = \@air; # $g_thorn_list{$val} = \@air; } $had_val = 0; } } $len = 0; #foreach $val (keys %g_thorn_list) $len = 0; foreach $val (keys %{$rtl}) { $ra = ${$rtl}{$val}; $len += scalar @{$ra}; } prt("Loaded $len a/c, from [$inf]\n"); } else { prt("WARNING: File [$inf] NOT FOUND!\n"); } } # options during parse my $XO_SHOW1 = 1; my $XO_SHOW2 = 2; my $XO_SHOW3 = 4; my $XO_SHOW4 = 8; # element types my $XT_HEADER = 1; # xml header <?xml ... ?> my $XT_COMMENT = 2; # comments <!-- ... --> my $XT_DOCTYPE = 3; # doctype <!DOCTYPE ... [ <!-- ... --> ]> my $XT_CDATA = 4; # cdata <![CDATA[ ... ]]> # elements my $XT_ELE1 = 5; # simple <element[ attribs]> my $XT_ELE2 = 6; # closed </element> my $XT_ELE3 = 7; # complete <element[ attribs]/> my %xml_type_names = ( $XT_HEADER => 'header', $XT_COMMENT => 'comment', $XT_DOCTYPE => 'doctype', $XT_CDATA => 'cdata', $XT_ELE1 => 'open', $XT_ELE2 => 'close', $XT_ELE3 => 'complete' ); # special hash strings my $x_cont = 'ContentArray'; my $x_warn = 'ErrorWarnings'; my $x_root = 'DocRoot'; my $x_file = 'FileName'; # stacked in an array my $XAO_TYPE = 0; my $XAO_TEXT = 1; my $XAO_TAG = 2; my $XAO_PRE = 3; my $XAO_LNNUM = 4; my $XAO_STACK = 5; my @warnings = (); # debug my $dbg_01 = 0; # prt("[dbg_01] Found [$sf]\n") if ($dbg_01); my $dbg_02 = 0; # prt("[$dbg_02] COMMENT:[$tag]\n") if ($dbg_02); my $dbg_03 = 0; # prt("[dbg_03] HEAD:[$tag]\n") if ($dbg_03); my $dbg_04 = 0; # prt("[dbg_04] CLOSE1:[$tag]\n") if ($dbg_04); my $dbg_05 = 0; # prt("[dbg_05] $lnn:$cols: Stacked 1 [$currtag]\n") if ($dbg_05); my $dbg_06 = 0; # prt("[dbg_06] $lnn:$cols: Stacked 2 [$currtag]\n") if ($dbg_06); my $dbg_07 = 0; # prt("[dbg_07] $lnn:$cols: UNStacked 1 [$tmptag], currtag [$currtag]\n") if ($dbg_07); my $dbg_08 = 0; # prt("[dbg_08] $lnn:$cols: UNStacked 2 [$tmptag], currtag [$currtag]\n") if ($dbg_08); my $dbg_09 = 0; # prt("[dbg_09] Done $lnn lines, from [$fil]. $len chars...\n") if ($dbg_09); my $dbg_10 = 0; # prt("[dbg_10] $lnn: END CDATA:<$tag>\n") if ($dbg_10); #my $test_in_file = "C:\\FGCVS\\FlightGear\\data\\Aircraft\\14bis\\14bis-set.xml"; my $test_in_file = ''; # ############################################################# # ### FUNCTIONS ### my $verbosity = 0; sub VERB1() { return ($verbosity > 0); } sub VERB2() { return ($verbosity > 1); } sub VERB5() { return ($verbosity > 4); } sub VERB9() { return ($verbosity > 8); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "No warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if ( !($msg =~ /\n$/) ); prt($msg); } show_warnings(); close_log($outfile,$load_log); exit($val); } sub short_form_file_name($) { my ($fil) = @_; my $len = length($fil); if ($len > $max_path_len) { my ($nm,$dir) = fileparse($fil); my $len2 = length($nm); if ($len2 > $max_path_len) { return $nm; } my $bal = $max_path_len - $len2; return substr($fil,0,$bal)."...$nm"; } return $fil; } sub is_rel_set_file($) { my ($fil) = @_; my $off = 0; my $lcfil = lc($fil); $lcfil =~ s/\\/\//g; foreach my $f (@rel_ac_set) { $off++; my $lcf = lc($f); $lcf =~ s/\\/\//g; return $off if ($lcf eq $lcfil); } if ($lcfil =~ /^ufo\/ufo/i) { pgm_exit(1,"UFO FILE NOT FOUND!!! [$fil]??????? [$lcfil]"); } return 0; } sub sub_common_dir($$) { my ($rd,$nd) = @_; my $len = length($rd); my $lnd = length($nd); $len = $lnd if ($lnd < $len); my ($i,$c1,$c2); for ($i = 0; $i < $len; $i++) { $c1 = substr($rd,$i,1); $c2 = substr($nd,$i,1); if ($c1 =~ /(\\|\/)/) { last if !($c2 =~ /(\\|\/)/); } else { last if ($c1 ne $c2); } } $c1 = substr($nd,$i); if (($i == $len)&&($c1 =~ /^(\\|\/)/)) { $c1 = substr($c1,1); } return $c1 } sub process_dir($$$$) { my ($dir,$fil,$rcnt,$rsfa) = @_; my $ff = "$dir/$fil"; my $sf = "$ff/$fil-set.xml"; my @sfiles = (); my ($f,$sf1,@fils,$fcnt); $fcnt = 0; if (opendir(DIR,$ff)) { @fils = readdir(DIR); closedir DIR; foreach $f (@fils) { next if (($f eq '.')||($f eq '..')); if ($f =~ /-set.xml$/) { $sf1 = "$ff/$f"; $sf = '' if ($sf1 eq $sf); push(@sfiles,$sf1); } } } #if (length($sf) && ( -f $sf )) { # $fcnt++; # prt("Found [$sf]\n"); #} foreach $sf (@sfiles) { if ( -f $sf ) { $fcnt++; prt("[dbg_01] Found [$sf]\n") if ($dbg_01); } } ${$rcnt} += $fcnt; if ($fcnt == 0) { prt("No set files found in [$ff]\n") if (VERB9()); } else { push(@{$rsfa},@sfiles); } } sub process_files($$) { my ($dir,$rar) = @_; my $fcnt = scalar @{$rar}; my $ac_dir = "$dir/Aircraft"; prt("Got $fcnt items, from [$ac_dir] to process...\n"); my ($fil,$dcnt,$scnt,$scnt2); $dcnt = 0; $fcnt = 0; $scnt = 0; my @setfiles = (); foreach $fil (@{$rar}) { next if (($fil eq '.')||($fil eq '..')); my $ff = "$dir/$fil"; if ( -d $ff ) { $dcnt++; process_dir($dir,$fil,\$scnt,\@setfiles); } elsif ( -f $ff ) { $fcnt++; } else { prt("WHAT IS THIS? [$fil]! full [$ff]!\n"); } } $scnt2 = scalar @setfiles; prt("Done $dcnt directories, $scnt xml set files...($scnt2)\n"); if (length($set_file_list)) { if (open SF,">$set_file_list") { printf SF join("\n",@setfiles)."\n"; close SF; prt("Written list to $set_file_list...\n"); } } return \@setfiles; } sub xml_get_type_name($) { my ($typ) = shift; if (defined $xml_type_names{$typ}) { return $xml_type_names{$typ}; } return 'Unknown $typ!'; } sub is_cdata($) { my ($txt) = @_; if ($txt =~ /^\[CDATA\[/) { return 1; } return 0; } sub ret_stack_text_simple($) { my ($ra) = @_; my $rtxt = ''; foreach my $tx (@{$ra}) { $rtxt .= '/' if (length($rtxt)); $rtxt .= $tx; } return $rtxt; } sub ret_stack_text_arr($) { my ($ra) = @_; my $rtxt = ''; foreach my $tx (@{$ra}) { $rtxt .= '/' if (length($rtxt)); $rtxt .= ${$tx}[0]; } return $rtxt; } ################################################################## ### Have open element <foo followed by k=v attributes sub get_att_ref($) { my ($txt) = @_; $txt = substr($txt,1) while ($txt =~ /^\s/); # clear any leading spaces my $len = length($txt); my ($i,$cc,$key,$val); $i = 0; my %h = (); while ($i < $len) { $key = ''; for (; $i < $len; $i++) { $cc = substr($txt,$i,1); if ($cc eq '=') { $i++; $cc = substr($txt,$i,1); last; } $key .= $cc; } return \%h if ($cc ne '"'); $i++; $val = ''; for (; $i < $len; $i++) { $cc = substr($txt,$i,1); last if ($cc eq '"'); $val .= $cc; } # SET THE KEY=VALUE ################################# $h{$key} = $val; ################################# $i++; # bump over 2nd inverted commas # and eat any spaces for (; $i < $len; $i++) { $cc = substr($txt,$i,1); last if ( !($cc =~ /\s/) ); } } return \%h; } sub check_ele_stack($$$) { my ($res,$rw,$opts) = @_; my $cnt = scalar @{$res}; if ($cnt) { my $wrap = 4; my $msg = "WARNING: Still $cnt items ON THE STACK! "; my $tcnt = 0; $msg .= "\n" if ($cnt > $wrap); for (my $i = 0; $i < $cnt; $i++) { my $refts = ${$res}[$i]; my $toptag = ${$refts}[0]; my $toplnn = ${$refts}[1]; $msg .= "[".$toptag."]($toplnn) "; $tcnt++; if ($tcnt > $wrap) { $tcnt = 0; $msg .= "\n"; } } push(@{$rw},$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } } ######################################################################## ### scan an XML text string # element types # xml header <?xml ... ?> # comments <!-- ... --> # doctype <!DOCTYPE ... [ <!-- ... --> ]> # cdata <![CDATA[ ... ]]> # elements # simple <element attribs> # closed </element> # complete <element attribs/> sub scan_xml_text($$$) { my ($fil,$text,$opts) = @_; my $len = length($text); prt("Process file [$fil], $len characters...\n") if ($opts & $XO_SHOW1); my ($i,$cc,$pretxt,$lnn,$element); my ($xitem,$pc,$ppc,$pppc); my ($eletyp,$eleref,$pele,$plnn); my ($stkcnt,$bgnlnn,$stktxt,$msg); my ($atttxt); my %xmlhash = (); my %xh2 = (); my $rxmlhash = \%xmlhash; my $rh2 = \%xh2; my ($attref,$chr); my @elestack = (); my @xmlarray = (); my @warns = (); my @error = (); my $doc_root = ''; my $dr_line = 0; my $doc_error = 0; $i = 0; $lnn = 0; $pretxt = ''; $element = ''; $cc = ''; $pc = ''; $ppc = ''; $pppc = ''; while (($i < $len) && !$doc_error) { $eletyp = 0; # accumulate text before an element $pretxt = ''; for (; $i < $len; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '<'); $pretxt .= $cc; } # accumulate the element $bgnlnn = $lnn; $element = ''; $i++; # bump past '<' char for (; $i < $len; $i++) { $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')||($cc =~ /\s/)); # stop on '>' OR a SPACE, or out of chars $element .= $cc; # accumulate element } next if (length($element) == 0); # got an XML element - either <.......> or <..... prt("$lnn: Process element [$element]\n") if ($opts & $XO_SHOW1); $stktxt = ret_stack_text_arr(\@elestack); # determine element type if ($element =~ /^\?xml/i) { $eletyp = $XT_HEADER; # is xml header $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; } } # store head # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done HEADER <$xitem> END HEADER\n") if ($opts & $XO_SHOW2); # new stuff if ($do_new_stuff) { $attref = get_att_ref(""); $element = "==xml_header=="; $stktxt = $element; # ret_stack_text(\@elestack); $pretxt =~ s/\n/\\n/g if ($conv_pre_text_cr); $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } $pretxt = ''; $element = ''; $i++; # skip last '>' } elsif ($element =~ /^!--/) { $eletyp = $XT_COMMENT; # comment $xitem = $element; if (!(($cc eq '>')&&($pc eq '-')&&($ppc eq '-'))) { $pc = '*'; # make sure not trapped by <!--> for (; $i < $len; $i++) { $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')&&($pc eq '-')&&($ppc eq '-')); $xitem .= $cc; } } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done COMMENT <$xitem> END COMMENT\n") if ($opts & $XO_SHOW2); # new stuff if ($do_new_stuff) { $element = "==xml_comment=="; $attref = get_att_ref(""); $stktxt = $element; $pretxt =~ s/\n/\\n/g if ($conv_pre_text_cr); $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } $element = ''; $pretxt = ''; $i++; # skip last '>' } elsif ($element =~ /^!DOCTYPE/) { $eletyp = $XT_DOCTYPE; # doctype - $cc has to be a SPACE $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; if ($cc eq '[') { # enter DOCTYPE comment $i++; for (; $i < $len; $i++) { $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; last if ($cc eq ']'); if (($cc eq '-')&&($pc eq '-')&&($ppc eq '!')&&($pppc eq '<')) { # entered comment in doctype $i++; $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; $i++; for (; $i < $len; $i++) { $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; last if (($cc eq '>')&&($pc eq '-')&&($ppc eq '-')); } } } } } } else { $msg = "ERROR:$lnn: Closed DOCTYPE> - mal-formed XML!"; push(@error,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); $doc_error++; last; } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done DOCTYPE <$xitem> END DT\n") if ($opts & $XO_SHOW2); # new stuff if ($do_new_stuff) { $element = "==xml_doctype=="; $attref = get_att_ref(""); $stktxt = $element; $pretxt =~ s/\n/\\n/g if ($conv_pre_text_cr); $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } $pretxt = ''; $element = ''; $i++; # skip last '>' } elsif ($element =~ /^!\[CDATA\[/) { $eletyp = $XT_CDATA; # CDATA $xitem = $element; if (!(($cc eq '>') && ($pc eq ']') && ($ppc eq ']'))) { for (; $i < $len; $i++) { $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')&&($pc eq ']')&&($ppc eq ']')); $xitem .= $cc; } } prt("$lnn: Done CDATA <$xitem> END CDATA\n") if ($opts & $XO_SHOW2); # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); # new stuff if ($do_new_stuff) { $element = "==xml_cdata=="; $attref = get_att_ref(""); $stktxt = $element; $pretxt =~ s/\n/\\n/g if ($conv_pre_text_cr); $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } $element = ''; $pretxt = ''; $i++; # skip last '>' } # ================================================================= if (length($element)) { # an element, which may be complete ie end in '/>', and may have attributes a="b" $attref = get_att_ref(""); # get a BLANK attribute reference $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; } } if ($element =~ /^\//) { $element = substr($element,1); $eletyp = $XT_ELE2; # open, now closed - so pop } elsif ($pc eq '/') { # open/close element $eletyp = $XT_ELE3; } else { $eletyp = $XT_ELE1; # open, so push } # Deal with ELEMENT types # ======================= if ($eletyp == $XT_ELE1) { # open <tag [attrs]> $atttxt = $xitem; $atttxt =~ s/^$element//; $attref = get_att_ref($atttxt); push(@elestack,[$element,$lnn,$attref]); $stkcnt = scalar @elestack; if ($stkcnt == 1) { if (length($doc_root)) { $msg = "ERROR:$lnn: Have doc root [$doc_root]($dr_line), now 2nd root [$element]($lnn)!"; push(@error,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); $doc_error++; last; } $doc_root = $element; $dr_line = $lnn; } prt("$lnn: PUSHED [$element] ($stkcnt)\n") if ($opts & $XO_SHOW3); } elsif ($eletyp == $XT_ELE2) { # close </tag> if (@elestack) { $eleref = $elestack[-1]; $pele = ${$eleref}[0]; $plnn = ${$eleref}[1]; if ($element eq $pele) { $attref = ${$eleref}[2]; pop @elestack; $stkcnt = scalar @elestack; prt("$lnn: POPPED [$element] ($stkcnt)\n") if ($opts & $XO_SHOW3); } else { $msg = "WARNING:$lnn: Element [$element] NOT last. Last is [$pele]($plnn)! NO POP"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } } else { $msg = "WARNING:$lnn: Element [$element] NOT ON EMPTY STACK! NO POP"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } } elsif ($eletyp == $XT_ELE3) { # complete <tag [attrs]/> $atttxt = $xitem; $atttxt =~ s/^$element//; $attref = get_att_ref($atttxt); } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); if ($do_new_stuff) { if ($eletyp == $XT_ELE2) { # new stuff $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } elsif ($eletyp == $XT_ELE3) { # new stuff $stktxt .= "/$element"; $chr = xml_get_content_hr($eletyp,$pretxt,$xitem,$attref); xml_set_hash_ref_value($stktxt,$rh2,$element,$chr); } } $pretxt = ''; $element = ''; $i++; # skip last '>' } } if ($i < $len) { $msg = "WARNING:$lnn: Still ".($len - $i)." characters in file [$fil] NOT PARSED!"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } check_ele_stack(\@elestack,\@warns,$opts); # if (!$doc_error); if ($do_new_stuff) { #prt(reduce_indent_5_2(Dumper($rh2))); } # fill up the HASH with collections # ================================= ${$rxmlhash}{$x_warn} = [ \@warns, \@error ] if (@warns || @error); ${$rxmlhash}{$x_cont} = \@xmlarray; ${$rxmlhash}{$x_root} = $doc_root; ${$rxmlhash}{$x_file} = $fil; # ================================= return $rxmlhash; } # my ($set,$parser,$root,$root_children,$element,$root_tag_name,$aero_text,$roots_children); # $parser = XML::Parser::Wrapper->new; # $root = $parser->parse({ file => $set }); # #$root = $parser->parse($set); # $root_tag_name = $root->name; # $roots_children = $root->elements; # foreach $element (@$roots_children) { # if ($element->name eq 'aero') { # $aero_text = $element->text; # eq "Hello World!" # prt("$aero_text\n"); # exit(1) # } # } # my $aero_element = $root3->first_element('aero'); # my $head_elements = $root->elements('head2'); # my $test = $root->element('head2')->first_element('test_tag'); sub parse_xml_text($$) { my ($fil,$text) = @_; return scan_xml_text($fil,$text,0); } sub parse_xml_text_warning($$) { my ($fil,$text) = @_; my %hash = (); my ($len,$i,$cc,$lnn); $len = length($text); $lnn = 1; my $opts = $show_parse_options; my ($pretxt,$element,$stktxt,$eletyp,$xitem,$bgnlnn); my ($pc,$ppc,$pppc,$msg,$doc_error); my ($attref,$atttxt,$stkcnt); my ($doc_root,$dr_line,$eleref,$pele,$plnn); my @elestack = (); my @xmlarray = (); my @error = (); my @warns = (); my $rxmlhash = \%hash; $pc = ''; $ppc = ''; $doc_error = 0; $doc_root = ''; $i = 0; while ($i < $len) { $pretxt = ''; # store text BEFORE '<' for ( ; $i <$len ; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '<'); $pretxt .= $cc; } $bgnlnn = $lnn; $i++; # got START of ELEMENT $element = ''; for ( ; $i <$len ; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')||($cc =~ /\s/)); $element .= $cc; } # got END of ELEMENT, or SPACE - decide what we got $stktxt = ret_stack_text_arr(\@elestack); # determine element type if ($element =~ /^\?xml/i) { $eletyp = $XT_HEADER; # is xml header $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; } } # store head # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done HEADER <$xitem> END HEADER\n") if ($opts & $XO_SHOW2); # =================================================================== $pretxt = ''; $element = ''; $i++; # skip last '>' } elsif ($element =~ /^!--/) { $eletyp = $XT_COMMENT; # comment $xitem = $element; if (!(($cc eq '>')&&($pc eq '-')&&($ppc eq '-'))) { $pc = '*'; # make sure not trapped by <!--> for (; $i < $len; $i++) { $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')&&($pc eq '-')&&($ppc eq '-')); $xitem .= $cc; } } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done COMMENT <$xitem> END COMMENT\n") if ($opts & $XO_SHOW2); # =================================================================== $pretxt = ''; $element = ''; $i++; # skip last '>' } elsif ($element =~ /^!DOCTYPE/) { $eletyp = $XT_DOCTYPE; # doctype - $cc has to be a SPACE $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; if ($cc eq '[') { # enter DOCTYPE comment $i++; for (; $i < $len; $i++) { $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; last if ($cc eq ']'); if (($cc eq '-')&&($pc eq '-')&&($ppc eq '!')&&($pppc eq '<')) { # entered comment in doctype $i++; $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; $i++; for (; $i < $len; $i++) { $pppc = $ppc; $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); $xitem .= $cc; last if (($cc eq '>')&&($pc eq '-')&&($ppc eq '-')); } } } } } } else { $msg = "ERROR:$lnn: Closed DOCTYPE> - mal-formed XML!"; push(@error,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); $doc_error++; last; } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); prt("$lnn: Done DOCTYPE <$xitem> END DT\n") if ($opts & $XO_SHOW2); # =================================================================== $pretxt = ''; $element = ''; $i++; # skip last '>' } elsif ($element =~ /^!\[CDATA\[/) { $eletyp = $XT_CDATA; # CDATA $xitem = $element; if (!(($cc eq '>') && ($pc eq ']') && ($ppc eq ']'))) { for (; $i < $len; $i++) { $ppc = $pc; $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if (($cc eq '>')&&($pc eq ']')&&($ppc eq ']')); $xitem .= $cc; } } prt("$lnn: Done CDATA <$xitem> END CDATA\n") if ($opts & $XO_SHOW2); # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); # =================================================================== $element = ''; $pretxt = ''; $i++; # skip last '>' } # ================================================================= if (length($element)) { # an element, which may be complete ie end in '/>', and may have attributes a="b" $attref = get_att_ref(""); # get a BLANK attribute reference $xitem = $element; if ($cc ne '>') { for (; $i < $len; $i++) { $pc = $cc; $cc = substr($text,$i,1); $lnn++ if ($cc eq "\n"); last if ($cc eq '>'); $xitem .= $cc; } } if ($element =~ /^\//) { $element = substr($element,1); $eletyp = $XT_ELE2; # open, now closed - so pop } elsif ($pc eq '/') { # open/close element $eletyp = $XT_ELE3; } else { $eletyp = $XT_ELE1; # open, so push } # Deal with ELEMENT types # ======================= if ($eletyp == $XT_ELE1) { # open <tag [attrs]> $atttxt = $xitem; $atttxt =~ s/^$element//; $attref = get_att_ref($atttxt); push(@elestack,[$element,$lnn,$attref]); $stkcnt = scalar @elestack; if ($stkcnt == 1) { if (length($doc_root)) { $msg = "ERROR:$lnn: Have doc root [$doc_root]($dr_line), now 2nd root [$element]($lnn)!"; push(@error,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); $doc_error++; last; } $doc_root = $element; $dr_line = $lnn; } prt("$lnn: PUSHED [$element] ($stkcnt)\n") if ($opts & $XO_SHOW3); } elsif ($eletyp == $XT_ELE2) { # close </tag> if (@elestack) { $eleref = $elestack[-1]; $pele = ${$eleref}[0]; $plnn = ${$eleref}[1]; if ($element eq $pele) { $attref = ${$eleref}[2]; pop @elestack; $stkcnt = scalar @elestack; prt("$lnn: POPPED [$element] ($stkcnt)\n") if ($opts & $XO_SHOW3); } else { $msg = "WARNING:$lnn: Element [$element] NOT last. Last is [$pele]($plnn)! NO POP"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } } else { $msg = "WARNING:$lnn: Element [$element] NOT ON EMPTY STACK! NO POP"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } } elsif ($eletyp == $XT_ELE3) { # complete <tag [attrs]/> $atttxt = $xitem; $atttxt =~ s/^$element//; $attref = get_att_ref($atttxt); } # $XAO_ TYPE TEXT TAG PRE LNNUM push(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn, $stktxt ]); $pretxt = ''; $element = ''; $i++; # skip last '>' } } if ($i < $len) { $msg = "WARNING:$lnn: Still ".($len - $i)." characters in file [$fil] NOT PARSED!"; push(@warns,$msg); prtw("$msg\n") if ($opts & $XO_SHOW4); } check_ele_stack(\@elestack,\@warns,$opts); # if (!$doc_error); # fill up the HASH with collections # ================================= ${$rxmlhash}{$x_warn} = [ \@warns, \@error ] if (@warns || @error); ${$rxmlhash}{$x_cont} = \@xmlarray; ${$rxmlhash}{$x_root} = $doc_root; ${$rxmlhash}{$x_file} = $fil; # ================================= return $rxmlhash; } sub has_utf_16_BOM($) { my ($fil) = shift; if (open INF, "<$fil") { binmode INF; my $buf = ""; if ((read INF, $buf, 2) == 2) { close INF; my $od1 = ord(substr($buf,0,1)); my $od2 = ord(substr($buf,1,1)); if (($od1 == 0xFF)&&($od2 == 0xFE)) { return (16+2); # LittleEndians (windows) } elsif (($od1 == 0xFE)&&($od2 == 0xFF)) { return (16+4); # BigEndians (unix) } elsif ($od1 == 0) { return 4; } elsif ($od2 == 0) { return 2; } return 1; } close INF; } return 0; } ################################################################# ### load an XML file into a single text string sub parse_xml_file($) { my ($fil) = @_; my $bom = has_utf_16_BOM($fil); if (!open INF, "<$fil") { pgm_exit(1,"ERROR: Unable to open file [$fil]!"); } if ($bom & 2) { binmode INF, ":encoding(UTF-16LE)"; } elsif ($bom & 4) { binmode INF, ":encoding(UTF-16BE)"; } my @lines = <INF>; close INF; $lines[0] = substr($lines[0],1) if ($bom & 16); # move PAST the BOM my $text = join("",@lines); my $len = length($text); my $lnn = scalar @lines; if (VERB5()) { prt("Processing $lnn lines, $len chars, from "); prt("\n ") if (length($fil) > 24); prt("[$fil]"); if ($bom & 6) { prt(" UTF-16LE") if ($bom & 2); prt(" UTF-16BE") if ($bom & 4); prt("(BOM)") if ($bom & 16); } prt("\n"); } return scan_xml_text($fil,$text,0); } sub parse_xml_ok($) { my ($fil) = @_; my %hash = (); my ($msg); if (open INF, "<$fil") { my @lines = <INF>; close INF; my ($tag,$text,$len,$i,$cc,$nc,$pc,$pc1,$pc2,$iscom,$tcnt,$ishead,$lnn,$isclose1,$isclose2,$ttxt,$spcnt); my (@tagstack,$i2,$cols,$currtag,$tmptag,$stkcnt,$iscdata,$stktxt); $text = join("",@lines); $len = length($text); $lnn = scalar @lines; prt("Processing $lnn lines, from [$fil]. $len chars...\n"); $cc = ''; $pc1 = ''; $pc2 = ''; $iscom = 0; $ishead = 0; $lnn = 1; $isclose1 = 0; $isclose2 = 0; $ttxt = ''; @tagstack = (); $currtag = ''; $cols = 0; $iscdata = 0; for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $cols++; $pc2 = $pc1; $pc1 = $pc; $pc = $cc; $cc = substr($text,$i,1); $nc = ($i2 < $len) ? substr($text,$i2,1) : ''; if ($cc eq "\n") { $lnn++; $cols = 0; $cc = ' '; } if ($cc eq '<') { $tag = ''; # clear the tag $i++; $tcnt = 0; $iscom = 0; $ishead = 0; $isclose1 = 0; $isclose2 = 0; $iscdata = 0; $spcnt = 0; # proceed to END OF TAG for (; $i < $len; $i++) { $cols++; $i2 = $i + 1; $pc2 = $pc1; $pc1 = $pc; $pc = $cc; $cc = substr($text,$i,1); $nc = ($i2 < $len) ? substr($text,$i2,1) : ''; if ($cc eq "\n") { $lnn++; $cols = 0; $cc = ' '; } # <?xml $ishead = 1 if (($tcnt == 2) && ($nc eq 'l') && ($cc eq 'm') && ($pc eq 'x') && ($pc1 eq '?')); # <![CDATA[ ... ]]> $iscdata = 1 if (($tcnt == 1) && ($nc eq 'C') && ($cc eq '[') && ($pc eq '!') && ($pc1 eq '<') && is_cdata(substr($text,$i))); if ($iscdata) { #prt("$lnn:$cols: Got CDATA\n"); #prt(substr($text,$i,40)."\n"); #pgm_exit(1,"Temp exit"); # stay and EAT comment completely $i++; $tag = $pc.$cc; # proceed to END OF CDATA TAG for (; $i < $len; $i++) { $cols++; $i2 = $i + 1; $pc2 = $pc1; $pc1 = $pc; $pc = $cc; $cc = substr($text,$i,1); $nc = ($i2 < $len) ? substr($text,$i2,1) : ''; if ($cc eq "\n") { $lnn++; $cols = 0; $cc = ' '; } # is it '-->', end of comment if (($cc eq '>') && ($pc eq ']') && ($pc1 eq ']')) { last; # reached END OF CDATA } $tag .= $cc; } last; # exit TAG inner loop } # <!-- $iscom = 1 if (($tcnt == 1) && ($nc eq '-') && ($cc eq '-') && ($pc eq '!') && ($pc1 eq '<')); if ($iscom) { # stay and EAT comment completely $i++; $tag = $pc.$cc; # proceed to END OF TAG for (; $i < $len; $i++) { $cols++; $i2 = $i + 1; $pc2 = $pc1; $pc1 = $pc; $pc = $cc; $cc = substr($text,$i,1); $nc = ($i2 < $len) ? substr($text,$i2,1) : ''; if ($cc eq "\n") { $lnn++; $cols = 0; $cc = ' '; } # is it '-->', end of comment if (($cc eq '>') && ($pc eq '-') && ($pc1 eq '-')) { last; # reached END OF COMMENT } $tag .= $cc; } last; # exit TAG inner loop } else { # </... $isclose1 = 1 if (($tcnt == 0) && ($cc eq '/')); # <... /> if (($cc eq '/') && ($nc eq '>')) { $isclose2 = 1; # this is a <... /> self closed tag if ($spcnt && @tagstack && ($tagstack[-1] eq $currtag)) { $tmptag = pop @tagstack; if (@tagstack) { $currtag = $tagstack[-1]; } else { $currtag = "*EMPTY*"; } $stktxt = ret_stack_text(\@tagstack); prt("[dbg_07] $lnn:$cols: UNStacked 1 [$tmptag], currtag [$currtag]\n") if ($dbg_07); } last; } elsif ($cc eq '>') { if (($spcnt == 0) && !$ishead && !$iscom) { if ($isclose1) { if (@tagstack && ($tagstack[-1] eq $currtag)) { $tmptag = pop @tagstack; if (@tagstack) { $currtag = $tagstack[-1]; } else { $currtag = "*EMPTY*"; } $stktxt = ret_stack_text(\@tagstack); prt("[dbg_08] $lnn:$cols: UNStacked 2 [$tmptag], currtag [$currtag]\n") if ($dbg_08); } elsif (@tagstack) { prt("ERROR: $lnn:$cols: curtag [".$currtag."] NE tagstack [".$tagstack[-1]."]!\n"); pgm_exit(1,"Bad TAG 1! file=$fil"); } else { prt("ERROR: $lnn:$cols: curtag [".$currtag."] NOT IN tagstack!\n"); pgm_exit(1,"Bad TAG 2! file=$fil"); } } elsif (length($tag)) { push(@tagstack,$tag); $currtag = $tag; $stktxt = ret_stack_text(\@tagstack); prt("[dbg_05] $lnn:$cols: Stacked 1 [$currtag]\n") if ($dbg_05); } } last; } elsif ($cc =~ /\s/) { if (($spcnt == 0) && !$ishead && !$isclose1 && !$iscom) { push(@tagstack,$tag); $currtag = $tag; $stktxt = ret_stack_text(\@tagstack); prt("[dbg_06] $lnn:$cols: Stacked 2 [$currtag]\n") if ($dbg_06); } $cc = ' ' if ($cc eq "\n"); if ( !($pc =~ /\s/) ) { $tag .= $cc; } $spcnt++; # bump the SPACE counter } else { # NOT '/', '>', '\s'... $tag .= $cc; } } $tcnt++; #last if ($iscom); } # for (; $i < $len; $i++) { # proceed to END OF TAG if ($ishead) { prt("[dbg_03] $lnn: HEAD:<$tag>\n") if ($dbg_03); $hash{'XML HEADER'} = $tag; } elsif ($iscom) { prt("[dbg_02] $lnn: COMMENT:<$tag>\n") if ($dbg_02); } elsif ($isclose1) { prt("[dbg_04] $lnn: CLOSE1:<$tag>\n") if ($dbg_04); } elsif ($isclose2) { prt("[dbg_04] $lnn: CLOSE2:<$tag>\n") if ($dbg_04); } elsif ($iscdata) { prt("[dbg_10] $lnn: END CDATA:<$tag>\n") if ($dbg_10); } # done this tag $ttxt = ''; next; } $ttxt .= $cc; } $stkcnt = scalar @tagstack; prt("[dbg_09] Done $lnn lines, from [$fil]. $len chars...\n") if ($dbg_09); if ($stkcnt) { $msg = "WARNING: Still $stkcnt item on tag stack! "; for ($i = 0; $i < $stkcnt; $i++) { $msg .= "[".$tagstack[$i]."] "; } prtw("$msg\n"); } } else { pgm_exit(1,"ERROR: Unable to open file [$fil]!"); } return \%hash; } ####################################################### ### parse a set of -set.xml file sub parse_ref_set($$) { my ($dir,$ra) = @_; my $cnt = scalar @{$ra}; prt("Got $cnt set xml files...\n"); my ($set,$rxml); my %h = (); foreach $set (@{$ra}) { $rxml = parse_xml_file($set); $h{$set} = $rxml; } return \%h; } # ================================================= # Functions used by xml_get_all_children sub get_warn_error_text($) { my ($rh) = @_; my $text = ''; if (defined ${$rh}{$x_warn}) { my $rwarn = ${$rh}{$x_warn}[0]; my $rerror = ${$rh}{$x_warn}[1]; my ($err); if (@{$rwarn}) { foreach $err (@{$rwarn}) { $text .= "<!-- $err -->\n"; } } if (@{$rerror}) { foreach $err (@{$rerror}) { $text .= "<!-- $err -->\n"; } } } return $text; } sub is_in_array_ref($$) { my ($tag,$rarr) = @_; my $cnt = scalar @{$rarr}; my ($i,$ele); for ($i = 0; $i < $cnt; $i++) { $ele = ${$rarr}[$i]; return ($i+1) if ($ele eq $tag); } return 0; } sub is_in_array_ref_0($$) { my ($tag,$rarr) = @_; my $cnt = scalar @{$rarr}; my ($i,$ele); for ($i = 0; $i < $cnt; $i++) { $ele = ${$rarr}[$i]; # extract ref return ($i+1) if (${$ele}[0] eq $tag); } return 0; } sub show_ele_hash($$) { my ($reh,$out) = @_; my ($key,$cnt,$cont,$xitem,$msg,$attrs,$atth); my ($k,$v,$ec); $cnt = scalar keys(%{$reh}); prt("Show element hash - count $cnt...\n") if ($out); $cnt = 0; foreach $key (keys %{$reh}) { $cnt++; $ec = ${$reh}{$key}{'count'}; $msg = "$cnt: [$key]($ec) "; #prt("$cnt: key [$key] ".${$reh}{$key}{'count'}." "); $xitem = $key; $attrs = ''; if (defined ${$reh}{$key}{'xitem'}) { $xitem = ${$reh}{$key}{'xitem'}; $attrs = $xitem; $attrs =~ s/$key//; # strip OFF the key $attrs = trim_all($attrs); #$msg .= "[$attrs] "; } $atth = get_att_ref($attrs); if (!defined ${$reh}{$key}{'attrs'}) { ${$reh}{$key}{'attrs'} = $atth; } $msg .= "<$key"; foreach $k (keys %{$atth}) { $v = ${$atth}{$k}; $msg .= " $k=\"$v\""; } $msg .= ">"; if (defined ${$reh}{$key}{'content'}) { $cont = ${$reh}{$key}{'content'}; if (length($cont)) { #prt("cont [$cont]"); $msg .= "$cont</$key>"; } else { $msg .=" EMPTY"; delete ${$reh}{$key}; } } else { $msg .= "No CONTENT!"; delete ${$reh}{$key}; } prt("$msg\n") if ($out); } prt("Done element hash - count $cnt...\n") if ($out); } sub transfer_ele_hash($$$) { my ($sim,$rch,$reh) = @_; my ($key); foreach $key (keys %{$reh}) { ${$rch}{$sim}{$key} = [ ${$reh}{$key}{'content'}, ${$reh}{$key}{'attrs'} ]; } } sub xml_get_all_children($$$$) { my ($rh,$sim,$dep,$opts) = @_; my %ch = (); my %ch2 = (); my $rch2 = \%ch2; if (!defined ${$rh}{$x_cont}) { return $rch2; # "<!-- ERROR: No content array in HASH! -->\n"; } my $childpath = "child_".$sim."_".$dep."_".$opts; if (defined ${$rh}{$childpath}) { return ${$rh}{$childpath}; } my $ra = ${$rh}{$x_cont}; my $doc_root = ${$rh}{$x_root}; my $fil_name = ${$rh}{$x_file}; my $cnt = scalar @{$ra}; my $text = ''; my $ind = 0; my $in; my ($i,$eletyp,$xitem,$element,$pretxt,$bgnlnn,$eleref,$prev,$stktxt); my (@arr,$inarr,$acnt,$diff,$i2,$typnam,$sst,$tpt,$msg,$hadyes); my ($stkpath,$inref); my ($topele,$topref,$attref,$topatt,$chr,$sxit); my @tagstack = (); my %elehash = (); my $dbg_ln = $opts; my ($fil_root,$fil_dir) = fileparse($fil_name); $prev = ''; $hadyes = 0; $inref = 0; prt("Get all children of [$sim], depth $dep, doc root $doc_root...\n") if ($dbg_ln); $text = ''; $text .= get_warn_error_text($rh); # $XAO_ TYPE TEXT TAG PRE LNNUM #ush(@xmlarray, [ $eletyp, $xitem, $element, $pretxt, $bgnlnn ]); for ($i = 0; $i < $cnt; $i++) { $i2 = $i + 1; $eleref = ${$ra}[$i]; $eletyp = ${$eleref}[$XAO_TYPE]; $xitem = ${$eleref}[$XAO_TEXT]; $element = ${$eleref}[$XAO_TAG]; $pretxt = ${$eleref}[$XAO_PRE]; $bgnlnn = ${$eleref}[$XAO_LNNUM]; $stktxt = ${$eleref}[$XAO_STACK]; next if (length($stktxt) == 0); $sst = $stktxt; $sst =~ s/^$doc_root\///; $typnam = xml_get_type_name($eletyp); # element types $in = ' ' x $ind; @arr = split('/',$stktxt); $acnt = scalar @arr; $inarr = is_in_array_ref($sim,\@arr); $msg = "$i2: $typnam [$element][$sst]"; $msg .= " $inarr of $acnt "; if ($inarr) { $tpt = trim_all($pretxt); $diff = ($acnt - $inarr); if ($dep <= 0) { $msg .= "YesD"; } elsif ($diff <= $dep) { $msg .= "Yes"; } else { $msg .= "Yes, but DEPTH!"; $inarr = 0; } $msg .= " $tpt" if (length($tpt)); prt("$msg\n") if ($dbg_ln); $hadyes++; } else { if ($element eq $sim) { $msg .= "NO, but YES because element is $sim"; $hadyes++; $inarr = 1; } else { $msg .="NO"; $hadyes-- if ($hadyes); } prt("$msg\n") if ($dbg_ln); } next if (!$inarr); if ($eletyp == $XT_HEADER) { # xml header <?xml ... ?> #$text .= "<$xitem>\n"; } elsif ($eletyp == $XT_COMMENT) { # comments <!-- ... --> #if ($opts & 1) { # $text .= "$in<$xitem>\n"; #} } elsif ($eletyp == $XT_DOCTYPE) { # doctype <!DOCTYPE ... [ <!-- ... --> ]> #$text .= "<$xitem>\n"; } elsif ($eletyp == $XT_CDATA) { # cdata <![CDATA[ ... ]]> $text .= "$i2:" if ($dbg_ln); if ($opts & 2) { $text .= "$in<$xitem>\n"; } else { $text =~ s/\n$//; $text .= "<$xitem>\n"; } } elsif ($eletyp == $XT_ELE1) { # simple <element[ attribs]> #$ind++; $text .= "$i2:" if ($dbg_ln); $text .= "$in<$xitem>\n"; $sxit = $xitem; $sxit =~ s/^$element//; # NOTE: one of the attributes can be 'include="file-path-name"' $attref = get_att_ref($sxit); $prev = $element; $stkpath = ret_stack_text_arr(\@tagstack); push(@tagstack,[$element,$attref]); $ind = scalar @tagstack; if (defined $elehash{$element}) { $elehash{$element}{'count'}++; } else { $elehash{$element}{'count'} = 1; $elehash{$element}{'line'} = $i2; $elehash{$element}{'xitem'} = $xitem; } } elsif ($eletyp == $XT_ELE2) { # closed </element> #$ind-- if ($ind); $in = ' ' x $ind; $ind = scalar @tagstack; $pretxt = trim_all($pretxt); $inref = is_in_array_ref_0($element,\@tagstack); if (@tagstack) { $ind = scalar @tagstack; $topref = $tagstack[-1]; $topele = ${$topref}[0]; $topatt = ${$topref}[1]; if (!$inref) { prtw("WARNING: element [$element] NOT IN STACK! [$fil_root]\n"); next; } elsif ($element ne $topele) { prtw("WARNING: element [$element] NOT LAST STACK! last [$topele][$fil_root]\n"); next; } elsif ($inref != $ind) { # this can be WRONG??? } } else { prtw("WARNING: element [$element] NOT IN EMPTY STACK! [$fil_root]\n"); next; } $stkpath = ret_stack_text_arr(\@tagstack); pop @tagstack; $ind = scalar @tagstack; if (defined $elehash{$element}) { #$elehash{$element}{'count'}-- if ($elehash{$element}{'count'}); $elehash{$element}{'content'} = $pretxt; } $in = ' ' x $ind; if ($prev eq $element) { $text =~ s/\n$//; $text .= $pretxt if (length($pretxt) && !($pretxt =~ /^\s+$/)); $text .= "$i2:" if ($dbg_ln); $text .= "<$xitem>\n"; } else { $text .= $in; if (length($pretxt) && !($pretxt =~ /^\s+$/)) { $text .= "$pretxt\n" if (length($pretxt) && !($pretxt =~ /^\s+$/)); $text .= "$i2:" if ($dbg_ln); $text .= "$in<$xitem>\n"; } else { $text .= "$i2:" if ($dbg_ln); $text .= "<$xitem>\n"; } } if ($do_new_stuff) { if (length($pretxt)) { $chr = xml_get_content_hr($eletyp,"",$pretxt,$topatt); xml_set_hash_ref_value($stkpath,$rch2,$element,$chr); } } } elsif ($eletyp == $XT_ELE3) { # complete <element[ attribs]/> $text .= "$i2:" if ($dbg_ln); $text .= "$in<$xitem>\n"; $sxit = $xitem; $sxit =~ s/^$element//; $sxit = trim_all($sxit); if ($do_new_stuff) { if (length($sxit)) { $stkpath = ret_stack_text(\@tagstack); # NOTE: one of the attributes can be 'include="file-path-name"' $attref = get_att_ref($sxit); $stkpath .= "/$element"; # increase PATH by this 'element' $chr = xml_get_content_hr($eletyp,"","",$attref); xml_set_hash_ref_value($stkpath,$rch2,$element,$chr); } } } } #prt(Dumper($rch2)); #enum_hash_ref(\%ch2,0,''); #enum_hash_ref($rch2,0,''); prt("Debug parse text...\n$text\nEnd Debug parse text\n") if ($dbg_ln); # ========================================== show_ele_hash( \%elehash, 0 ); show_ele_hash( \%elehash, 0 ); transfer_ele_hash( $sim, \%ch, \%elehash ); # ========================================== ### pgm_exit(1,"TEMP EXIT"); if ($do_new_stuff) { #return \%ch2; return $rch2; } ${$rh}{$childpath} = \%ch; return \%ch; } sub show_child_hash($$$) { my ($rc,$sim,$opt) = @_; my $ri = ${$rc}{$sim}; my ($key,$rah,$ritm,$msg,$k,$v,$cont,$cnt,$fnd,$min,$len); my @arr = qw(status description aero flight-model author); my $show_xml = 0; my $rtxt = ''; $min = 0; foreach $key (@arr) { $len = length($key); $min = $len if ($len > $min); } $cnt = scalar keys( %{$ri} ); prt("Show $cnt children hash...\n") if ($show_xml); foreach $key (sort keys %{$ri}) { $ritm = ${$rc}{$sim}{$key}; $cont = ${$ritm}[0]; $rah = ${$ritm}[1]; $fnd = 0; foreach $k (@arr) { if ($k eq $key) { $fnd = 1; last; } } if ($fnd) { if ($show_xml) { $msg = "<$key"; foreach $k (keys %{$rah}) { $v = ${$rah}{$k}; $msg .= " $k=\"$v\""; } $msg .= ">$cont</$key>"; } else { $msg = $key; $msg .= ' ' while (length($msg) < $min); $msg .= ": $cont"; $rtxt .= "$msg\n"; # add to returned text } prt("$msg\n"); } } prt("Done $cnt children hash...\n") if ($show_xml); return $rtxt; } sub show_fg_sim_references($) { my ($rh) = @_; my $doc_root = ${$rh}{$x_root}; my $fil_name = ${$rh}{$x_file}; my $rc = xml_get_all_children($rh,"sim",0,0); my $cnt = scalar keys(%{$rc}); my ($fil_root,$fil_dir) = fileparse($fil_name); my $msg = ''; if ($cnt == 0) { $msg ="WARNING: NO CHILDREN FETCHED! [$fil_root]"; prtw("$msg\n"); } else { $msg = show_child_hash($rc,"sim",0); } return $msg; } sub get_fg_string($$$) { my ($rh,$sim,$tag) = @_; my $rc = xml_get_all_children($rh,$sim,0,0); my $ri = ${$rc}{$sim}; foreach my $key (keys %{$ri}) { if ($key eq $tag) { my $ritm = ${$rc}{$sim}{$key}; my $cont = ${$ritm}[0]; return $cont; } } return ""; } sub get_fg_sim_fdm_string($) { my ($rh) = @_; my $sim = "sim"; my $tag = 'flight-model'; return get_fg_string($rh,$sim,$tag); } sub get_fg_sim_author_string($) { my ($rh) = @_; my $sim = "sim"; my $tag = 'author'; return get_fg_string($rh,$sim,$tag); } sub get_fg_sim_status_string($) { my ($rh) = @_; my $sim = "sim"; my $tag = 'status'; return get_fg_string($rh,$sim,$tag); } sub get_fg_sim_aero_string($) { my ($rh) = @_; my $sim = "sim"; my $tag = 'aero'; return get_fg_string($rh,$sim,$tag); } sub get_fg_sim_desc_string($) { my ($rh) = @_; my $sim = "sim"; my $tag = 'description'; return get_fg_string($rh,$sim,$tag); } # My particular time 'translation' - replaced date_string sub get_YYYYMMDD_local($) { my ($tm) = shift; # 0 1 2 3 4 5 6 7 8 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm); $year += 1900; $mon += 1; my $ymd = "$year/"; $ymd .= '0' if ($mon < 10); $ymd .= "$mon/"; $ymd .= '0' if ($mday < 10); $ymd .= "$mday"; return $ymd; } sub show_ref_dir($$) { my ($rdir,$rh) = @_; my ($fil,$rdh,$cnt,$sfil,$msg,$aircraft,$ac,$ntxt,$fnd,$add,$off,$air2,$max,$i); my %h = (); my $otext = ''; my $fndair = ''; my ($set,$aero); $cnt = scalar keys(%{$rh}); prt("Show ref directory files... count = $cnt...\n"); if (length($output_file)) { open OUT, ">$output_file"; $msg = get_YYYYMMDD_local(time()).": $cnt set files from [$rdir] directory...\n"; print OUT $msg; } $cnt = 0; # restart counter $add = 0; $max = scalar @rel_ac; foreach $fil (keys %{$rh}) { $rdh = ${$rh}{$fil}; $sfil = sub_common_dir($rdir,$fil); if (${$rdh}{$x_root} eq 'PropertyList') { $cnt++; prt("\n"); $aero = get_fg_string($rdh,'sim','aero'); # if ($sfil =~ /(\\|\/)(\w+|-|\d+)-set\.xml/) if ($sfil =~ /(\\|\/)(.+)-set\.xml/) { $set = $2; } else { $set = '???'; } $msg = sprintf("%3d:",$cnt)." SET FIL: $sfil ($set) ($aero)\n"; prt("$msg"); # prt("IS 43 ($cnt)\n") if ($cnt == 43); $ntxt = show_fg_sim_references($rdh); $msg .= $ntxt; if (length($output_file)) { print OUT $msg; } $fnd = 0; $off = is_rel_set_file($sfil); if ($off > 0) { $air2 = $rel_ac[$off-1]; #for ($i = 0; $i < $max; $i++) { # $aircraft = $rel_ac[$i]; # my $tsttok = $aircraft; # if (($sfil =~ /$tsttok/i)||($ntxt =~ /$tsttok/im)) { $fnd = 1; # $fndair = $aircraft; # last; # } #} } if ($fnd && length($air2)) { if ( ! defined $h{$air2} ) { $h{$air2} = []; } my $ra = $h{$air2}; push(@{$ra},$rdh); $h{$air2} = $ra; $add++; } } } if (length($output_file)) { close OUT; prt("Info written to [$output_file]...\n"); } prt("$add: Added to release list...\n"); return \%h; } sub test_inp_dir($) { my ($in_dir) = @_; my $ver_file = "$in_dir/version"; my $ac_dir = "$in_dir/Aircraft"; if ( ! -d $in_dir ) { prt("ERROR: Can NOT locate directory [$in_dir]! Aborting...\n"); pgm_exit(1,""); } if (open INF, "<$ver_file" ) { my @arr = <INF>; close INF; chomp $arr[0]; prt("Data version [$arr[0]]... from [$in_dir]\n"); } else { prt("ERROR: Can NOT locate file [$ver_file]! Aborting...\n"); pgm_exit(1,""); } if ( ! -d $ac_dir ) { prt("ERROR: Can NOT locate directory [$ac_dir]! Aborting...\n"); pgm_exit(1,""); } } my $min_air_msg = 12; sub show_rel_ac($) { my ($rh) = @_; my ($air,$cnt,$cnt1,$cnt2,$ra,$rdh,$cnt3,$i,$msg,$cnt4,$test,$cat); my @arr = keys(%{$rh}); my %done = (); $cnt1 = scalar @arr; $cnt2 = scalar @rel_ac; prt("Of $cnt2 release aircraft, found $cnt1...\n"); $cnt = 0; prt("\n"); $cnt = 0; $cnt3 = 0; my @array = (); my ($aero,$fdm,$status,$author,$desc,$msg2,$airm,$cntm,$cnt3m); my $mina = 0; my $minf = 0; my $mins = 0; my $len = 0; my %haero = (); my %hfdm = (); my %hstatus = (); my %hauthor = (); foreach $air (@rel_ac) { $cnt++; $done{$air} = 1; $cat = ' '; $airm = $air; $airm .= " " while (length($airm) < $min_air_msg); if (defined $rel_aircraft{$air}) { $cat = $rel_aircraft{$air}; } $cntm = sprintf("%2d",$cnt); prt( "$cntm: [$airm] "); if (defined ${$rh}{$air}) { $ra = ${$rh}{$air}; foreach $rdh (@{$ra}) { $aero = get_fg_sim_aero_string($rdh); $len = length($aero); $mina = $len if ($len > $mina); $fdm = get_fg_sim_fdm_string($rdh); $len = length($fdm); $minf = $len if ($len > $minf); $status = get_fg_sim_status_string($rdh); $len = length($status); $mins = $len if ($len > $mins); $author = get_fg_sim_author_string($rdh); $desc = get_fg_sim_desc_string($rdh); push( @array, [$aero, $fdm, $status, $author, $desc] ); $cnt3++; if (defined $haero{$aero}) { $haero{$aero}++; } else { $haero{$aero} = 1; } if (defined $hfdm{$fdm}) { $hfdm{$fdm}++; } else { $hfdm{$fdm} = 1; } if (defined $hstatus{$status}) { $hstatus{$status}++; } else { $hstatus{$status} = 1; } if (defined $hauthor{$author}) { $hauthor{$author}++; } else { $hauthor{$author} = 1; } } $cnt3m = sprintf("%2d",$cnt3); prt("$cnt3m: $cat"); } else { prt("UGH: [$air] Not in hash!"); } prt("\n"); } foreach $air (@arr) { if (!defined $done{$air}) { prt("$cnt3: [$air] from hash\n"); $ra = ${$rh}{$air}; foreach $rdh (@{$ra}) { $aero = get_fg_sim_aero_string($rdh); $len = length($aero); $mina = $len if ($len > $mina); $fdm = get_fg_sim_fdm_string($rdh); $len = length($fdm); $minf = $len if ($len > $minf); $status = get_fg_sim_status_string($rdh); $len = length($status); $mins = $len if ($len > $mins); $author = get_fg_sim_author_string($rdh); $desc = get_fg_sim_desc_string($rdh); push( @array, [$aero, $fdm, $status, $author, $desc] ); $cnt3++; if (defined $haero{$aero}) { $haero{$aero}++; } else { $haero{$aero} = 1; } if (defined $hfdm{$fdm}) { $hfdm{$fdm}++; } else { $hfdm{$fdm} = 1; } if (defined $hstatus{$status}) { $hstatus{$status}++; } else { $hstatus{$status} = 1; } if (defined $hauthor{$author}) { $hauthor{$author}++; } else { $hauthor{$author} = 1; } } } } prt("\nList as found in HASH...\n"); for ($i = 0; $i < $cnt3; $i++) { $aero = $array[$i][0]; $fdm = $array[$i][1]; $status = $array[$i][2]; $author = $array[$i][3]; $desc = $array[$i][4]; $cnt = $i + 1; $aero .= ' ' while (length($aero) < $mina); $fdm .= ' ' while (length($fdm) < $minf); $status .= ' ' while (length($status) < $mins); $msg = sprintf("%3d:",$cnt); prt("$msg aero [$aero], fdm [$fdm], status [$status], author [$author]\n"); prt(" desc [$desc]\n"); } # ================================================== $cnt = 0; prt("\nList per aero...\n"); foreach $test (sort keys %haero) { $cnt2 = $haero{$test}; $cnt1 = 0; for ($i = 0; $i < $cnt3; $i++) { if ($test eq $array[$i][0] ) { $aero = $array[$i][0]; $fdm = $array[$i][1]; $status = $array[$i][2]; $author = $array[$i][3]; $desc = $array[$i][4]; $cnt++; $cnt4 = $i + 1; $cnt1++; $aero .= ' ' while (length($aero) < $mina); $fdm .= ' ' while (length($fdm) < $minf); $status .= ' ' while (length($status) < $mins); $msg = sprintf("%3d:",$cnt4); prt("$msg aero [$aero], fdm [$fdm], status [$status], author [$author]\n"); prt(" desc [$desc] ($cnt1 of $cnt2) $cnt\n"); } } } # ================================================== $cnt = 0; prt("\nList per FDM...\n"); $msg2 = ''; foreach $test (sort keys %hfdm) { $cnt2 = $hfdm{$test}; $cnt1 = 0; for ($i = 0; $i < $cnt3; $i++) { if ($test eq $array[$i][1]) { $aero = $array[$i][0]; $fdm = $array[$i][1]; $status = $array[$i][2]; $author = $array[$i][3]; $desc = $array[$i][4]; $cnt++; $cnt4 = $i + 1; $cnt1++; $aero .= ' ' while (length($aero) < $mina); $fdm .= ' ' while (length($fdm) < $minf); $status .= ' ' while (length($status) < $mins); $msg = sprintf("%3d:",$cnt4); prt("$msg aero [$aero], fdm [$fdm], status [$status], author [$author]\n"); prt(" desc [$desc] ($cnt1 of $cnt2) $cnt\n"); } } $test = "<blank>" if (length(trim_all($test)) == 0); $msg2 .= "\n $test = $cnt2 ($cnt1) "; } $cnt4 = scalar keys(%hfdm); $msg2 = "Done $cnt per $cnt4 FDM - ".$msg2; prt("$msg2\n"); # ================================================== $cnt = 0; prt("\nList per status...\n"); $msg2 = ''; foreach $test (sort keys %hstatus) { $cnt2 = $hstatus{$test}; $cnt1 = 0; for ($i = 0; $i < $cnt3; $i++) { if ($test eq $array[$i][2]) { $aero = $array[$i][0]; $fdm = $array[$i][1]; $status = $array[$i][2]; $author = $array[$i][3]; $desc = $array[$i][4]; $cnt4 = $i + 1; $cnt++; $cnt1++; $aero .= ' ' while (length($aero) < $mina); $fdm .= ' ' while (length($fdm) < $minf); $status .= ' ' while (length($status) < $mins); $msg = sprintf("%3d:",$cnt4); prt("$msg aero [$aero], fdm [$fdm], status [$status], author [$author]\n"); prt(" desc [$desc] ($cnt1 of $cnt2) $cnt\n"); } } $test = "<blank>" if (length(trim_all($test)) == 0); $msg2 .= "\n $test = $cnt2 ($cnt1) "; } $cnt4 = scalar keys(%hstatus); $msg2 = "Done $cnt per $cnt4 status - ".$msg2; prt("$msg2\n"); # ================================================== $cnt = 0; prt("\nList per author...\n"); $msg2 = ''; foreach $test (sort keys %hauthor) { $cnt2 = $hauthor{$test}; $cnt1 = 0; for ($i = 0; $i < $cnt3; $i++) { if ($test eq $array[$i][3]) { $aero = $array[$i][0]; $fdm = $array[$i][1]; $status = $array[$i][2]; $author = $array[$i][3]; $desc = $array[$i][4]; $cnt++; $cnt4 = $i + 1; $cnt1++; $aero .= ' ' while (length($aero) < $mina); $fdm .= ' ' while (length($fdm) < $minf); $status .= ' ' while (length($status) < $mins); $msg = sprintf("%3d:",$cnt4); prt("$msg aero [$aero], fdm [$fdm], status [$status], author [$author]\n"); prt(" desc [$desc] ($cnt1 of $cnt2) $cnt\n"); } } $test = "<blank>" if (length(trim_all($test)) == 0); $msg2 .= "\n $test = $cnt2 ($cnt1) "; } $cnt4 = scalar keys(%hauthor); $msg2 = "Done $cnt per $cnt4 authors - ".$msg2; prt("$msg2\n"); # ================================================== } sub read_inp_dir($) { my ($in_dir) = @_; my $ac_dir = "$in_dir/Aircraft"; if ( opendir( DIR, $ac_dir ) ) { my @files = readdir(DIR); closedir DIR; my $ref_set_arr = process_files($ac_dir,\@files); my $ref_dir = parse_ref_set($ac_dir,$ref_set_arr); my $ref_rac = show_ref_dir($ac_dir,$ref_dir); show_rel_ac($ref_rac); } else { prt("ERROR: Can NOT open directory [$ac_dir]! Aborting...\n"); pgm_exit(1,""); } } sub check_air_list() { my ($air,$cnt); $cnt = scalar @rel_ac; prt("$cnt release aircraft...\n"); $cnt = 0; foreach $air (@rel_ac) { $cnt++; prt( "$cnt: [$air]\n"); } pgm_exit(1,""); } ############################################################ # ### MAIN ### # check_air_list(); if (length($test_in_file)) { my $rh = parse_xml_file($test_in_file); if (${$rh}{$x_root} eq 'PropertyList') { show_fg_sim_references($rh); } } else { parse_args(@ARGV); # load_thorn_list($thorn_list); test_inp_dir($inp_dir); read_inp_dir($inp_dir); } pgm_exit(0,"Normal exit"); ############################################################ ######################################## sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] [data-directory]\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verbosity (-v[n]) = Bump, or set verbosity to 'n' - 0 - 9 valid.\n"); prt("Purpose:\n"); prt("Search [$inp_dir] for FG aircraft 'set' files...\n"); prt(" and show some of the contents of the set files.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have 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/i) { if ($sarg =~ /^v(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1); } } prt("Set verbosity to $verbosity\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $inp_dir = $arg; prt("Set input direcotry to [$inp_dir]\n") if (VERB1()); } shift @av; } } # eof - fg-ac.pl