package PerlInHTML ;
#
# Authors: Theodore Norvell and Depok Parai
# Contact: Theodore Norvell (theo@engr.mun.ca)
# Copyright: Theodore S. Norvell 1999, 2000
# Licence: Permission is granted to use this software as is
# with no modification. You may redistribute this software as
# is, as long as the copyright information and this notice
# remain attached.  You may also modify this software and
# its derivitives and you may redistribute modified copies.
# But if you do so, you must attach a prominent notice that
# it has been modified and you must leave this notice and
# the original copyright notice intact.
# The authors disclaim that this software is fit for
# any purpose whatsoever, and can not be held responsible
# for any data lost owing to its use or misuse.  That
# said, I find it rather useful for my own purposes.

###############
# Exporting information
###############

# use strict ;

BEGIN {
	use Exporter () ;
	use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	$VERSION     = 0.00;
	@ISA         = qw(Exporter);
	@EXPORT      = qw(&makeHTML &includeBody &put
			  &includeHTML &html2perl &evalWarn);
 	%EXPORT_TAGS = ( ); 
	@EXPORT_OK   = qw();
}

############################
# Constant values          #
############################

my $letter = '[a-zA-Z]' ;          # Element names start with a letter
my $moreElement = '[^\\s>]' ;   # Any non-whitespace other than > can be in an element name
my $elementName = "$letter$moreElement*" ;
my $whitespace = '\\s' ;
my $whitespaceNL = '(\\s|\\n)' ;	 # Spaces separate </ from the element name
my $inQuotes = '[^\']*' ;           # Any char except ' can appear in single quotes
my $inDQuotes = '[^"]*' ;           # Any char except " can appear in double quotes
# Attributes are optional.
# If present they must start with one or more whitespaces.
# Thereafter any character is allowed except >.
# Quotes must match.
# The > may appear within quotes

###This was trouble###$attributes = "(\\s+([^'\">]*|('$inQuotes'|\"$inDQuotes\"|)*)*)?" ;

my $attributes = "((\\s+([^'\">]|'$inQuotes'|\"$inDQuotes\")*)?)" ;

#Start tags.
my $startTag = "<($elementName)$attributes>" ;
my $startPTag = "<p$attributes>" ;
my $startBRTag = "<br$attributes>" ;
my $startBodyTag = "<body$attributes>";

#End tags.
my $endTag = "<\\/$whitespace*($elementName)$attributes>" ;
my $endPTag = "<\\/$whitespace*P$attributes>";
my $endBodyTag ="<\\/$whitespace*body$attributes>";


###################################
#  Subroutines (Exported or not)  #
###################################

sub includeHTML 
# See spec.
{
	my $inputFile= @_[0];
	my $inputText = "" ;
	unless (open INHANDLE, $inputFile )
	{ 
		print STDERR "Can't open $inputFile :, $!\n";
		return 0 ; 
	}
	while( <INHANDLE> )
	{    
		$inputText = $inputText . $_ ;
	}

	my $perlString = html2perl( $inputText ) ;
	if( "0" eq $perlString ) 
	{
		return 0 ;
	}
	else
	{
		return evalWarn( $perlString ) ; 
	}
}

sub  includeBody 
# See spec.
{
	my $inputFile= @_[0];
	my $inputText = "" ;
	unless (open INHANDLE, $inputFile )
	{ 
		print STDERR "Can't open $inputFile :, $!\n";
		return 0 ; 
	}
	while ( <INHANDLE> )
	{    
		$inputText = $inputText . $_ ;
	}
	
	if( $inputText =~/$startBodyTag((.|\n)*)$endBodyTag/i )
	{
		$inputText = $4;
	}

	#print "IncludeBody: input text is $inputText\n" ;
	my $perlString = html2perl( $inputText ) ;
	if( "0" eq $perlString ) 
	{
		return 0 ;
	}
	else
	{
		#print "IncludeBody: perl text is $perlString\n" ;
		return evalWarn( $perlString ) ; 
	}
}

sub makeHTML
#  See spec.
{
	my $inputFile = @_[0];
	my $outputFile = @_[1];
	my $inputText = "" ;
	unless (open INHANDLE, $inputFile )
	{ 
		print STDERR "Can't open $inputFile :, $!\n";
		return 0 ; 
	}
	unless (open OUTPUT, ">$outputFile")
	{ 
		print STDERR "Could not open $outputFile :, $!\n";
		return 0 ; 
	}
	while(<INHANDLE>)
	{
		$inputText = $inputText . $_ ;
	}

	#print "input text is $inputText\n" ;
	my $perlString = html2perl( $inputText ) ;
	if( "0" eq $perlString ) 
	{
		return 0 ;
	}
	else
	{
		#print "perl text is $perlString\n" ;
		my $evaluatedOutputString = evalWarn( $perlString ) ;
		#print "evaluated output is $evaluatedOutputString\n" ; 
		print  OUTPUT "$evaluatedOutputString" ; 
		return 1 ;
	}
}

sub  put
#   See spec.
{
	my $i ;
	foreach $i (@_)
	{
		$PerlInHTML::zzz .= $i ;
	}
	return 1 ;
}


sub escape
#  Input parameter:  a string
#  The ouput is the same as the input, but with each backslash replaced by
#  two backslashes and each single quote replaced by a backslash, single quote.
{
    $_ = @_[0];
    s/\\/\\\\/g ;
    s/'/\\'/g ;
    $_ ; 
}

sub html2perl
#  Input parameter: remainingInput
#  Output: The converted text (see specification).
{
	my $remainingInput= @_[0];
	#output: Convertedtext
	my $outputString ="";
	my $rest ;
	my $closeDelim ;
	my $success ;
	($success, $outputString, $rest, $closeDelim)
		= convertHTMLwithPerl($remainingInput);
	
	if ($success)
	{
		if( $rest eq "" && $closeDelim eq "")
		{
			$outputString
			 = '{package main; local $PerlInHTML::zzz ;'
			   . "\n"  . $outputString.  ' $PerlInHTML::zzz ;}';
			return $outputString;
		}
		else
		{
			print "SYNTAX ERROR: Unexpected $closeDelim\n";
		}
	}
	else
	{
		return 0;
	}
}

sub convertHTMLwithPerl
#  Input parameter: remainingInput
#  Outputs: 0 -- A success flag
#           1 -- The converted text
#           2 -- The remaining input
#           3 -- The closing delimiter
{
	my $remainingInput= @_[0];
	#output: success, convertedtext, remainingInput, closeDelim
	my $outputString = "";
	my $found ;
	my $firstPart ;
	my $delimiter ;
	my $rest ;
	#print "Entering convertHTMLwithPerl. \$remainingInput is $remainingInput\n" ;
	while( $remainingInput ne "")
	{
		#print "In convertHTMLwithPerl, at top of loop. \$remainingInput is $remainingInput\n" ;
		my $found ;
		my $firstPart ;
		my $delimiter ;
		my $rest ;
		($found, $firstPart, $delimiter, $rest)
			= FindDelimiter($remainingInput);
		#print "After FindDelimiter. \$found is $found, \$firstPart is $firstPart, \$delimiter is $delimiter\n" ;
		
		if (! $found)
		{
			$outputString .= convertHTML($remainingInput);
			$remainingInput = "" ;
		}

		elsif ($delimiter eq "(*") 
		{
			$outputString .= convertHTML($firstPart);
			my $success ;
			my $convertedText ;
			my $closeDelim ;
			($success, $convertedText, $remainingInput, $closeDelim)
				= convertPerlWithHTML($rest);
			$outputString .= $convertedText . ";\n";

			if (! $success)
			{
				return (0, $outputString, $rest, "");
			}
			if ($closeDelim ne "*)")
			{
				print "SYNTAX ERROR: Missing *) \n"; 
				return (0, $outputString, $rest, "");
			}
		}
		elsif ( $delimiter eq "(**" )
		{
			$firstPart = stripTrailingPTag ( $firstPart ); 
			$outputString .= convertHTML( $firstPart );
			my $success ;
			my $convertedText ;
			my $closeDelim ;
			($success, $convertedText, $remainingInput, $closeDelim)
				= convertPerlWithHTML($rest);
			$outputString .= $convertedText . ";\n"; 
			
			if (! $success)
			{
				return (0, $outputString, $rest, "");
			}
			if ($closeDelim ne  "**)")
			{
				print "SYNTAX ERROR: Missing  **)";
				return (0, $outputString, $rest, "");
			} 
			$remainingInput = stripLeadingPTag ( $remainingInput );
		}

		elsif ( $delimiter eq "(!" )
		{
			$outputString .= convertHTML($firstPart);
			my $success ;
			my $convertedText ;
			my $closeDelim ; 
			($success, $convertedText, $remainingInput, $closeDelim)
				 = convertPerlWithHTML($rest);
			#print "In convertHTMLwithPerl. Processing (!. Returned from convertPerlWithHTML with '$convertedText'\n" ; 
			$outputString .= ' $PerlInHTML::zzz .= ('.$convertedText.");\n";

			if ( ! $success )
			{
				return (0, $outputString, $rest, "");
			}
			if ( $closeDelim ne "!)" )
			{
				print "SYNTAX ERROR: Expected !)\n";
				return (0, $outputString, $rest, "");
			} 
		}

		elsif ( $delimiter eq "(!!" )
		{
			$firstPart = stripTrailingPTag ( $firstPart ); 
			$outputString .= convertHTML($firstPart);
			my $success ;
			my $convertedText ;
			my $closeDelim ;
			($success, $convertedText, $remainingInput, $closeDelim)
				 = convertPerlWithHTML($rest);
			$outputString .= ' $PerlInHTML::zzz .= ('.$convertedText.");\n";
			
			if(! $success)
			{
				return (0, $outputString, $rest, "");
			}
			if ( $closeDelim ne "!!)" )
			{
				print "SYNTAX ERROR: Missing  !!)";
				return (0, $outputString, $rest, "");
			}
			$remainingInput= stripLeadingPTag ( $remainingInput );
		}

		elsif ( ( $delimiter eq "?)" ) || ( $delimiter eq "??)" ) )
		{
			if ( $delimiter eq "??)" ) 
			{
				#print "Stripping trailing P tag\n" ;
				$firstPart = stripTrailingPTag ( $firstPart );
				#print "\$firstPart is now $firstPart.\n" ;
			}
			$outputString .= convertHTML($firstPart);
			return (1, $outputString, $rest, $delimiter);
		}

		else
		{
			print "SYNTAX ERROR: Missing Delimiter\n";
			return (0, $outputString, $rest, ""); 
		}
	}
	return (1, $outputString, "" , "");
} 

sub convertHTML      
#  Input parameter:  remainingInput
#  Output: The converted text
{
	my $remainingInput = @_[0];
	#Output: Converted text.
	my $outputString = "" ; 
	while( $remainingInput ne "" )
	{ 
		if($remainingInput =~/(.*)\n((.|\n)*)/)  
		{
			my $firstLine = $1 ; 
            		my $rest = $2 ;
            		$outputString .= '  $PerlInHTML::zzz .= \''
				       . (escape $firstLine)
				       . "\'; \n" ;
            		$outputString .= '  $PerlInHTML::zzz .= "\n" ;' . "\n";
            		$remainingInput = $rest;
            	}
		else 
		{ 
			$outputString .= '  $PerlInHTML::zzz .= \''
				       . (escape $remainingInput)
				       . "\'; \n";
			$remainingInput = "";
		}			
	}
	return $outputString;
}

sub convertPerlWithHTML
#  Input parameter:  remainingInput
#  Outputs: 0 -- A success flag
#           1 -- The converted text
#           2 -- The remaining input
#           3 -- The closing delimiter.
{
	my $remainingInput = @_[0];
	#Output: Success, Convertedtext, remainingInput, Closedelimiter.
	my $outputString = "" ;
	#print "Entering convertPerlWithHTML. \$remainingInput is $remainingInput\n" ;
	while( $remainingInput ne "" )
	{
		my $found ;
		my $firstPart ;
		my $delimiter ;
		my $rest ;
		($found, $firstPart, $delimiter, $rest)
			= FindDelimiter($remainingInput);
	 	
		if (! $found) 
		{
			$outputString .= convertPerl($remainingInput);
			$remainingInput = "";
		}

		elsif ( $delimiter eq "(?" )
		{
			$outputString .= convertPerl($firstPart);
			my $success ; 
			my $convertedText ;
			my $closeDelim ; 
			($success, $convertedText, $remainingInput, $closeDelim)
			  = convertHTMLwithPerl($rest);
			#print "In convertPerlWithHTML. Processing (?. Returned from convertHTMLwithPerl with ($success, $convertedText, $remainingInput, $closeDelim)\n" ;
			$outputString .=
			   '(PerlInHTML::evalWarn \' {package main; local $PerlInHTML::zzz; '
			   . (escape $convertedText)
			   . '; $PerlInHTML::zzz; }\')' ;
			
			if (! $success)
			{
				return (0, $outputString, $rest, "");
			}
			if ( $closeDelim ne "?)" )  
			{
				print "SYNTAX ERROR: Expected ?)\n";
				return (0, $outputString, $rest, "");
			}
		}

		elsif ( $delimiter eq "(??" )
		{
			$outputString .= convertPerl ($firstPart );
			$rest = stripLeadingPTag ( $rest );
			my $success ; 
			my $convertedText ;
			my $closeDelim ;
			($success, $convertedText, $remainingInput, $closeDelim)
			 = convertHTMLwithPerl ( $rest );
			$outputString .=
			   '(PerlInHTML::evalWarn \' {package main; local $PerlInHTML::zzz; '
			   . (escape $convertedText)
			   . '; $PerlInHTML::zzz; }\')' ;
				
			if (! $success) 
			{
				return (0, $outputString,$rest , "");
			}
			if ( $closeDelim ne  "??)" )
			{
				print "SYNTAX ERROR: Missing ??) ";
				return (0, $outputString, $rest, "");
			}
		}

		elsif (   $delimiter eq "*)" || $delimiter eq "!)"
                       || $delimiter eq "**)" || $delimiter eq "!!)" )
		{
			$outputString .= convertPerl($firstPart);
			return (1, $outputString, $rest, $delimiter);
		}
		else 
		{
			print "SYNTAX ERROR: Unexpected '$delimiter'\n";
			return (0, $outputString, $rest, "");
		}
	}
	 return (1, $outputString, "", "");
}

sub convertPerl
#  Input parameter: remainingInput
#  Output: The converted text.
{

	my $remainingInput = @_[0];
	$remainingInput =~ s/\n/ /g ;
	
	
#Start tags. 
	
	$remainingInput =~ s/$startPTag/\n/gi ;
	$remainingInput =~ s/$startBRTag/\n/gi ;
	$remainingInput =~ s/$startTag//gi ;
	
#End tags.

	$remainingInput =~ s/$endTag//gi ;
	$remainingInput =~ s/$endPTag//gi ;


#Entity references.
	
	$remainingInput =~ s/&lt;?/</gi ;
	$remainingInput =~ s/&gt;?/>/gi ;
	$remainingInput =~ s/&quot;?/"/gi ;
	$remainingInput =~ s/&amp;?/&/gi ;
	$remainingInput =~ s/&nbsp;?/ /gi ;
	$remainingInput =~ s/&ensp;?/ /gi ;
	$remainingInput =~ s/&emsp;?/ /gi ;
	$remainingInput =~ s/&thinsp;?/ /gi ;
	$remainingInput =~ s/&ndash;?/-/gi ;
	$remainingInput =~ s/&mdash;?/-/gi ;
	$remainingInput =~ s/&lsqua;?/'/gi ;
	$remainingInput =~ s/&rsquo;?/'/gi ;
	$remainingInput =~ s/&ldquo;?/"/gi ;
	$remainingInput =~ s/&rdquo;?/"/gi ;
	
	return $remainingInput;
}

sub FindDelimiter
#  Input parameter: remainingInput
#  Try to find the first occurence of any of "(*", "*)", "(!", "!)", "(?", "?)"
#          "(**", "**)", "(!!", "!!)", "(??", "??)",  in the remainingInput.
#  if none is found
#          return (0, "", "", "")
#  else
#          return (1, everything up to the delimiter, the delimiter,
#                     everything after the delimiter)

{	
	my $remainingInput = @_[0];
	#print "Searching for delimiter\n" ;
	
	if ($remainingInput =~ /  \(\*\*
	                       |  \*\*\)
	                       |  \(\*
	                       |  \*\)
	                       |  \(\?\?
	                       |  \?\?\)
	                       |  \(\?
	                       |  \?\)
	                       |  \(!!
	                       |  !!\)
	                       |  \(!
	                       |  !\)
			       /x
	)
	{
		#print "\ndelimiter is found PREMATCH is $`, MATCH is $&, POSTMATCH is $'\n";
		return (1, $`, $&, $') ;
	}
	else 
	{
		#print "delimiters couldnot found\n";
		return (0, $remainingInput, "", "");
	}
}

sub stripLeadingPTag
{
#  InputParamter: inputString
#  Output: the input, but with any leading </P> tag removed along with any
#  surrounding spaces, tabs, and newlines.

	my $InputString = @_[0];
	$InputString =~ s/^$whitespaceNL* $endPTag $whitespaceNL* //xi;
	return $InputString;
}

sub stripTrailingPTag
{
#  InputParamter: inputString
#  Output: the input, but with any trailing <P> tag removed along with any
#  surrounding spaces, tabs, and newlines.
	
	my $InputString = @_[0];
	#print "In stripTrailingPTag. \$InputString is $InputString.\n" ;
	#print "Pattern is / $whitespaceNL* $startPTag $whitespaceNL* \$/\n" ;
	$InputString =~ s/ $whitespaceNL* $startPTag $whitespaceNL* $ //xi;
	#print "Leaving stripTrailingPTag. \$InputString is $InputString.\n" ;
	return $InputString;
}

sub evalWarn
{
#   Input parameter:  A string to be evaluated.
#   Output: The result of the evaluation.
#   Effect:  A warning is printed if there is an error in the evaluation.
	my $result = eval @_[0] ;
	if( $@ ) {
		warn $@ ;
		print STDERR @_[0], "\n" ; }
	return $result ;
}
1; # END OF FILE.