Generated: Sun Aug 21 11:10:57 2011 from fg_menu_xml.pl 2011/04/18 25 KB.
#!/usr/bin/perl -w # NAME: fg_io_xml.pl # AIM: View the contents of a FlightGear IO XML file # 15/04/2011 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($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 $pgm_version ="0.0.1 2011-04-15"; my $load_log = 1; my $in_file = ''; my $include_format = 0; my $include_name = 0; my $include_type = 0; my $include_factor = 0; my $include_offset = 0; my $load_next = 1; # follow and load the ;next' xml, if FOUND # output control my $show_open = 0; my $show_empty = 0; my $show_close = 0; my $show_comments = 0; my $show_cdata = 0; my $show_hash_counts = 0; my $show_first_name = 1; # show the FIRST <name>....</name> entry my $show_curr_name = 0; # show <name>...</name> after first my $warn_label_nt = 0; my $warn_already = 0; my $debug_on = 1; my $def_file = 'C:\FG\29\data\gui\menubar.xml'; ###my $def_file = 'C:\FG\29\data\gui\dialogs\location-of-tower.xml'; ###my $def_file = 'C:\FG\29\data\gui\dialogs\view.xml'; my @menu_tags = qw( PropertyList airport-list alpha binding blue border button button-template checkbox checkbox-template close col color colspan combo command default default-padding dial dialog-name draggable editable empty enable enabled engine-label equal equals font format greater-than green group halign height hrule input input-template item key keynum label layout legend list live map max menu min modal mtbf-label name nasal not object-name one-shot open padding pref-height pref-width properties property radio red resizable row rowspan script slider step stretch subsystem text text-template textbox timeofday valign value visible waypointlist width wrap x y ); my @command_items = qw( ATC-freq-search dialog-apply dialog-close dialog-show dialog-update dump-scenegraph exit hires-screen-capture nasal old-help-dialog old-print-dialog panel-load presets-commit property-adjust property-assign property-randomize property-swap property-toggle reinit replay reset timeofday ); #my @menu_tags2 = qw( PropertyList binding command dialog-name enabled item label # max menu min name property script step subsystem value ); #my @command_items2 = qw( ATC-freq-search dialog-show dump-scenegraph hires-screen-capture # nasal old-help-dialog old-print-dialog panel-load property-adjust property-assign # property-randomize reinit reset ); my %tag_list = (); my %command_list = (); my %files_processed = (); ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my ($root_name,$root_dir); ### forward refs sub process_in_file($$); 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" ); } } 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); } # this could be split(/\s/,$line), but there is a # problem with name="with space", that this overcomes. # Slower. but sure the split is as desired. sub space_split_local($) { my ($lin) = shift; my $ll = length($lin); my $tag = ''; my @rarr = (); my $inquots = 0; for (my $p = 0; $p < $ll; $p++) { my $ch = substr($lin,$p,1); if ($inquots) { $tag .= $ch; if ($ch eq '"') { $inquots = 0; } } else { if ($ch =~ /\s/) { push(@rarr, $tag) if (length($tag)); $tag = ''; } else { $tag .= $ch; if ($ch eq '"') { $inquots = 1; } } } } push(@rarr, $tag) if (length($tag)); return @rarr; } sub path_per_os($) { my $ff = shift; if ($os =~ /Win/) { $ff = path_u2d($ff); } else { $ff = path_d2u($ff); } return $ff; } sub show_count_hash($$$) { my ($rl,$label,$ra) = @_; # like (\%tag_list,"TAG LIST",\@menu_tags); my @arr = sort keys(%{$rl}); my $acnt = scalar @arr; prt("File contained $acnt $label tags...\n"); my ($key,$val,$msg); $msg = 'my @array_name = qw( '; foreach $key (@arr) { $val = ${$rl}{$key}; prt("$key $val\n"); $msg .= "$key "; } $msg .= ")"; prt("$msg\n"); } # $missed = process_dialog_name($txt,$dir,$dep); sub process_dialog_name($$$$$) { my ($txt,$dir,$dep,$rt,$rff) = @_; my ($ff,$ff2,$tmp,$tmp2,$missed); $missed = 1; $ff = $dir."dialogs/$txt".".xml"; $ff = path_per_os($ff); ${$rff} = $ff; $tmp2 = " tried [$txt]"; if (-f $ff) { $missed = 0; prt("Loading file [$ff]\n"); process_in_file($ff,$dep+1) if ($load_next); } if ($missed) { $ff = $root_dir."dialogs/$txt".".xml"; $ff = path_per_os($ff); $tmp2 = " tried [root/$txt]"; if (-f $ff) { $missed = 0; ${$rff} = $ff; prt("Loading file [$ff]\n"); process_in_file($ff,$dep+1) if ($load_next); } } if (($missed) && ($txt =~ /-/)) { $tmp = $txt; $tmp =~ s/-/_/; $tmp2 .= " tried [$tmp]"; $ff2 = $dir."dialogs/$tmp".".xml"; $ff2 = path_per_os($ff2); if (-f $ff2) { $missed = 0; ${$rff} = $ff2; prt("Loading file [$ff2]\n"); process_in_file($ff2,$dep+1) if ($load_next); } if ($missed) { $ff2 = $root_dir."dialogs/$tmp".".xml"; $ff2 = path_per_os($ff2); $tmp2 = " tried [root/$tmp]"; if (-f $ff2) { $missed = 0; ${$rff} = $ff2; prt("Loading file [$ff2]\n"); process_in_file($ff2,$dep+1) if ($load_next); } } } if (($missed) && ($txt =~ /-(.+)$/)) { $tmp = $txt; $tmp =~ s/-(.+)$//; $tmp2 .= " tried [$tmp]"; $ff2 = $dir."dialogs/$tmp".".xml"; $ff2 = path_per_os($ff2); if (-f $ff2) { $missed = 0; ${$rff} = $ff2; prt("Loading file [$ff2]\n"); process_in_file($ff2,$dep+1) if ($load_next); } if ($missed) { $ff2 = $root_dir."dialogs/$tmp".".xml"; $ff2 = path_per_os($ff2); $tmp2 = " tried [root/$tmp]"; if (-f $ff2) { $missed = 0; ${$rff} = $ff2; prt("Loading file [$ff2]\n"); process_in_file($ff2,$dep+1) if ($load_next); } } } ${$rt} = $tmp2; return $missed; } sub collect_item_lines($$$$$$) { my ($inf,$dep,$rlines,$ln,$lncnt,$etag) = @_; my ($i,$line,$i2,$pc,$ch,$nc,$intag,$tag,$txt,$len,$lnn); my (@arr,$lasttag,$bgn,$acnt); $intag = 0; my $incdata = 0; my $incomment = 0; $tag = ''; $txt = ''; my @tagstack = (); my @tsinfo = (); $lnn = $ln; for (; $ln < $lncnt; $ln++) { $line = ${$rlines}[$ln]; chomp $line; $line = trim_all($line); $len = length($line); $lnn++; next if ($len == 0); for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); $i2 = $i + 1; $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if ($incdata) { $tag .= $ch; if (($nc eq '>')&&($ch eq ']')&&($pc eq ']')) { if ($show_cdata) { prt("$lnn: End CDATA\n"); prt("tag [$tag>]\n"); } $incdata = 0; } next; } if ($incomment) { $tag .= $ch; if (($nc eq '>')&&($ch eq '-')&&($pc eq '-')) { if ($show_comments) { prt("$lnn: End COMMENT\n"); prt("tag [$tag>]\n"); } $incomment = 0; } next; } if ($intag) { if (($ch eq '-')&&($tag eq '<!-')) { prt("$lnn: Began COMMENT\n") if ($show_comments); $incomment = 1; $tag .= $ch; next; } if (($ch eq '[')&&($tag eq '<![CDATA')) { # <![CDATA[ ... ]]> prt("$lnn: Began CDATA\n") if ($show_cdata); $incdata = 1; $tag .= $ch; next; } if ($ch eq '>') { $tag .= $ch; $intag = 0; if ($tag =~ /^<\?/) { # header line } elsif ($tag =~ /^<!--/) { # forget comments } elsif ($tag =~ /^<!\[CDATA\[/) { # CDATA item } elsif ($tag =~ /\/>$/) { # self closing - forget for now } elsif ($tag =~ /^<\//) { # CLOSE - time to store text, information $tag =~ s/^<\///; $tag =~ s/>$//; if (@tagstack) { $lasttag = pop @tagstack; $bgn = pop @tsinfo; } else { pgm_exit(1,"ERROR: $lnn: Closing tag [$tag], with NO open tag stack! [$inf]\n"); } if ($tag eq $lasttag) { if ($tag eq $etag) { prt("$lnn: Found end of [$tag]\n"); return 1; } } else { pgm_exit(1,"ERROR:$ln: TAG NOT EQUAL [$lasttag] vs [$tag] [$inf]\n"); } } else { # OPEN - strip '<' and '>' $tag =~ s/^<//; $tag =~ s/>$//; @arr = space_split_local($tag); $acnt = scalar @arr; $tag = $arr[0]; push(@tagstack,$tag); push(@tsinfo, $lnn); if ($tag eq $etag) { prt("$lnn: Found start of [$tag]\n"); } } $tag = ''; $txt = ''; } else { $tag .= $ch; } } else { if ($ch eq '<') { $tag = $ch; $intag = 1; } else { $txt .= $ch; } } } } return 0; } sub process_file_lines($$$) { my ($inf,$dep,$rlines) = @_; my $lncnt = scalar @{$rlines}; my $dnfile = $inf; $dnfile = lc($dnfile) if ($os =~ /Win/); if (defined $files_processed{$dnfile}) { prtw("WARNING: Already processed [$inf]\n") if ($warn_already); return; } prt("\nProcessing $lncnt lines, from [$inf]...\n"); $files_processed{$dnfile} = [$inf, $lncnt]; my ($line,$inc,$lnn); my ($i,$len,$ch,$nc,$i2,$pc,$tag,$txt,$lasttag,$chunk,$tmp); my (@arr,$key,$val,$tmp2,$acnt,$j,$bgn,$ln); my (@arr2,$tshw,$smenu,$ff,$tcnt,$ff2,$missed); $lnn = 0; $ch = ''; my $intag = 0; ($root_name,$root_dir) = fileparse($inf) if ($dep == 0); my ($name,$dir) = fileparse($inf); $tag = ''; $txt = ''; my @tagstack = (); my @tsinfo = (); my @chunks = (); my $menu_count = 0; my $item_count = 0; # item count in each MENU my $last_command = ''; my $inmenu = 0; my $incomment = 0; my $incdata = 0; my $curr_name = ''; my $first_name = ''; my $name_cnt = 0; my $but_count = 0; $chunk = ''; my %attrs = (); for ($ln = 0; $ln < $lncnt; $ln++) { $line = ${$rlines}[$ln]; chomp $line; $lnn++; $line = trim_all($line); $len = length($line); next if ($len == 0); for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); $i2 = $i + 1; $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if ($incdata) { $tag .= $ch; if (($nc eq '>')&&($ch eq ']')&&($pc eq ']')) { if ($show_cdata) { prt("$lnn: End CDATA\n"); prt("tag [$tag>]\n"); } $incdata = 0; } next; } if ($incomment) { $tag .= $ch; if (($nc eq '>')&&($ch eq '-')&&($pc eq '-')) { if ($show_comments) { prt("$lnn: End COMMENT\n"); prt("tag [$tag>]\n"); } $incomment = 0; } next; } if ($intag) { if (($ch eq '-')&&($tag eq '<!-')) { prt("$lnn: Began COMMENT\n") if ($show_comments); $incomment = 1; $tag .= $ch; next; } if (($ch eq '[')&&($tag eq '<![CDATA')) { # <![CDATA[ ... ]]> prt("$lnn: Began CDATA\n") if ($show_cdata); $incdata = 1; $tag .= $ch; next; } if ($ch eq '>') { $tag .= $ch; $intag = 0; if ($tag =~ /^<\?/) { # header line } elsif ($tag =~ /^<!--/) { # forget comments } elsif ($tag =~ /^<!\[CDATA\[/) { # CDATA item } elsif ($tag =~ /\/>$/) { # self closing - forget for now } elsif ($tag =~ /^<\//) { # CLOSE - time to store text, information $tag =~ s/^<\///; $tag =~ s/>$//; if (@tagstack) { $lasttag = pop @tagstack; $bgn = pop @tsinfo; } else { pgm_exit(1,"ERROR: $lnn: Closing tag [$tag], with NO open tag stack!\n"); } if ($tag eq $lasttag) { $tmp = ''; if ($tag eq 'name') { if (length($txt)) { $curr_name = $txt; if ($name_cnt == 0) { prt("Dialog NAME = $curr_name\n") if ($show_first_name); $first_name = $curr_name; } else { prt("Set current NAME = $curr_name\n") if ($show_curr_name); } } else { prtw("WARNING: $lnn:$inf: Close NAME, but no TEXT found!\n"); } $name_cnt++; } elsif ($tag eq 'menu') { $tmp = "Menu: # $menu_count Sub-items: $item_count [$smenu]"; } if (length($txt)) { if ($tag eq 'command') { if (defined $command_list{$txt}) { $command_list{$txt}++; } else { $command_list{$txt} = 1; } $last_command = $txt; } elsif ($tag eq 'label') { $smenu .= "|" if (length($smenu)); $smenu .= $txt; } elsif ($tag eq 'dialog-name') { $missed = process_dialog_name($txt,$dir,$dep,\$tmp2,\$ff); if ($missed) { prtw("WARNING:$lnn: Unable to locate [$txt], file [$ff], in [$inf] $tmp2\n") if ($missed); } else { $smenu .= "\n(fil:[$ff])"; } } prt("$bgn:$lnn: <$lasttag> [$txt] </$tag> = Close tag $tmp\n") if ($show_close); } else { if ($tag eq 'label') { prtw("WARNING:$bgn:$lnn: Closing LABEL, but NO TEXT? [$inf]\n") if ($warn_label_nt); } if ($show_empty || length($tmp)) { if ($tag eq 'menu') { prt("$bgn:$lnn: CLOSE MENU $tmp\n"); } else { prt("$bgn:$lnn: <$lasttag></$tag> = Close empty tag $tmp\n"); } } } if ($tag eq 'menu') { $inmenu = 0; } elsif ($tag eq 'item') { # closing a menu sub-item } } else { pgm_exit(1,"ERROR: TAG NOT EQUAL [$lasttag] vs [$tag]\n"); } } else { # OPEN - strip '<' and '>' $tag =~ s/^<//; $tag =~ s/>$//; @arr = space_split_local($tag); $acnt = scalar @arr; $tag = $arr[0]; $tmp = ''; if ($acnt > 1) { #// has ATTRIBUTES my %ats =(); for ($j = 1; $j < $acnt; $j++) { $key = $arr[$j]; @arr2 = split('"',$key); if (scalar @arr2 == 2) { $key = $arr2[0]; $val = $arr2[1]; $ats{$key} = strip_quotes($val); $tmp .= "$key$val "; } else { prtw("WARNING: Attrib did not split on '=' [$key]\n"); } } } $tcnt = scalar @tagstack; $tcnt++; if (length($txt)) { prtw("WARNING: $lnn: Open tag = [$tag] with text [$txt] - CHECK THIS [$inf]\n"); } else { $tshw = 0; $tmp2 = ''; if ($tag eq 'menu') { $tshw = 1; $menu_count++; $tmp2 = "Menu: # $menu_count"; $inmenu = 1; $item_count = 0; $smenu = ''; } elsif ($tag eq 'item') { $item_count++; } elsif ($tag eq 'button') { $but_count++; collect_item_lines($inf,$dep,$rlines,$ln,$lncnt,$tag); } if ($show_open || $tshw) { if (length($tmp)) { prt("$lnn: Open [$tag] ATTRS [$tmp] $tcnt\n"); } else { prt("$lnn: Open [$tag] $tmp2 $tcnt\n"); } } } push(@tagstack, $tag); push(@tsinfo, $lnn); if (defined $tag_list{$tag}) { $tag_list{$tag}++; } else { $tag_list{$tag} = 1; } } $tag = ''; $txt = ''; } else { $tag .= $ch; } } else { if ($ch eq '<') { $tag = $ch; $intag = 1; } else { $txt .= $ch; } } } # process a LINE # end of LINE, so add a space, as appropriate if ($intag) { $tag .= " " if (length($tag) && !($tag =~ /\s$/)); } else { $txt .= " " if (length($txt) && !($txt =~ /\s$/)); } } # process the FILE # ======================================================== if ($menu_count) { prt( "File has $menu_count Menu: items.\n" ); } if ($but_count) { prt( "File has $but_count 'button' items.\n" ); } prt("Done $lncnt lines, from [$inf]...\n"); if ($dep == 0) { if ($show_hash_counts) { show_count_hash(\%tag_list,"TAG LIST", \@menu_tags); show_count_hash(\%command_list,"COMMAND LIST", \@command_items); } @arr = sort keys(%files_processed); $acnt = scalar @arr; prt("Processed $acnt files, "); $lncnt = 0; foreach $key (@arr) { $val = $files_processed{$key}; $lncnt += ${$val}[1]; } prt("total of $lncnt lines...\n"); } } sub process_in_file($$) { my ($inf,$dep) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; my $dnfile = $inf; $dnfile = lc($dnfile) if ($os =~ /Win/); if (defined $files_processed{$dnfile}) { prtw("WARNING: Already processed [$inf]\n") if ($warn_already); return; } process_file_lines($inf,$dep,\@lines); } ######################################### ### MAIN ### parse_args(@ARGV); ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); process_in_file($in_file,0); pgm_exit(0,"Normal exit(0)"); ######################################## sub give_help { prt("$pgmname: version $pgm_version\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\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)"); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } # eof - template.pl