fg_menu_xml.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional