#!/usr/bin/perl

# QuizMaster
# By Kagan D. MacTane (kmactane@GothPunk.com)
# version 0.5 (03/31/2000) First deployed on GothPunk.com(Munity) server.

# TODO: 
#
# 1) Add support for specific comments based on specific answers
#    to particular questions;
# 2) Add support for answer values based on other values;
# 3) Allow skipping of questions based on user answers;
# 4) Allow "fake" min/max range displays;
# 5) Make it capable of scoring on multiple axes (useful for Kiersey
#    and other complex surveys).


# ----  Standard options can be set here.  -----------

# The directory where quiz stuff is kept. QuizMaster
# assumes quiz files are here unless its initiating
# form input explicitly specifies a path to a quiz file.

$Base_Dir = $ENV{DOCUMENT_ROOT}.'/quizzes/';

# The page on the server to return to after a
# quiz is done. Leave blank to have it go to
# http://www.server-name.tld/
#
# However, many sites have a big, splashy logo or
# something on that page, and then direct visitors
# to an inner, "core" page such as main.html. If
# this is so for your site, you'll want to set
# this so that people finishing up quizzes can go
# directly there and skip the intro stuff.

# $ServerMainPage = '/main.html';
$ServerMainPage = '';

# ----  End of standard options. Start execution.  -----------


# Emit your HTML MIME-type header now and get it out of
# the way. We'll start procrastinating later.

print "Content-type: text/html\n\n";


# Get the input via POST method.

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);

# Now convert from HTML/URL to ASCII.

foreach $pair (@pairs)
{
     ($name, $value) = split(/=/, $pair);
     $name  =~ tr/+/ /;
     $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
     $value =~ tr/+/ /;
     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
     $value =~ s/<!--(.|\n)*-->//g;
     $Form{$name} = $value;
}

# Make sure a quiz name was supplied.

if ($Form{QuizName} eq '')
{
	&Error_Message("No quiz name was supplied.");
	exit 1;
}


# Save the file name of the quiz, with some changes...

$QuizTitle = $Form{QuizName};

if ($QuizTitle =~ m.^/.)
{
	$QuizTitle = reverse $QuizTitle;
	$QuizTitle = reverse substr($QuizTitle, 0, index($QuizTitle, '/'));
}

if ($QuizTitle !~ /[A-Z]/)
{
	$QuizTitle =~ tr/-_./ /s;
	@foo = split(/\s+/, $QuizTitle);
	foreach (@foo)
	{
		$_ = ucfirst unless (/^(a|the|and?|of|in|on|by|it)$/);
	}
	$QuizTitle = join(' ', @foo);
}

if ($QuizTitle =~ /[a-z]/ && $QuizTitle =~ /[A-Z]/)
{
	$QuizTitle =~ s/[^^]([A-Z])/ $1/g;
	$QuizTitle = ucfirst($QuizTitle);
}


# Look in the Base_Dir if no path was supplied, and verify that
# the quiz file exists and is readable.


if ($Form{QuizName} !~ m.^/.) { $Form{QuizName} = $Base_Dir.$Form{QuizName}; }

unless (-e $Form{QuizName})
{
	&Error_Message("There is no quiz file $Form{QuizName}!");
	exit 1;
}

unless (-r $Form{QuizName})
{
	&Error_Message("I can't read the quiz file $Form{QuizName}!");
	exit 1;
}

unless (-s $Form{QuizName})
{
	&Error_Message("There is no information in the $Form{QuizName} quiz file!");
	exit 1;
}




# Now read the [Default] section from the quiz file.

&ReadSection(Default);

# And take more comprehensive action based on the contents
# (if any) of the QuestionNum value gleaned from the form.


# If QuestionNum is undefined, you just came from the initial
# form. If there's an Intro, show that; otherwise, show
# Question1. If there's no Question1, scream, barf and die.

if ($Form{QuestionNum} eq '')
{
	# The ReadSection subroutine arranges the information from
	# the specified section in the %Display_This hash, setting
	# the DblCheck key if successful.
	
	# Save the location you just came from so it can be used at the end.
	$Form{OrigDoc} = $ENV{HTTP_REFERER} if ($Form{OrigDoc} eq '');

	&ReadSection(Introduction);
	$Form{QuestionNum} = 0;
	if ($Display_This{DblCheck} eq '')
	{
		$Form{QuestionNum} = 1;
		&ReadSection(Question1);
		if ($Display_This{DblCheck} eq '')
		{
			&Error_Message("There is no starting question in this quiz! Aborting!");
			exit 1;
		}
	}
	
	# Set the starting tally number.
	$Tally = 0;
	&Display_It;
}

# A QuestionNum of zero means you just came from the Introduction.
elsif ($Form{QuestionNum} == 0)
{
	# Save the location you just came from so it can be used at the end.
	$Form{OrigDoc} = $ENV{HTTP_REFERER} if ($Form{OrigDoc} eq '');

	$Form{QuestionNum} = 1;
	&ReadSection(Question1);
	if ($Display_This{DblCheck} eq '')
	{
		&ErrorMessage("There is no starting question in this quiz! Aborting!");
		exit 1;
	}
	$Tally = 0 unless (defined $Tally);
	&Display_It;
}

# Otherwise, we're somewhere in the middle of a quiz.
else
{
	# The UpdateTally subroutine reads the content of the
	# AnswerN controls on the question just completed (in
	# %Form) and performs arithmetic to increment or decre-
	# ment the $Tally variable.
	&UpdateTally;
	++$Form{QuestionNum};
	&ReadSection("Question$Form{QuestionNum}");
	if ($Display_This{DblCheck} eq '')
	{
		&ReadSection(Evaluation);

		# Do whatever you do here...
		&Display_Evaluation;

		exit 0;
	}
	else
	{
		&Display_It;
	}
}

exit 0;



# ---------------------------------------------------------------
# --------------------- End of main routine. --------------------
# ---------------------------------------------------------------



sub Error_Message {

	local $message = $_[0];

	local $server_name = $ENV{SERVER_NAME};
	$server_name = substr($server_name, 4) if ($server_name =~ /^www\./i);

	#print "Content-type: text/html\n\n";
	
	print <<EOF;
<HTML>

<HEAD>
<TITLE>Quiz-Master Error!</title>
</head>

<BODY bgcolor="#FFFFFF" text="#CC0000">

<H1>Quiz-Master Error!</h1>

<P>$message
</p>
<P>Please contact the <A HREF="mailto:webmaster\@$server_name">server administrator</a>.
</p>

</body>

</html>

EOF

}

# ---------------------------------------------------------------

sub ReadSection {

local $section_to_read = $_[0];

   if ($section_to_read eq 'Default')    { $hash_name = 'Default'; }
elsif ($section_to_read eq 'Evaluation') { $hash_name = 'Evaluation'; }
 else                                    { $hash_name = 'Display_This'; }


# Unset some variables.

#undef %{$hash_name};
#undef @{$hash_name.'-QuestionText'};
#if ($hash_name eq 'Default')
#{
#	print "UNDEFining Default-ExtraText, array of $#{Default-ExtraText} elements!<BR>\n";
#}

#undef @{$hash_name.'-ExtraText'};
$$hash_name{DblCheck} = '';
$latch = 0;
$last_key = '';


# Open the file and get to the beginning of the requested section.

open QUIZ, "$Form{QuizName}" || die "Couldn't open quiz file! $!";

while (<QUIZ>)
{
	last if (/^\[$section_to_read\]/);
}

# Now read the stuff in that section into the proper hash.

while (<QUIZ>)
{
	chomp($_);
	s/[\r\n]//g;

	# If you hit the next section, save any ExtraText continuation
	# line you might have hanging about and bail out of the loop.

	if (/^\[(Default|Evaluation|Introduction|Question\d+)\]/)
	{
		if ($key =~ /ExtraText/)
		{
			if ($last_key =~ /^Answer(\d+)/)
			{
				push(@{'Interstitial'.$1}, $$hash_name{$key});
			} else {
				push(@{$hash_name.'-'.$key}, $$hash_name{$key});
			}
		}
		last;
	} else {

		# Ignore comment lines and blank lines.

		unless (/^[;\#]/ || length($_) == 0)
		{
			if ($latch)
			{
				# Beware! The upcoming regex is really ugly.
				if (/^(Body(Background|BgColor|Text|[AV]?Link)|FontFace|Question(Text|Type)|Answer\d+((Anti)?Value|Text|Control|Modifier(Name|Value))|DefaultAnswer|Range\d+(Cap|(Extra)?Text)|(Min|Max)Desc|(SubmitButton|Extra|Title|First)Text)/)
				{
					$latch = 0;
					if ($key =~ /ExtraText/)
					{
						if ($last_key =~ /^Answer(\d+)/)
						{
							push(@{'Interstitial'.$1}, $$hash_name{$key});
						} else {
							push(@{$hash_name.'-'.$key}, $$hash_name{$key});
						}
					}
					($key, $value) = split(/\s*=\s*/, $_, 2);
					if ($key =~ /(Question|Extra|Range\d+(Extra)?)Text/)
					{
						$latch = 1;
					} else {
						$last_key = $key;
					}
					$$hash_name{$key} = $value;
				} else {
					$$hash_name{$key} .= ' '.$_;
				}
			} else {
				($key, $value) = split(/\s*\=\s*/, $_, 2);
				if ($key =~ /(Question|Extra|Range\d+(Extra)?)Text/)
				{
					$latch = 1;
				} else {
					$last_key = $key;
				}
				$$hash_name{$key} = $value;
				$$hash_name{DblCheck} = 'check' if ($value);
			}
		}
	}
}

# And save any ExtraText continuations hanging at the end
# of the file.

if ($key =~ /ExtraText/)
{
	if ($last_key =~ /^Answer(\d+)/)
	{
		push(@{'Interstitial'.$1}, $$hash_name{$key}) unless (@{'Interstitial'.$1}[$#{'Interstitial'.$1}] eq $$hash_name{$key});
	} else {
		push(@{$hash_name.'-'.$key}, $$hash_name{$key}) unless (@{$hash_name.'-'.$key}[$#{$hash_name.'-'.$key}] eq $$hash_name{$key});
	}
}


close QUIZ;

#
#print "<H3>Called with \[$section_to_read\], output going to \%$hash_name.</h3>\n\n";
#
#print "<P>Here are the contents of the \%$hash_name hash:\n</p>\n";
#
#print "<TABLE BORDER>\n";
#
#foreach (sort keys %{$hash_name})
#{
#	print "<TR>\n\t<TH ALIGN=right VALIGN=top>$_</td>\n";
#	print "\t<TD VALIGN=top>$$hash_name{$_}</td>\n</tr>\n";
#}
#
#print "</table>\n\n";
#
#if (defined @{$hash_name.'-QuestionText'})
#{
#	print "<P>The $hash_name-QuestionText array looks like this:\n</p>\n<UL>\n";
#	foreach (@{$hash_name.'-QuestionText'})
#	{
#		print "\t<LI>$_\n";
#	}
#	print "</ul>\n\n";
#}
#
#if (defined @{$hash_name.'-ExtraText'})
#{
#	print "<P>The $hash_name-ExtraText array looks like this:\n</p>\n<UL>\n";
#	foreach (@{$hash_name.'-ExtraText'})
#	{
#		print "\t<LI>$_\n";
#	}
#	print "</ul>\n\n";
#}
#
#if (defined @{$hash_name.'-Range2ExtraText'})
#{
#	print "<P>The $hash_name-Range2ExtraText array looks like this:\n</p>\n<UL>\n";
#	foreach (@{$hash_name.'-Range2ExtraText'})
#	{
#		print "\t<LI>$_\n";
#	}
#	print "</ul>\n\n";
#}
#
#print "\n\nExiting ReadSection.\n<HR>\n\n";
#

}


# ---------------------------------------------------------------

sub Display_It {

# This subroutine displays the contents of the %Display_This
# hash, and also throws in any persistent variables stored
# in hidden fields in the %Form hash.

print <<EOF;
<HTML>
<HEAD>
<TITLE>Quiz &quot;$QuizTitle&quot;, Question $Form{QuestionNum}</title>
</head>

EOF

# Get body tag attributes, if any.

local $BgColor    = $Display_This{BodyBgColor}    || $Default{BodyBgColor};
local $Background = $Display_This{BodyBackground} || $Default{BodyBackground};
local $Text       = $Display_This{BodyText}       || $Default{BodyText};
local $Link       = $Display_This{BodyLink}       || $Default{BodyLink};
local $ALink      = $Display_This{BodyALink}      || $Default{BodyALink};
local $VLink      = $Display_This{BodyVLink}      || $Default{BodyVLink};

unless ($BgColor eq '')
{
	if ($BgColor =~ /[^0-9A-F]/)
	{
		$BgColor = ' BGCOLOR="'.$BgColor.'"';
	} else {
		$BgColor = ' BGCOLOR="#'.$BgColor.'"';
	}
}

unless ($Text eq '')
{
	if ($Text =~ /[^0-9A-F]/)
	{
		$Text = ' TEXT="'.$Text.'"';
	} else {
		$Text = ' TEXT="#'.$Text.'"';
	}
}

unless ($Link eq '')
{
	if ($Link =~ /[^0-9A-F]/)
	{
		$Link = ' LINK="'.$Link.'"';
	} else {
		$Link = ' LINK="#'.$Link.'"';
	}
}

unless ($ALink eq '')
{
	if ($ALink =~ /[^0-9A-F]/)
	{
		$ALink = ' ALINK="'.$ALink.'"';
	} else {
		$ALink = ' ALINK="#'.$ALink.'"';
	}
}

unless ($VLink eq '')
{
	if ($VLink =~ /[^0-9A-F]/)
	{
	$VLink = ' VLINK="'.$VLink.'"';
	} else {
		$VLink = ' VLINK="#'.$VLink.'"';
	}
}


if ($Background =~ m.^/.)
{
	$Background = ' BACKGROUND="'.$Background.'"';
} else {
	$Background = '';
}


local $BodyTag = '<BODY'.$BgColor.$Background.$Text.$Link.$ALink.$VLink.'>';

print "$BodyTag\n\n";

# Now check on the default font face -- again, if any.

local $FontFace = $Display_This{FontFace} || $Default{FontFace};


local ($FO, $FC);

if (length($FontFace) > 0)
{
	# These stand for FontOpen and FontClose. I hate to shorten
	# variable names like this, but they're going to be typed
	# so fucking many times, everywhere, that I just refuse to
	# use my usual descriptive (long) names.

	$FO = '<FONT FACE="'.$FontFace.'">';
	$FC = '</font>';
} else {
	$FO = '';
	$FC = '';
}

if ($Display_This{TitleText} ne '')
{
	$QuestionString = $Display_This{TitleText};
} else {
	if ($Form{QuestionNum} < 1)
	{
		$QuestionString = 'Introduction';
	} else {
		$QuestionString = 'Question '.$Form{QuestionNum};
	}
}


print "<H1>${FO}$QuestionString${FC}</h1>\n\n";

print "<FORM ACTION=\"$ENV{SCRIPT_NAME}\" METHOD=\"POST\">\n\n";
#print "<FORM ACTION=\"/cgi-bin/display\" METHOD=\"POST\">\n\n";


foreach ('UserName','QuizName','QuestionNum','OrigDoc')
{
	print "<INPUT TYPE=\"Hidden\" NAME=\"$_\" VALUE=\"$Form{$_}\">\n";
}

print "<INPUT TYPE=\"Hidden\" NAME=\"Tally\" VALUE=\"$Form{Tally}\">\n\n";


# Now put in the actual Question Text, taking account for
# any FirstText directive.

$FirstText = $Display_This{FirstText} || $Default{FirstText};
if ($FirstText =~ /large/i)
{
	if (length($FO) > 0)
	{
		$SFO = substr($FO, 0, length($FO) - 1).' SIZE="+1"'.substr($FO, -1);
		$SFC = '</font>';
	} else {
		$SFO = '<FONT SIZE="+1">';
		$SFC = '</font>';
	}
} elsif ($FirstText =~ /small/i)
{
	if (length($FO) > 0)
	{
		$SFO = substr($FO, 0, length($FO) - 1).' SIZE="-1"'.substr($FO, -1);
		$SFC = '</font>';
	} else {
		$SFO = '<FONT SIZE="-1">';
		$SFC = '</font>';
	}
}
else
{
	$SFO = $FO;
	$SFC = $FC;
}

if (defined $Display_This{QuestionText})
{
	print "<P>${SFO}$Display_This{QuestionText}$SFC\n</p>\n";
}
elsif (defined $Default{QuestionText} && $Form{QuestionNum} > 0)
{
	print "<P>${SFO}$Default{QuestionText}$SFC\n</p>\n";
}



if (defined @{$hash_name.'-ExtraText'})
{
	foreach $num (0..$#{$hash_name.'-ExtraText'})
	{
		if ($Form{QuestionNum} < 1 && $num == 0)
		{
			print "<P>${SFO}${$hash_name.'-ExtraText'}[$num]$SFC\n";
		} else {
			print "<P>${FO}${$hash_name.'-ExtraText'}[$num]$FC\n";
		}
	}
}



if (defined @{'Default-ExtraText'} && $QuestionString =~ /^Question/)
{
	# Set the Default ExtraText(s) in <FONT SIZE="-1">, just
	# 'cause I think it looks better that way. The "SFO" 
	# variable stands for "Special Font Open", but of course
	# $FC can stay as it is.

	if (length($FO) > 0)
	{
		$SFO = substr($FO, 0, length($FO) - 1).' SIZE="-1"'.substr($FO, -1);
	} else {
		$SFO = '<FONT SIZE="-1">';
		$SFC = '</font>';
	}
	foreach (0..$#{'Default-ExtraText'})
	{
		print "<P>${SFO}${'Default-ExtraText'}[$_]$SFC\n</p>\n";
	}
}


# Now we start putting in the answers.


print "<BLOCKQUOTE>\n";


# First, see if there's any default type on the controls...

$QuestionType = $Display_This{QuestionType} || $Default{QuestionType};


if ($QuestionType eq 'YesNo')
{
	$DefaultControl = 'Radio';
	$Answer1Text    = 'Yes';
	$Answer2Text    = 'No';
}

if ($QuestionType eq 'TrueFalse')
{
	$DefaultControl = 'Radio';
	$Answer1Text    = 'True';
	$Answer2Text    = 'False';
}

if ($QuestionType eq 'SingleChoice')  { $DefaultControl = 'Radio'; }
if ($QuestionType eq 'MultipleChoice') { $DefaultControl = 'Checkbox'; }

$cur_name = 'ValQuestion'.$Form{QuestionNum};

#print "Display_This(QuestionType) equals $Display_This{QuestionType}.\n";

if ($Display_This{QuestionType} eq 'DropBox')
{
	$cur_control = 'DropBox';
	print "<SELECT NAME=\"$cur_name\">\n";
}




$cur = 1;
$Tally_Max = $Form{TallyMax};
$Tally_Min = $Form{TallyMin};
undef $this_max;
undef $this_min;

while (${'Answer'.$cur.'Text'} ne '' || $Display_This{'Answer'.$cur.'Text'} ne '')
{
	$cur_text = ${'Answer'.$cur.'Text'} || $Display_This{'Answer'.$cur.'Text'};
	$cur_control = ${'Answer'.$cur.'Control'} || $Display_This{'Answer'.$cur.'Control'} || $DefaultControl unless ($cur_control eq 'DropBox');
	$cur_value = ${'Answer'.$cur.'Value'} || $Display_This{'Answer'.$cur.'Value'} || $Default{'Answer'.$cur.'Value'};

#	print "This_max now $this_max, this_min now $this_min.<BR>\n";

	if ($cur_control =~ /Checkbox/i)
	{
		$cur_name = 'ValCheck'.$cur;
		if ($cur_value > 0)
		{
			$Tally_Max += $cur_value
		} else {
			$Tally_Min += $cur_value;
		}

#		print "Tally_Max now $Tally_Max, Tally_Min now $Tally_Min.<BR>\n";

	} elsif ($cur_control =~ /Radio/i)
	{
		$cur_name = 'ValQuestion'.$Form{QuestionNum};

		$this_max = $cur_value unless (defined $this_max);
		$this_min = $cur_value unless (defined $this_min);
		$this_max = $cur_value if ($cur_value > $this_max);
		$this_min = $cur_value if ($cur_value < $this_min);
		$this_min = 0 if ($this_min > 0);

	}

	if ($cur_control eq 'DropBox')
	{
		$this_max = $cur_value unless (defined $this_max);
		$this_min = $cur_value unless (defined $this_min);
		$this_max = $cur_value if ($cur_value > $this_max);
		$this_min = $cur_value if ($cur_value < $this_min);

		print "\t<OPTION VALUE=\"$cur_value\">$cur_text\n";
	} else {
		print "<INPUT TYPE=\"$cur_control\" NAME=\"$cur_name\" VALUE=\"$cur_value\">";
		print " ${FO}$cur_text$FC<BR>\n";

		if (defined @{'Interstitial'.$cur})
		{
			print "</blockquote>\n\n";
			foreach (0..$#{'Interstitial'.$cur})
			{
				print "<P>${FO}${'Interstitial'.$cur}[$_]$FC\n</p>\n";
			}
			print "\n<BLOCKQUOTE>\n";
		}
	}

	$cur++;
}

print "</select>\n\n" if ($cur_control eq 'DropBox');





print "\n</blockquote>\n\n";



#    --------------
#
#print "\n\n<HR>\n\n<P>Begin debugging information.\n</p>\n";
#
#print "<P>${FO}This is some test text to check font color and face. I hope it's as enjoyable for you as it is for me.${FC}\n</p>\n";
#
#print "<P>${FO}Here's the output of the \%Default hash:$FC\n</p>\n";
#
#print "<TABLE BORDER>\n";
#
#foreach (keys %Default)
#{
#	print "<TR>\n\t<TH VALIGN=top ALIGN=right>$FO$_$FC</th>\n\t<TD VALIGN=top>$FO$Default{$_}$FC</td>\n</tr>\n";
#}
#print "</table>\n\n";
#
#
#
#
#print "<P>${FO}Here's the output of the \%Display_This hash:$FC\n</p>\n";
#
#print "<TABLE BORDER>\n";
#
#foreach (keys %Display_This)
#{
#	print "<TR>\n\t<TH VALIGN=top ALIGN=right>$FO$_$FC</th>\n\t<TD VALIGN=top>$FO$Display_This{$_}$FC</td>\n</tr>\n";
#}
#print "</table>\n\n";
#
#
#
#
#
#
#print "<P>${FO}And finally, here's the output of the \%Form hash:$FC\n</p>\n";
#
#print "<TABLE BORDER>\n";
#
#foreach (keys %Form)
#{
#	print "<TR>\n\t<TH VALIGN=top ALIGN=right>$FO$_$FC</th>\n\t<TD VALIGN=top>$FO$Form{$_}$FC</td>\n</tr>\n";
#}
#print "</table>\n\n";
#
#
#if (defined @{$hash_name.'-ExtraText'})
#{
#	print "<P>${FO}Here are the contents of the ${hash_name}-ExtraText array:$FC\n</p>\n\n<UL>\n";
#	
#	foreach (@{$hash_name.'-ExtraText'})
#	{
#		print "\t<LI>${FO}$_$FC\n";
#	}
#	print "</ul>\n\n";
#}
#
#
#
#
#print "<P>${FO}Here are the contents of the Default-ExtraText array:$FC\n</p>\n\n<UL>\n";
#
#foreach (0..$#{'Default-ExtraText'})
#{
#	print "\t<LI>${FO}${'Default-ExtraText'}[$_]$FC\n";
#}
#print "</ul>\n\n";
#
#
#
#
#
#foreach $foo (0..9)
#{
#	if (defined @{'Interstitial'.$foo})
#	{
#		print "<P>${FO}The contents of array \@Interstitial$foo are:$FC\n</p>\n";
#		print "<UL>\n";
#		foreach (0..$#{'Interstitial'.$foo})
#		{
#			print "\t<LI>${FO}${'Interstitial'.$foo}[$_]${FC}\n";
#		}
#		print "</ul>\n\n";
#	}
#}
#
#
#
#
#print "<P>End debugging information.\n</p>\n<HR>\n";
#
#
#    --------------


$Tally_Max += $this_max;
$Tally_Min += $this_min;

print "<INPUT TYPE=\"Hidden\" NAME=\"TallyMax\" VALUE=\"$Tally_Max\">\n";
print "<INPUT TYPE=\"Hidden\" NAME=\"TallyMin\" VALUE=\"$Tally_Min\">\n\n";




# And finally, check on the text for the submit button.

local $SubmitButtonText = $Display_This{SubmitButtonText} || $Default{SubmitButtonText};

if (length($SubmitButtonText) < 1)
{
	$NextQuestion = $Form{QuestionNum} + 1;
	$SubmitButtonText = "Question \#$NextQuestion &gt;&gt;";
}


print "<P><INPUT TYPE=\"Submit\" VALUE=\"$SubmitButtonText\">\n\n";
print "</form>\n\n";




print "\n\n</body>\n</html>\n";

}



# ----------------------------------------------------

sub UpdateTally {


foreach (sort keys %Form)
{
	$Form{Tally} += $Form{$_} if (/^Val[A-Z]/);
}


}




# ----------------------------------------------------

sub Display_Evaluation {

# For now, we'll just do a little bit...

print <<EOF;
<HTML>

<HEAD>
<TITLE>Results of Quiz &quot;$QuizTitle&quot;</title>
</head>

EOF


# Get body tag attributes, if any.

local $BgColor    = $Display_Eval{BodyBgColor}    || $Default{BodyBgColor};
local $Background = $Display_Eval{BodyBackground} || $Default{BodyBackground};
local $Text       = $Display_Eval{BodyText}       || $Default{BodyText};
local $Link       = $Display_Eval{BodyLink}       || $Default{BodyLink};
local $ALink      = $Display_Eval{BodyALink}      || $Default{BodyALink};
local $VLink      = $Display_Eval{BodyVLink}      || $Default{BodyVLink};

$BgColor    =    ' BGCOLOR="#'.$BgColor.'"'    if (length($BgColor)    > 0);
$Background = ' BACKGROUND="#'.$Background.'"' if (length($Background) > 0);
$Text       =       ' TEXT="#'.$Text.'"'       if (length($Text)       > 0);
$Link       =       ' LINK="#'.$Link.'"'       if (length($Link)       > 0);
$ALink      =      ' ALINK="#'.$ALink.'"'      if (length($ALink)      > 0);
$VLink      =      ' VLINK="#'.$VLink.'"'      if (length($VLink)      > 0);

local $BodyTag = '<BODY'.$BgColor.$Background.$Text.$Link.$ALink.$VLink.'>';

print "$BodyTag\n\n";

# Now check on the default font face -- again, if any.

local $FontFace = $Display_Eval{FontFace} || $Default{FontFace};


local ($FO, $FC);

if (length($FontFace) > 0)
{
	# These stand for FontOpen and FontClose. I hate to shorten
	# variable names like this, but they're going to be typed
	# so fucking many times, everywhere, that I just refuse to
	# use my usual descriptive (long) names.

	$FO = '<FONT FACE="'.$FontFace.'">';
	$FC = '</font>';
} else {
	$FO = '';
	$FC = '';
}


if ($Evaluation{TitleText} ne '')
{
	print "<H1>${FO}$Evaluation{TitleText}${FC}</h1>\n\n";
} else {
	if ($Form{UserName})
	{
		print "<H1>${FO}Evaluation for $Form{UserName}${FC}</h1>\n\n";
	} else {
		print "<H1>${FO}Evaluation...${FC}</h1>\n\n";
	}
}

$FirstText = $Evaluation{FirstText} || $Default{FirstText};

unless($FirstText =~ /suppress/i)
{
	if ($FirstText =~ /large/i)
	{
		if (length($FO) > 0)
		{
			$SFO = substr($FO, 0, length($FO) - 1).' SIZE="+1"'.substr($FO, -1);
		} else {
			$SFO = '';
		}
	} elsif ($FirstText =~ /small/i)
	{
		if (length($FO) > 0)
		{
			$SFO = substr($FO, 0, length($FO) - 1).' SIZE="-1"'.substr($FO, -1);
		} else {
			$SFO = '';
		}
	}
	else
	{
		$SFO = $FO;
	}
	
	$Form{Tally} = 'zero' unless ($Form{Tally});

	print "<P>${SFO}You have scored $Form{Tally} points, out of a range from $Form{TallyMin} ";
	print "($Evaluation{MinDesc})" if ($Evaluation{MinDesc} ne '');
	print " to $Form{TallyMax}";
	print " ($Evaluation{MaxDesc})" if ($Evaluation{MaxDesc} ne '');
	print ".$FC\n</p>\n\n";
}

# Now figure out which of the RangeTexts to show.

$n = 0;

do {
	$n++;
	$cur_cap = $Evaluation{'Range'.$n.'Cap'};
	$cur_cap = $Form{TallyMax} if ($cur_cap eq '');
} until $cur_cap >= $Form{Tally};


print "<P>${FO}$Evaluation{'Range'.$n.'Text'}$FC\n</p>\n";

if (defined @{'Evaluation-Range'.$n.'ExtraText'})
{
	foreach $num (0..$#{'Evaluation-Range'.$n.'ExtraText'})
	{
		if ($Form{QuestionNum} < 1 && $num == 0)
		{
			print "<P>${SFO}${'Evaluation-Range'.$n.'ExtraText'}[$num]$SFC\n";
		} else {
			print "<P>${FO}${'Evaluation-Range'.$n.'ExtraText'}[$num]$FC\n";
		}
	}
}



# ----------------------------------------------------------
# And don't forget to put in the code for the comment values
# as soon as you get it all figured out.
# ----------------------------------------------------------



if (defined @{'Evaluation-ExtraText'})
{
	foreach $num (0..$#{'Evaluation-ExtraText'})
	{
		if ($Form{QuestionNum} < 1 && $num == 0)
		{
			print "<P>${SFO}${'Evaluation-ExtraText'}[$num]$SFC\n";
		} else {
			print "<P>${FO}${'Evaluation-ExtraText'}[$num]$FC\n";
		}
	}
}






print "<FORM ACTION=\"$ENV{SCRIPT_NAME}\" METHOD=\"POST\">\n\n";
print "<INPUT TYPE=\"Hidden\" NAME=\"QuizName\" VALUE=\"$Form{QuizName}\">\n";
print "<INPUT TYPE=\"Hidden\" NAME=\"UserName\" VALUE=\"$Form{UserName}\">\n";
print "<INPUT TYPE=\"Hidden\" NAME=\"OrigDoc\" VALUE=\"$Form{OrigDoc}\">\n\n";

print "<INPUT TYPE=\"Submit\" VALUE=\"Take the Quiz Again...\">\n\n</form>\n\n";

print "<P>${FO}Or you can <A HREF=\"$Form{OrigDoc}\">let someone else</a> take the quiz.$FC\n</p>\n";

print "<P>${FO}Or you can go back to the <A HREF=\"http://$ENV{SERVER_NAME}$ServerMainPage\">$ENV{SERVER_NAME}</a> main page.$FC\n</p>\n";





print "\n\n</body>\n\n</html>\n";


}

