#!/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
