#!/usr/local/bin/perl -w
#	Produce Files from Templates using wwwalias for aliases
#	makeform TEMPLATE REALFILE OPTIONS
#
#	Recognize following special commands
#	{name} {value} {short} {full} {browse}
#	{loopindexone} which starts at 1 not 0 in numbering
#	{loopindexzero} which starts numbering at zero
#	{elementcount} increments by one each time encountered starting at zero
#			It records value before incrementing
#	{increment} increments {elementcount} without outputting
#	{length} which is total number of items
#	{select} {type} {othertype}
#	{browselist}
#	{browsetype}
#	{startloop}  (or {loop} ) {endloop}
#
#	If skip: key is set, then skip this option if skip value == REALFILE name
#
&readalias("wwwalias");
#
%procoptvocab =
 ( "name",0,"value",0,"short",0,"full",0,"browse",0,"skip",0,"type",0,
 "contd",0, "html",0,"endhtml",0);
#
$globalcount=0;
&readopt($ARGV[2]);
#
$list1=$ARGV[0];
open(TEMPLATEFILE,"<".$list1) || die("\nSorry couldn't open ",$list1,"\n");
$realfile=$ARGV[1];
open(REALFILE,">".$realfile) || die("\nSorry couldn't open ",$realfile,"\n");
@data=<TEMPLATEFILE>;
#
$skiptest = 'full';
$skiptest1 = 'full';
$skiptest = 'partial' if( $realfile eq 'OptionsFrame1.html' || $realfile eq 'FullOptionsFrame1.html' );
$skiptest = 'partial' if( $realfile eq 'Mainaddon' );
$skiptest1 = 'fullonly' if( $realfile eq 'OptionsFrame1.html' );
#
#	Set Template Command Variables
$classwww{"endloop" }= -2;
$classwww{"startloop"} = -1;
$classwww{"loop"} = -1;
$classwww{"name"} = 1;
$classwww{"value"} = 2;
$classwww{"short"} = 2;
$classwww{"full"} = 2;
$classwww{"browselist"} = 3;
$classwww{"select"} = 4;
$classwww{"loopindexone"} = 5;
$classwww{"length"} = 6;
$classwww{"type"} = 7;
$classwww{"othertype"} = 11;
$classwww{"loopindexzero"} = 8;
$classwww{"elementcount"} = 9;
$classwww{"optionformcount"} = 10;
$classwww{"quickoptionformcount"} = 12;
$classwww{"increment"} = 13;
$classwww{"browsetype"} = 14;
#
$elementcount =0;
$optionformcount=0;
$quickoptionformcount=0;
#
$loopsize=$globalcount;
$length = 0;
$lengthfont = 0;
$lengthcolor = 0;
for($looping=0; $looping<$globalcount ;$looping++)	{
	$key = $keytouse[$looping];
	$actualpos{$key} = $optionformcount;
	$quickactualpos{$key} = -1;
	if(defined($skip{$key}) )	{
		next if( $skip{$key} eq $skiptest );
		next if( $skip{$key} eq $skiptest1 );
	}
	unless( defined($skip{$key}) && ($skip{$key} eq 'fullonly') )	{
		$quickactualpos{$key} = $quickoptionformcount;
		$quickoptionformcount +=3;
		++$quickoptionformcount if(defined($browse{$key}));
	}
	$optionformcount +=3;
	++$optionformcount if(defined($browse{$key}));
	++$length;
	++$lengthfont	if( defined($type{$key}) && ($type{$key} =~ m%font%) );
	++$lengthcolor	if( defined($type{$key}) && ($type{$key} =~ m%color%) );
}
#
#	Loop over template lines
$lasti=@data;
#
PRINTWWW1:
for($i=0;$i<$lasti;$i++)        {
	$looping = -1;
	$key = 'Error';
#
PRINTWWW2:
	for($loop=$i; $loop < $lasti ; $loop++) {
       		$end=$data[$loop];
       		chomp($end);
		$lineacc='';
		$selected = 1;
		$selected = 0 if($looping >= $loopsize);
		while($end)     {
			if( &curlyscan($end) )  {
				$lineacc .= $begin;
				$testwww=$classwww{$tag};
				if( $testwww == -1 )    { # startloop
					++$looping;
					$key = $keytouse[$looping];
					undef($browsefile);
					while( )	{
						last unless(defined($skip{$key}) );
						last unless( ($skip{$key} eq $skiptest) || ($skip{$key} eq $skiptest1) );
						++$looping;
						last if( $looping >= $loopsize );
						$key = $keytouse[$looping];
						}
					next PRINTWWW2;
				}	
				if( $testwww == -2 )	{ # endloop
					goto PRINTWWW2 if( $looping < $loopsize-1 );
					$i=$loop;
					next PRINTWWW1;
				}
				next PRINTWWW2 unless $selected;
				$lineacc .= $key if( $testwww == 1);
				$lineacc .= eval( '$'.$tag.'{"'.$key.'"}' )	if( $testwww == 2 );
				if( $testwww == 3 )	{ 
					$browsefile = $browse{$key};
					next PRINTWWW2 unless defined($browsefile);
					if( $browsefile =~ m%^top% )	{
						$actualbrowsefile = $browsefile;
						++$elementcount;
						print REALFILE <<EOF
<script language="JavaScript">
<!--scriptbegin
$actualbrowsefile
//scriptend-->
</script>
EOF
					}
					else	{
						open(BROWSE,"<".$browsefile) || die("\nSorry couldn't open ",$browsefile,"\n");
						print REALFILE $lineacc,"\n" if($lineacc);
						$lineacc='';
						while($browseline = <BROWSE> )	{
							chomp($browseline);
							print REALFILE "<option>" . $browseline . "\n";
						}
						close(BROWSE);
					}
				}
				if( $testwww == 4 )	{ 	# {select}
					$browsefile = $browse{$key};
					if( defined($browsefile) )	{
						if( $browsefile =~ m%^button% )	{
							$selected=0 unless($tagvalue eq 'browsebutton');
						}
						elsif( $browsefile =~ m%^top% )	{
							$selected=0 unless($tagvalue eq 'browse' );
						}
						else	{
							$selected=0 unless( ($tagvalue eq 'browse') || ($tagvalue eq 'browsefile'));
						}
					}
					else	{
						$selected=0 unless($tagvalue eq 'notbrowse' );
					}
				}
				if( $testwww == 7 )     {	# {type}
					$typeval = $type{$key};
					if( defined($typeval) )	{
						$selected=0 unless($typeval =~ m%$tagvalue%);
						}
					else	{
						$selected = 0;
					}
				}
				if( $testwww == 11 )     {	# {othertype}
					$typeval = $type{$key};
					if( defined($typeval) )	{
						$selected=0;
						$selected=1 unless($typeval =~ m%$tagvalue%);
						}
					else	{
						$selected = 1;
					}
				}
				if( $testwww == 14 )     {      # {browsetype}
					die("$tag does not have browse file\n") unless(defined($browsefile));
					die("$tag does not have button ststus\n") unless( $browsefile =~ m%^button/(.*)$%) ;
					$browsetype = $1;
					$lineacc .= $browsetype;
				}
				$lineacc .= ($looping+1)	if( $testwww==5 );
				$lineacc .= $looping	if( $testwww==8 );
				if( ($testwww ==9) || ($testwww ==13) )	{
					$lineacc .= $elementcount if( $testwww ==9 );
					++$elementcount;
				}
				$lineacc .= $actualpos{$key} if( $testwww==10 );
				$lineacc .= $quickactualpos{$key} if( $testwww==12 );
				if( $testwww==6 )	{
					if( $tagvalue =~ m%font% )	{
						$lineacc .= $lengthfont;
					}
					elsif( $tagvalue =~ m%color% )      {
						$lineacc .= $lengthcolor;
					}
					else	{
						$lineacc .= $length;
					}
				}
#
			} # End successive calls to curlyscan in each line
			else    {
				$lineacc .= $begin;
				last;
			}
#
		} # End scan of line with while($end)
#
		next PRINTWWW2 unless $selected;
		print REALFILE $lineacc,"\n";
		last PRINTWWW2 unless( $looping > -1 );
	}	# end loop which is replicated if looping option set
#
}	# End loop reading lines of template
#
# End main routine
#
sub readalias	{ # Read alias file
#
	my($file)=@_;
#
	my($fullline);
#
	open(ALIAS,$file) || die("Sorry Couldnt read ALIAS ",$fullline," \n");
        while($fullline=<ALIAS>)        {
                chomp($fullline);
                &alias_decode('',$fullline);
        }
        close(ALIAS);
	&alias_cleanup;
}
#
sub alias_decode	{ # Decode alias definition
# key is EITHER in first argument or in first entry in value1@value2@  ..
# string transmitted as second argument
# if key is alias assume next entry in string is real key!
#
	my($key,$line)=@_;
	my(@fields,$test);
#
	@fields=split(/@/,$line);
	$test=$fields[0];
	$test =~ tr/A-Z/a-z/;
	shift(@fields)	if($test eq 'alias');
	$key=shift(@fields) unless $key;
	$key=shift(@fields) if $key eq 'alias';
#
	$wwwalias_url{$key}=$fields[0];
	if($fields[1])	{
		$wwwalias_title{$key}=&tohtml($fields[1]);
		$wwwalias_titlegiven{$key}=1;
	}
	else	{
		$wwwalias_title{$key}='At location ' . &tohtml($fields[0]);
		$wwwalias_titlegiven{$key}=0;
	}
	$wwwalias_comment{$key}= &tohtml($fields[2]);
	$wwwalias_author{$key}= &tohtml($fields[3]);
	$wwwalias_date{$key}= &tohtml($fields[4]);
#
}	# End alias_decode
#
sub alias_cleanup	{
#
	my($name,$replace);
#
	foreach $name (keys %wwwalias_url)	{
		$changed_alias=1;
		$replace=$wwwalias_url{$name};
		while( $changed_alias)	{
			$changed_alias=0;
			$replace=&alias_subst($replace);
		}
		$wwwalias_url{$name}=$replace;
	}
}	# End alias_cleanup
#
sub alias_subst	{
#
	my($total);
#
	$end_alias=$_[0];
	$total="";
	while($end_alias)	{
		if(&aliascurlyscan($end_alias))	{
			$total .= $begin_alias;
			if( $full=$wwwalias_url{$tag_alias} )	{
				if( &aliasroundbracket($end_alias) )	{
					$string_alias=$wwwalias_title{$tag_alias} unless $string_alias;
					$total .= '<a href="' . $full . '" >' . $string_alias . '</a>';
				}
				else	{
					$total .= $full;
				}
				++$changed_alias;
			}
			else	{
				$total .= '{' . $tag_alias . '}';
			}
			next;
		}
		else	{
			$total .= $begin_alias;
			last;
		}
	}	# End loop over curly brackets
	return $total;
#
}	# End alias_subst
#
sub aliasroundbracket	{
#
	$end_alias=$_[0];
	if( $end_alias =~ m%^\\\(%	)	{
		$end_alias =~ s/^.//;
		return 0;
	}
	if( $end_alias =~ m%^\(([^\(\)]*)\)(.*)% )	{
		$string_alias= $1;
		$end_alias=$2;
		return 1;
	}
	return 0;
#
}	# End aliasroundbracket
#
sub aliascurlyscan	{ 
#
	my($inline)=@_;
	my($line);
#
	$line=$inline;
	$begin_alias='';
	while($line)	{
#
		if( $line =~ m%([^{]*){([^}]*)}(.*)% 	)	{
			if( $1 =~ m%\\$% )	{
				$begin_alias .= $1 . '{';
				$line = $2.'}'.$3;
				next;
			}
			$begin_alias .= $1;
			$end_alias=$3;
			$tag_alias=$2;
			$tag_alias =~ s/\s*//g;
			return 1;
		}
		$begin_alias=$inline;
		$end_alias='';
		$tag_alias='';
		return 0;
	}	# End loop over starting {
	$begin_alias=$inline;
	return 0;
#
}	# End alias curly scan
#
# read dictionary from PROCOPTIONS
sub readopt {
#
	my($procfile)=@_;
	my($curkey,$vocabmem,$reading_html,$colon,$possiblekey,$savekey,$entry,$rest,$line);
#
	open(PROCOPTIONS,$procfile) || die("\nSorry couldnt Open Procoptions ",$procfile, "\n");
#
	$reading_html=0;	# Initial HTML option
	undef %optionvalues;
        $optionvalues{'name'}='NULL';
#
#
	$curkey='none';
	while( $line=<PROCOPTIONS> )	{
		chomp($line);
		$colon = index($line,":");
		if ( ($line =~ /^\s/) || $colon < 0 )	{
			die("\nIllegal Continuation Line", $rest,"\n") if $curkey eq 'none';
			$line =~ s/^\s+/ /;
			$optionvalues{$curkey} = &join($optionvalues{$curkey},$line);
			next;
		}
		$possiblekey = substr($line ,0, $colon);
		$possiblekey =~ s/\s+//g;
		$savekey=$possiblekey;
		$possiblekey =~ tr/A-Z/a-z/;
		&procname()	if($possiblekey eq 'name');
		$entry = -1;
		foreach  $vocabmem (keys %procoptvocab) {
			if( $possiblekey eq $vocabmem )	{
				$entry = $procoptvocab{$vocabmem};
				last;
			}
		}
		if( $entry < 0 )	{
			die("\nIllegal key Processing Options ", $possiblekey, "\n");	}	
		if( $possiblekey eq "html" )	{
			$reading_html=1;
			next;
		}
		if( $possiblekey eq "endhtml" )	{
			$reading_html=0;
			next;
		}
		$rest = substr($line, $colon+1);
		if( $possiblekey eq "contd" )	{
			if ($curkey eq 'none')	{
				die("\nIllegal Continuation Line", $rest,"\n");	}
			if( $savekey eq "CONTD" )	{
				$optionvalues{$curkey} .= "\n" . $rest;
				next;
			}
			$optionvalues{$curkey} = &join($optionvalues{$curkey},$rest);
			next;
		}
		$optionvalues{$possiblekey} = $rest;
		$optionvalues_html{$possiblekey} = $reading_html;
		$curkey=$possiblekey;
	}	# End loop over input lines
#
	&procname;
	close(PROCOPTIONS);
#
#
	return;
#
} # end readopt
sub procname	{ # Process shortcode
#
	my($key,$line);
#
	return if ($key=$optionvalues{'name'}) eq 'NULL';
	$inputorder{$key}= $globalcount;
	$keytouse[$globalcount]=$key;
	$globalcount++;
	$value{$key} = $optionvalues{'value'};
	$line= $optionvalues{'full'};
	$line = &tohtml($line)	unless $optionvalues_html{'full'};
	$full{$key}= &alias_subst($line);
	$line= $optionvalues{'short'};
	$line = &tohtml($line)	unless $optionvalues_html{'short'};
	$short{$key}= &alias_subst($line);
	$browse{$key} = $optionvalues{'browse'};
	$type{$key} = $optionvalues{'type'};
	$skip{$key} = $optionvalues{'skip'};
	undef %optionvalues;
	return;

}
#
sub tohtml	{ # Convert HTML magic characters in current line
	my($convline)=@_;

	return($convline)	unless $convline;
	$convline =~ s/&/&amp;/g;
	$convline =~ s/</&lt;/g;
	$convline =~ s/>/&gt;/g;
	$convline =~ s/"/&quot;/g;
	$convline;
}
#
# Process {tag=value} in templates
#
# Break up argument into $begin{$tag}$end finding first such pair
sub curlyscan	{ 
#
	my($inline)=@_;
	my($line);
#
	$line=$inline;
	$begin='';
	while($line)	{
#
		if( $line =~ m%([^{]*){([^}]*)}(.*)% 	)	{
			if( $1 =~ m%\\$% )	{
				$line =~ m%([^{]*){([^}]*)}(.*)%;
				$begin .= $1;
				$line = $2.'}'.$3;
				$begin =~ s%.$%%; # remove backslash
				$begin .=  '{';
				next;
			}
			$begin .= $1;
			$end=$3;
			$tag=$2;
			$tag =~ s/\s*//g;
			$tag =~ tr/A-Z/a-z/;
			if($tag =~ m%([^=]*)=(.*)%)	{
				$tag=$1;$tagvalue=$2;
			}
			else	{
				$tagvalue=0;
			}
			die("Illegal tag ",$tag," in ",$inline,"\n") unless $classwww{$tag};
			return 1;
		}
		$begin=$inline;
		$end='';
		$tag='';
		return 0;
	}	# End loop over starting {
	$begin=$inline;
	return 0;
#
}	# End curly scan
#
#       Join  2 lines together returning result
#       add white space as necessary
sub join        {
        my($a,$b) = @_;
        $a = $a . ' '   if( ($a =~ /\S$/) && ($b =~ /^\S/) ) ;
        return $a . $b ;
}
#
1;