#!/usr/local/bin/perl -w
#	Produce Files from Templates using wwwalias for aliases
#	makeform OPTIONS
#
#	Recognize following special commands on style file specified as filename:XXXX
#	in OPTIONS input
#	{title} {titlesize} {baretitle} {rest} {restsize}
#	{family} {childfamily} {world} {view} {path} {multimedia} {style} {urlstem} {search}
#	{addon} {slaveversion}
#       {select}
#	{childurls}
#
&readalias("wwwalias");
&readalias("javaalias");
#
#
#	Set Template Command Variables
$classwww{"select"} = 3;
$classwww{"view"} = 1;
$classwww{"path"} = 1;
$classwww{"title"} = 2;
$classwww{"baretitle"} = 2;
$classwww{"titlesize"} = 2;
$classwww{"rest"} = 2;
$classwww{"restsize"} = 2;
$classwww{"family"} = 2;
$classwww{"childfamily"} = 2;
$classwww{"slaveversion"} = 2;
$classwww{"body"} = 2;
$classwww{"urlstem"} = 2;
$classwww{"search"} = 2;
$classwww{"world"} = 2;
$classwww{"multimedia"} = 2;
$classwww{"addon"} = 2;
$classwww{"style"} = 2;
$classwww{"childurls"} = 4;
$aliasnotsimple=0;
#
%procoptvocab =
 ( "filename",0,"title",0,"rest",0,"restfile",0,"family",0,"childfamily",0,"world",0,"style",0,"multimedia",0,"urlstem",0,"search",0,"baretitle",0,"addon",0,"slaveversion",0,
 "view",1,"path",1,"target",0,"template",0,
 "contd",0, "html",0,"endhtml",0);
#
&readopt($ARGV[0]);
#
# 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)	{
		next if $wwwalias_url{$name} =~ /^JAVASCRIPT/;
		$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,$firsttag);
#
	$end_alias=$_[0];
	$total="";
	while($end_alias)	{
		if(&aliascurlyscan($end_alias))	{
			$total .= $begin_alias;
			if( $full=$wwwalias_url{$tag_alias} )	{
				if( $full =~ m%^JAVASCRIPT$% )	{
					$firsttag ='';
					$firsttag = '\'<font color=\'' if( $tag_alias =~ m%color% );
					$firsttag = '\'<font size=\'' if( $tag_alias =~ m%size% );
					$firsttag = '\'<body background=\'' if( $tag_alias =~ m%bgfile% );
					$total .= "\n<script language='JavaScript'>\n<!--scriptbegin\n<!--scriptbegin\ndocument.writeln( $firsttag + top.bigboss.currentparameters.$tag_alias + ' >');\n//scriptend-->\n</script>\n";
				}
				elsif( $full =~ m%^JAVASCRIPTTITLE$% )  {
					&aliasroundbracket($end_alias);
					unless( $string_alias )	{
						die("Illegal Alias $total *and* $string_alias\n");
					}
					$total .= "\n<script language='JavaScript'>\n<!--scriptbegin\n<!--scriptbegin\ntop.bigboss.foilsettitle(self," . &protectquote($string_alias) . ");\n";
				}
				else	{
					if( &aliasroundbracket($end_alias) )	{
						$string_alias=$wwwalias_title{$tag_alias} unless $string_alias;
						$total .= '<a ';
						$total .= 'onMouseOver="top.bigboss.maybedontclick();" onclick="top.bigboss.pleasedontclick(self);" ' if($aliasnotsimple);
						$total .= '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{'filename'}='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 'filename');
		$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;
		}
		if( $entry == 1	)	{
			if( defined($optionvalues{$possiblekey}) )	{
				$count = ++$optioncount{$possiblekey};
				$optionarray[$count-1]{$possiblekey} = $optionvalues{$possiblekey};
				$optionarray_html[$count-1]{$possiblekey} = $optionvalues_html{$possiblekey};
			}
			else	{
				$optioncount{$possiblekey}=0;
			}
		}
		$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,$title,$titlesize,$restline,$getfromfile,$locallasti,@localdata,$restsize,$family,$childfamily,$world,$style,$multimedia,$slaveversion,$body,$urlstem,$search,$baretitle,$addon,$view,$path,$realfile,$i,$testwww,$lineacc,$grab,$vocabmem);
#
	return if ($key=$optionvalues{'filename'}) eq 'NULL';
#
	foreach  $vocabmem (keys %procoptvocab) {
		next unless $procoptvocab{$vocabmem}==1;
		if( defined($optionvalues{$vocabmem}) )	{
			$count = ++$optioncount{$vocabmem};
			$optionarray[$count-1]{$vocabmem} = $optionvalues{$vocabmem};
			$optionarray_html[$count-1]{$vocabmem} = $optionvalues_html{$vocabmem};
		}
		else	{
			$optioncount{$vocabmem}=0;
		}
	}
#
#	if $target defined we are probably processing an index!
	$aliasnotsimple=1;
	$aliasnotsimple = 0 if( $key =~ 'imple' );
	$target= $optionvalues{'target'};
	$target= '' unless(defined($target));
	if( $target )	{
		$aliasnotsimple = 0;
		$target=' target="' . $target . '" ';
	}
#
	$title = $optionvalues{'title'};
	$baretitle = $title;
	$title = &protectquote($title);
	$title = &tohtml($title)      unless $optionvalues_html{'title'};
	$titlesize = &setcharactersize($title,$optionvalues_html{'title'},'');
	$restline= $optionvalues{'rest'};
	$restlinehtml = 0;
	if(defined($restline))	{
		$restline = &tohtml($line)	unless $optionvalues_html{'rest'};
		$restline = &alias_subst($restline);
		$restlinehtml = $optionvalues_html{'rest'};
	}
	else	{
		$restline ='';
	}
	$getfromfile = $optionvalues{'restfile'};
	if(defined($getfromfile))	{
		$restlinehtml = $optionvalues_html{'restfile'};
		open(INFILE,"<".$getfromfile) || die("\nSorry couldn't open ",$getfromfile,"\n");
		@localdata=<INFILE>;
		$locallasti=@localdata;
		close(INFILE);
		for( $i=0; $i < $locallasti; $i++ )	{
			$line=$localdata[$i];
			chomp($line);
			$line = &tohtml($line)  unless $optionvalues_html{'restfile'};
			$line = &alias_subst($line);
			$restline .= "\n" if($restline);
			$restline .= $line;
		}
	}
#
#	Process link commands
	$linkset=0;
	$rest = &analyserest($restline);
	$restsize = &setcharactersize($rest,$restlinehtml,'');
	$family = $optionvalues{'family'};
	$childfamily = $optionvalues{'childfamily'};
	$world = $optionvalues{'world'};
	$body = $optionvalues{'body'};
	$style = $optionvalues{'style'};
	$multimedia = $optionvalues{'multimedia'};
	$addon = $optionvalues{'addon'};
	$slaveversion = $optionvalues{'slaveversion'};
	$urlstem = $optionvalues{'urlstem'};
	$search = $optionvalues{'search'};
	$view = $optioncount{'view'};
	$path = $optioncount{'path'};
	$realfile =$optionvalues{'filename'};
#
	if( defined($list1=$optionvalues{'template'}) )	{
		open(TEMPLATEFILE,"<".$list1) || die("\nSorry couldn't open ",$list1,"\n");
		@data=<TEMPLATEFILE>;
		$lasti=@data;
	}
#
#	Process data for this file!
#
#	Loop over file make commands
	open(REALFILE,">".$realfile) || die("\nSorry couldn't open ",$realfile,"\n");
#
#	Loop over template lines
PRINTWWW:
	for($i=0;$i<$lasti;$i++)        {
		$loopsize =1;
		for( $looping=0; $looping < $loopsize; $looping++)	{
			$end=$data[$i];
		      	chomp($end);
			$lineacc='';
			while($end)     {
				if( &curlyscan($end) )  {
					$lineacc .= $begin;
					$testwww = $classwww{$tag};
					if( $testwww == 3 )	{
						$grab= eval('$'.$tagvalue);
						next PRINTWWW unless( defined( $grab ) );
						next PRINTWWW if( $grab eq '');
						if( $classwww{$tagvalue} == 1)	{
							next PRINTWWW if( $grab == 0 );
						}
					}
					if( $testwww == 1)	{
						$loopsize = eval('$'.$tag );
						$grab = eval('$optionarray[' . $looping . ']{"'. $tag .'"}');
						$grab =~s/,/","/;
						$lineacc .= $grab;
					}
					if( $testwww == 4 )	{
						print REALFILE $lineacc,"\n" if($lineacc);
						$lineacc='';
						for( $child=0; $child< $linkset; $child++)	{
							print REALFILE 'top.bigboss.AccumulateIndex("child","' . $linkurls[$child] . '",'.$linkurlsdisabled[$child].');',"\n";
							if( $linkurlsdisabled[$child] > 0 )	{
								print REALFILE 'top.bigboss.AccumulateIndex("childtitle","' .  $linktitle[$child].'");',"\n";
							}
						}
					}
					$lineacc .= eval( '$'.$tag )	if( $testwww == 2 );
				} # End successive calls to curlyscan in each line
				else    {
					$lineacc .= $begin;
					last;
				}
#
			} # End scan of line with while($end)
#
			print REALFILE $lineacc,"\n" ;
		}	# End loop over $looping
#
	}	# End loop reading lines of template
#
	close(REALFILE);
#
	undef $optionvalues{'filename'};
	undef $optionvalues{'template'};
	undef $optionvalues_html{'filename'};
	undef $optionvalues{'view'};
	undef $optionvalues_html{'view'};
	undef $optionvalues{'path'};
	undef $optionvalues_html{'path'};
	undef $optionvalues{'rest'};
	undef $optionvalues_html{'rest'};
	undef $optionvalues{'restfile'};
	undef $optionvalues_html{'restfile'};
	undef $optionvalues{'urlstem'};
	undef $optionvalues_html{'urlstem'};
	undef $optionvalues{'search'};
	undef $optionvalues_html{'search'};
	undef $optionvalues{'addon'};
	undef $optionvalues_html{'addon'};
	undef $optionvalues{'slaveversion'};
	undef $optionvalues_html{'slaveversion'};
	undef %optionarray;
	undef %optionarray_html;
	undef %optioncount;
#
	return;
}
#
#	Analyse line for links used in an index
sub	analyserest	{
#
	my($filelines)=@_;
	my($newrest,$crlf,$nextline,$one,$two);
#
	$newrest ='';
	while($filelines)	{
		$crlf = index($filelines,"\n");
		if( $crlf < 0 )	{
			$nextline = $filelines;
			$filelines='';
		}
		else	{
			$nextline = substr($filelines,0,$crlf);
			$filelines = substr($filelines,$crlf+1);
		}
		if( $nextline =~ m%^link:\s*\{([^\}]*)\}(.*)% )	{
			$one=$1;
			$two=$2;
			$linkurls[$linkset]=$one;
			$linkurlsdisabled[$linkset]=0;
			$linktitle[$linkset] = &protectquote($two);
			++$linkset;
			$nextline = '<a href="" onClick="top.bigboss.seturlfromindex(this,' . $linkset . ',\'' . $one . '\',0)"' . $target . ' > ' . $two . '</a>';
		}
		if( $nextline =~ m%^linkdisabled:\s*\{([^\}]*)\}(.*)% )	{
			$one=$1;
			$two=$2;
			$linkurls[$linkset]=$one;
			$linkurlsdisabled[$linkset]=1;
			$linktitle[$linkset] = &protectquote($two);
			++$linkset;
			$nextline = '<a href="" onClick="top.bigboss.seturlfromindex(this,' . $linkset . ',\'' . $one . '\',1)"' . $target . ' > ' . $two . '</a>';
		}
		elsif( $target )	{
			$nextline =~ s%href=%${target}href=%;
		}
		$newrest .= $nextline."\n";
	}
	return $newrest;
#
}	# End analyserest
#
#       Protect quotes in String
sub protectquote        { # return backslashed string
#
        my($dangerous)=@_;
        $dangerous =~ s/([^\\])'/$1\\'/g;
        $dangerous =~ s/([^\\])"/$1\\"/g;
        return $dangerous;
#
}       # End protectquote
#
sub setcharactersize	{ # return additional character string info
#
	my($charstring,$html,$currentsummary)=@_;
	my($count,$left,$begin,$num,$newpos);
	$count=0;
#
	if($html == 1 )	{	# This has HTML tags
		$charstring =~ s%<[^>]*>%%g;
	}	# End removing tag data
	$begin=0;
	$left=length($charstring);
	while( ($newpos = index($charstring,"\n",$begin)) > -1 )	{ # Newlines embedded
		$num=$newpos-$begin;
		if( $num > 0 )	{
			++$count;
			if($count >10)	{
				$count=1;
				$currentsummary .=")\ntop.bigboss.textsize(\'contd\'";
			}
			$currentsummary .= ',' ;
			$currentsummary .= $num;
		}
		$left -= ($num+1);
		$begin=$newpos+1;
	}
	if($left>0)	{ # No newlines/remainder
		$currentsummary .= ',' ;
		$currentsummary .= $left;
	}
	return $currentsummary;
#
}	# End setcharactersize
#
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%\\$% )	{
				$begin .= $1 . '{';
				$line = $2.'}'.$3;
				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;
