# #######################################################################
# Emdlparser.pm version 0.5.0: Part of the emdl2umenu.pl program.
#   Reads and parses an EMDL file, and places the info in a
#   Menutree object.
#
#   Copyright (C) 2002 by Steve Litt (slitt@troubleshooters.com)
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; version 2 of the License.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Steve Litt, slitt@troubleshooters.com, http://www.troubleshooters.com
# #######################################################################
# #######################################################################
# HISTORY
# 	Version 0.5.0, 3/5/2002
# 		Initial distribution
# #######################################################################
use strict;

package Parser;
#############################################################################
#############################################################################
#############################################################################
# The Parser object parses the intput file. This parser parses an
# EMDL 1.0 file.
#############################################################################
sub new($$)
	{
	my($type) = $_[0];
	my($self) = {};
	my($temp);
	$self->{'inputfilename'} = $_[1];
	$self->{'menutree'} = $_[2];

	$self->{'logfilename'} = "emdlparser.log";
	$self->{'initialmenustring'} = '';
	$self->{'reader'} = Reader->new($self->{'inputfilename'});
	$self->{'inparams'} = 0;
	$self->{'paramstartlevel'} = 99999;
	$self->{'previousmenulevel'} = 99999;
	$self->{'currentmenuid'} = "01";
	$self->{'currentmenuletterpath'} = "^";
	bless($self, $type);
	return($self);
	}

#############################################################################
# Various methods to handle errors, warnings, and logging
#############################################################################
sub appendLog($$)
	{
	my($self) = $_[0];
	my($msg) = $_[1];
	my($initialNewlines) = $_[2];

        my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time);
	my($timestamp) = sprintf("%04d/%02d/%02d @ %02d:%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec);
	my($message) = sprintf("%s, line %05d: msg=%s<, line=%s<\n",
		$timestamp,
		$self->getInputLineNumberOnesBased(),
		$msg,
		$self->{'reader'}->thisLine(),
		);

	my($newlineString) = "";
	while($initialNewlines > 0)
		{
		$newlineString .= "\n";
		$initialNewlines--;
		}
	$message = $newlineString . $message;
	
	open(LOG, ">>" . $self->{'logfilename'});
	print $message;
	print LOG $message;
	close(LOG);
	}

sub parseWarning($)
	{
	my($self)=$_[0];
	my($message) = "PARSE WARNING: >$_[1]<";
	$self->appendLog("$message", 0);
	}

sub parseError($)
	{
	my($self)=$_[0];
	my($message) = "PARSE ERROR: >$_[1]<";
	$self->appendLog("$message", 0);
	$self->{'menutree'}->invalidate();
	}

sub parseProgrammerError($)
	{
	my($self)=$_[0];
	my($message) = "FATAL PROGRAMMER ERROR: SUBMIT BUG REPORT: >$_[1]<";
	$self->appendLog("$message", 0);
	$self->{'menutree'}->invalidate();
	}

sub parseFatalError($)
	{
	my($self)=$_[0];
	my($message) = "FATAL PARSE ERROR: >$_[1]<";
	$self->appendLog("$message", 0);
	$self->{'menutree'}->invalidate();
	die;
	}

sub parseInfoMessage($$)
	{
	my($self)=$_[0];
	my($message) = "PARSE INFORMATION: >" . $_[1] . "<";
	$self->appendLog("$message", $_[2]);
	}

#############################################################################
# Various utility methods
#############################################################################
sub do_nothing(){}

sub getInputLineNumberOnesBased(){return $_[0]->{'reader'}->getLineNo() + 1;}
sub getInputLine(){return $_[0]->{'reader'}->thisLine();}

sub ID2level($)
	{
	my($length) = int(length($_[1]));
	$length = int($length/2);
	$length = int($length - 1);
	return $length;
#	return int((length($_[1])/2) - 1); # root menu is level 0
	}


#############################################################################
# isSignificant() returns whether an input line is significant or not.
# Comments and blank lines are insignificant, all else is significant.
#############################################################################
sub isSignificant()
	{
	my($self)=$_[0];
	if(($self->{'type'} eq "COMMENT") || ($self->{'type'} eq "BLANK"))
		{return 0;}
	else
		{return 1;}
	}


#############################################################################
# Various methods associated with input line levels
#############################################################################
sub getLevel($)
	{
	my($self)=$_[0];
	$_[1] =~ m/^(	*)/;
	if(defined($1))
		{return length($1);}
	else
		{return 0;}
	}

#############################################################################
# Various methods dealing with Menu ID's. The Menu ID is a string comprised
# of multiple two digit numbers, and are constructed such that every
# menu can have 100 submenus, with each Menu ID being unique. This is
# necessary for menu systems allowing multiple menu choices with the
# same letter.
# 
# For the purpose of a Menutree object, the Menu ID is the unique key
# identifying a specific menu.
#############################################################################
sub appendMenuID($) { return $_[1] . '01'; }

sub trimMenuID($$)
	{
	my($self)=$_[0];
	my($base) = $_[1];
	my($ss) = $_[2];


	while($ss > 0)
		{
		$base =~ m/(.*)..$/;
		$base = $1;
		$ss--;
		if(scalar($base) < 1)
			{$self->parseProgrammerError("Illegal trimming of numeric menu ID!");}
		}
	return $base;
	}

sub incMenuID($)
	{
	my($self)=$_[0];
	
	$_[1] =~ m/^(.*)(..)$/;
	my($base) = $1;
	my($int) = int($2) + 1;
	my($temp) = "00000" . $int;
	$temp =~ m/(..)$/;
	return  $base . $1;
	}


#############################################################################
# Various methods associated with menu letter paths
# Some menu systems (such as UMENU) use letter paths
# to identify menus (or menu definition files). Such menuing
# systems cannot handle multiple menu choices with the same letter.
# The letter path is the letter path of the root menu
# plus the letters pressed to navigate to the current menu
#############################################################################

sub incMenuLetterPath($$)
	{
	my($self)=$_[0];
	$_[1] =~ m/^(.*).$/;
	my($base) = $1;
	my($return) = $base . $_[2];
	return  $return;
	}

sub appendMenuLetterPath($$){return $_[1] . $_[2];}

sub trimMenuLetterPath($$)
	{
	my($self)=$_[0];
	my($base) = $_[1];
	my($ss) = $_[2];

	while($ss > 0)
		{
		$base =~ m/(.*).$/;
		$base = $1;
		$ss--;
		if(length($base) < 1)
			{
			$self->parseProgrammerError("Illegal trimming of menu letter path\ncall programmer!");
			}
		}
	return $base;
	}

#############################################################################
# Various methods to accomplish parsing
# These methods depend on each other, are complex, and should not be
# modified without considerable understanding.
#############################################################################
sub parseParameterLine($)
	{
	my($self)=$_[0]; 
	my($line)=$_[1];

	my($key) = "ERROR";
	my($value) = "undefined";

	unless($line =~ m/^\s*(.)\s*:\s*(.*)\s*$/)
		{
		$self->parseError("Malformed Parameter Line, line ignored");
		}
	else
		{
		($key,$value) = (uc($1), $2);
		unless($key =~ m/^[A-Za-z#=]$/)
			{
			$self->parseError("Bad parameter key letter, line ignored: >$key<! ");
			$key = "ERROR";
			$value = "undefined";
			}
		else
			{
			if($key eq "C")
				{
				$key = "COMMAND";
				}
			}
		}
	return($key,$value);
	}

sub getLineType($$)
	{
	my($self)=$_[0];
	my($line) = $_[1];
	my($menuLevel) = $_[2];

	my($level) = $self->getLevel($line);
	my($type) = "undefined";

	if($self->{'inparams'} != 0)
		{
		if($level > $self->{'paramstartlevel'})
			{
			$type = "PARAMETER";
			$self->{'inParams'} = 2;
			if($level > $self->{'paramstartlevel'} + 1)
				{
				$self->parseError("Overly indented parameter");
				}
			}
		else
			{
			$type = "UNDEFINED";
			$self->{'inparams'} = 0;
			$self->{'paramstartlevel'} = 9999;
			}
		}

	if($line =~ m/^\s*$/) {$type = "BLANK";}
	elsif($line =~ m/^\s*#/) {$type = "COMMENT";}
	elsif($line =~ m/^___EOF___$/) {$type = "EOF";}
	elsif($line =~ m/^___BOF___$/) {$type = "BOF";}
	elsif(($line =~ m/:::/) && ($type ne 'PARAMETER'))
		{
		$type = "MENU";
		}
	elsif($line =~ m/^\s*params?/)
		{
		$type = "PARAMSTART";
		$self->{'inparams'} = 1;
		$self->{'paramstartlevel'} = $level;
		}
	elsif($type ne "PARAMETER")
		{$type = 'CHOICE';}
	return($type);
	}


sub parseChoiceLine($)
	{
	my($self)=$_[0];
	my($letter) = '';
	my($text) = '';
	my($menuTitle) = '';
	my($quitFlag) = 0;
	
	$_[1] =~ m/^\s*(.*)\s*$/;
	my($line)=$1;
	if($line =~ m/^(.*)\s*:::\s*(.*)$/)
		{
		$menuTitle = $2;
		my($temp) = $1;
		$line = $temp;
		}
	
	if($line =~ m/^\^(.*)/)
		{
		$line = $1;
		$quitFlag=1;
		}
	if($line =~ m/^_L(.)_(.*)$/)
		{
		$letter = $1;
		$line = $2;
		}
	elsif($line =~ m/^(.*)&(\S)(.*)\s*/)
		{
		$letter = $2;
		$line = $1 . $2 . $3;
		}
	elsif($line =~ m/([A-Z])/)
		{
		$letter = $1;
		}
	else
		{
		$line =~ m/^(.)/;
		$letter = $1;
		}
	if($quitFlag) {$line = "^" . $line;}
	$letter = uc($letter);
	$text = $line;
		
	return(($letter,$text,$menuTitle));
	}


sub parse()
	{
	my($self)=$_[0];
	$self->parseInfoMessage("STARTING PARSE...",3);
	my($level);
	my($line);
	my($lineType);
	while (1)
		{
		$line = $self->{'reader'}->nextLine();
		$level = $self->getLevel($line);
		$lineType = $self->getLineType($line,$level);
		if($lineType eq 'MENU')
			{last;}
		}
	$line =~ m/^\s*(.*)\s*:::(.*)\s*$/;
	my($currentMenuLetterPath) = $1;
	$self->{'initialmenustring'} = $currentMenuLetterPath;
	my($menuTitle) = $2;

	my($temp) = '01';
	$self->{'menutree'}->appendMenu($temp, $currentMenuLetterPath, $menuTitle);
	my($previousMenuID) = $temp;
	my($parentMenuID) = $temp;

	$line = $self->{'reader'}->nextLine();

	while(1)
		{
		$level = $self->getLevel($line);
		my($lineType) = $self->getLineType($line,$level);
#		$self->parseErrorCheck($level,$lineType);


		if($lineType eq 'BLANK')
			{$self->do_nothing();}
		elsif($lineType eq 'COMMENT')
			{$self->do_nothing();}
		elsif($lineType eq 'PARAMSTART')
			{$self->do_nothing();}
		elsif($lineType eq 'EOF')
			{last;}
		elsif($lineType eq 'BOF')
			{$self->parseProgrammerError("BOF encountered!<\n");}
		elsif($lineType eq 'CHOICE')
			{
			my($letter,$text,$menuTitle) = $self->parseChoiceLine($line);
			my($previousMenuLevel) = $self->ID2level($previousMenuID);
			my($subservientChoiceLevel) = $previousMenuLevel + 1;
			if($level < $subservientChoiceLevel)
				{
				$parentMenuID = $self->trimMenuID($previousMenuID, $subservientChoiceLevel - $level);
				}
			elsif($level == $subservientChoiceLevel)
				{
				$parentMenuID = $previousMenuID;
				}
			else
				{
				$self->parseFatalError("Overly indented choice");
				}
			my($flag) = "";
			if($text =~ m/^\^(.*)/)
				{
				$text=$1;
				$flag="QUIT";
				}
			$self->{'menutree'}->appendChoice($parentMenuID,$letter,$text,$menuTitle);
			if($flag eq 'QUIT')
				{
				$self->{'menutree'}->{'menus'}->{$parentMenuID}->thisChoiceObject()->setCommand('^');
				}
			}
		elsif($lineType eq 'PARAMETER')
			{
			my($key,$value) = $self->parseParameterLine($line);
			if($key eq "COMMAND")
				{
				$self->{'menutree'}->{'menus'}->{$parentMenuID}->thisChoiceObject()->setCommand($value);
				}
			elsif($key ne 'ERROR')
				{
				# Parameter parse errors were already logged in parseParameterLine().
				$self->{'menutree'}->appendParameter($parentMenuID, $key, $value);
				}
			}
		elsif($lineType eq 'MENU')
			{
			my($letter,$text,$menuTitle) = $self->parseChoiceLine($line);
			my($previousMenuLevel) = $self->ID2level($previousMenuID);
			my($subservientChoiceLevel) = $previousMenuLevel + 1;
			if($level < $subservientChoiceLevel)
				{
				$parentMenuID = $self->trimMenuID($previousMenuID, $subservientChoiceLevel - $level);
				}
			elsif($level == $subservientChoiceLevel)
				{
				$parentMenuID = $previousMenuID;
				}

			$self->{'menutree'}->appendChoice($parentMenuID,$letter,$text,$menuTitle);

			if($level == $previousMenuLevel)
				{
				$previousMenuID = $self->incMenuID($previousMenuID);
				$currentMenuLetterPath = $self->incMenuLetterPath($currentMenuLetterPath, $letter);
				}
			elsif($level < $previousMenuLevel)
				{
				$previousMenuID = $self->trimMenuID($previousMenuID, $previousMenuLevel - $level);
				$previousMenuID = $self->incMenuID($previousMenuID);

				$currentMenuLetterPath = $self->trimMenuLetterPath($currentMenuLetterPath, $previousMenuLevel - $level);
				$currentMenuLetterPath = $self->incMenuLetterPath($currentMenuLetterPath, $letter);
				}
			elsif($level == $previousMenuLevel + 1)
				{
				$previousMenuID = $self->appendMenuID($previousMenuID);
				$currentMenuLetterPath = $self->appendMenuLetterPath($currentMenuLetterPath, $letter);
				}
			else
				{
				$self->parseFatalError("Doubly indented menu: lev=>$level<, prevMenulev=>$previousMenuLevel !");
				}
			
			my($string) = $self->{'menutree'}->appendMenu($previousMenuID, $currentMenuLetterPath, $menuTitle);
			if($string eq 'EXISTS')
				{
				parseError("Attempt to append menu $previousMenuID ($currentMenuLetterPath) failed -- it already exists");
				}
			}
		else
			{
			$self->parseError("BOGUS linetype=>$lineType<");
			}
		$line = $self->{'reader'}->nextLine();
		}
	}

return 1;
