Generated: Sun Aug 21 11:11:26 2011 from showpiperxml.pl 2010/12/08 8.4 KB.
#!/usr/bin/perl -w # NAME: showpiperxml.pl # AIM: VERY SPECIFIC - Quikc output of an XML file contents... 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); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } # user variables my $in_file = ''; my $use_def_file = 1; my $def_file = 'C:\FG\27\data\Aircraft\pa24-250\help.xml'; my $dbg_x01 = 0; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; sub prt($) { print shift; } sub trim_leading($) { my ($ln) = shift; $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space return $ln; } sub trim_tailing($) { my ($ln) = shift; $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space return $ln; } sub trim_ends($) { my ($ln) = shift; $ln = trim_tailing($ln); # remove all TRAINING space $ln = trim_leading($ln); # remove all LEADING space return $ln; } sub trim_all { my ($ln) = shift; $ln =~ s/\n/ /gm; # replace CR (\n) $ln =~ s/\r/ /gm; # replace LF (\r) $ln =~ s/\t/ /g; # TAB(s) to a SPACE $ln = trim_ends($ln); $ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/); # all double space to SINGLE return $ln; } 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); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n") if ($dbg_x01); my ($line,$inc,$lnn,$len,$ch,$i,$pc,$i2,$nc,$intag,$tag,$incomm,$inkey); my ($ltag,$done,$type,$desc,$inline,$help); $lnn = 0; $ch = ''; $intag = 0; my @nlines = (); $tag = ''; $incomm = 0; $inkey = 0; my @tagstack = (); $desc = ''; $inline = 0; $help = ''; my @helplines = (); foreach $line (@lines) { chomp $line; $lnn++; #prt("$line\n"); $len = length($line); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pc = $ch; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ''; if ($intag) { if ($ch eq '>') { $type = 'text'; if (length($tag)) { push(@nlines,$tag); $done = 0; if ($tag =~ /^\?/) { # header $type = 'hdr'; } elsif ($tag =~ /^!--/) { $incomm = 1; $type = 'bgn.comm'; } elsif ($tag =~ /--$/) { $incomm = 0; $type = 'end.comm'; } elsif ($tag =~ /\/\s*$/) { # self closed tag $type = 'close'; } elsif ($tag =~ /^\//) { if (@tagstack) { $ltag = $tagstack[-1]; $tag = substr($tag,1); if ($tag eq 'key') { prt("$tag $desc\n") if (length($desc)); $inkey = 0; $desc = ''; } elsif ($tag eq 'line') { $inline = 0; $help = trim_all($help); if (length($help)) { push(@helplines,$help); prt("HELP: $help\n"); $help = ''; } } if ($tag eq $ltag) { prt("$lnn: [$tag] Close\n") if ($dbg_x01); $type = 'pop'; } else { prtw("$lnn: WARNING [$tag] [$ltag] Close\n"); $type = 'pop.err'; } pop @tagstack; $done = 1; } else { prtw("$lnn: WARNING [$tag] NO TAG STACK!\n"); $type = 'OOO'; } } else { push(@tagstack,$tag); prt("$lnn: [$tag] Open\n") if ($dbg_x01); $done = 1; $type = 'new'; if ($tag eq 'key') { $inkey = 1; } elsif ($inkey) { #$desc .= "$tag "; } elsif ($tag eq 'line') { $inline = 1; } } prt("$lnn: [$tag] $type\n") if (!$done && $dbg_x01); } $tag = ''; $intag = 0; } else { $tag .= $ch; } } else { if ($ch eq '<') { if (length($tag)) { push(@nlines,$tag); prt("$lnn: [$tag] text\n") if ($dbg_x01); if ($inkey) { $tag = trim_all($tag); $desc .= "$tag " if (length($tag)); } elsif ($inline) { $tag = trim_all($tag); $help .= "$tag " if (length($tag)); } } $tag = ''; $intag = 1; } else { $tag .= $ch; } } } } if (length($tag)) { push(@nlines,$tag); prt("$lnn: [$tag]\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); process_in_file($in_file); pgm_exit(0,""); ######################################## sub give_help { prt("$pgmname: version 0.0.1 2010-09-11\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) && $use_def_file) { $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