#!/usr/bin/perl -w
#
# @(#) ReportValidationAuditTrail.sh 1.0
#
# Author: (Moron)
#
# Versie 1.0  16 oktober 2006

use strict;
use locale;
use Time::localtime;
use lib $ENV{AC_PERLLIB};
use Env;
use Utilities;

use IPC::Open3; 
use POSIX ":sys_wait_h"; 

# ... main program logic omitted as being off-topic
# ...

sub GetTag {
	my $fh = shift;
	my $pastNoise = 0;
	my ( $tag, $sts, $cnt, $twixt );
	do { # walk past comment tags e.g. <?version ... >
		Throw( $fh ); # walk past whitespace and "\n"s
		/^\</ or XMLerror( 'Format' );
		Step(); # step over one char 
		( $tag, $sts ) = AntiLex( $fh, '\W' );  # collect data until \W 
							# and then walk there
		unless( $pastNoise = $tag ) {
			( $cnt, $sts ) = AntiLex( $fh, '\>' );
			/^\>/ or XMLerror( 'Comment Unclosed By > ' );
			Step();
		}
	} until ( $pastNoise );
	Throw( $fh);
	my $assignments = {};
	ASSMNT: for ( my $assco = 0; !/^\>/; $assco++ ) {
		my $kwd;
		( $kwd, $sts ) = AntiLex( $fh, '\W', );
		unless ( $kwd )
		{
			# only valid way is no assignments
			( $assco || !/^\>/ ) and XMLerror( 'Format' );
			last ASSMNT;
		}
		Throw( $fh );
		( $cnt, $sts ) = AntiLex( $fh, '\=' );
		( $cnt || !$sts ) and XMLerror( 'Format' );
		Step();
		Throw( $fh );
		my $val = '';

		# error-check for something before quotes
		( $twixt, $sts ) = AntiLex( $fh, '\"' );
		Step();
		$twixt and XMLerror( 'Format' );
		do { # quotes loop
			( $cnt, $sts ) = AntiLex( $fh, '\"', '\\\"' );
			$sts or XMLerror( 'Unclosed Quote' );
			$val .= $cnt;
			length() or $_ = <$fh>;
		} until ( /^\"/ ); # i.e. include \" as part of string
		Step();
		$assignments -> { $kwd } = $val;
		Throw( $fh );
		length() or XMLerror( 'Unexpected End Of XML' );
	}
	Step();

	Throw( $fh );

	# case of simple value for current tag ...
	my $simple = '';
	/^</ or ( $simple, $sts ) = AntiLex( $fh, '<' );

	my @subtags = (); # collect nested tags to current tag
	while ( !$simple && /^\<(.)/ && ($1 ne '/' ) ) {
		push @subtags, GetTag( $fh );
		Throw( $fh );
	}

	AntiLex( $fh, '<' ); # * ... see comment below

	if ( /^\<\/(\w+)\>(.*)/ ) {
		( $1 eq $tag ) or XMLerror( 'Tag Nesting' );
		$_ = $2; # walk past closing tag.
		$simple and return { $tag => $simple };
		return { $tag => { ASSMNTS => $assignments,
				   SUBTAGS => \@subtags  } };
	}

	XMLerror( "Format" ); # anything okay between '*' and here was eliminated from suspicion.

} 

# subroutine to walk past whitespace.
sub Throw { return ( AntiLex( shift(), '\S' ) ); }

sub Step { # like chopping $_ but from the LEFT of the string
	s/^(.)//;
	return $1;
}

sub XMLerror {
	my $reason = shift;
	my @ct = split( "\n" );
	die "XML $reason Error: $ct[0]";
}

sub AntiLex { 	# - walk thru $_, reloading from optional fh if present, until
		#   matching one of a list of regexps
		# - eats the returned content from $_ ready for
		#   repeated calls to this routine by the calling parser
		#
		# to parse positively just give it negative regexps.
		# the purpose is to roll up a lexer and thrower into a trivial
		# piece of code.

	# - SYNOPSIS: ( $content, $status ) = AntiLex ( [fh], { pattern, ... } )

	my $fh = shift; # undef means simply: don't reload emptied $_ from file

	my $contents = '';
	while ( 1 ) {
		unless( defined() && length() ) {
			defined( $fh ) and $_ = <$fh>;
			$_ or return ( $contents, 0 );
			chomp;
		}
		for my $pat ( @_ ) {
			( /^($pat)(.*)$/ ) and return ( $contents, 1 );
		}
		$contents .= Step();
	} 
}