#!/usr/local/bin/webwork-perl

################################################################
#  Copyright @1995-1999 by Michael E. Gage, Arnold K. Pizer and
#  WeBWorK at the University of Rochester. All rights reserved.
################################################################

my $debugON=0;

use lib '.'; use webworkInit; # WeBWorKInitLine

require 5.001;
use strict;
use Global;
use Auth;
use CGI qw(:standard);
use Net::SMTP;
use Safe;

use PGtranslator;
use vars qw($modules_to_evaluate $extra_packages_to_be_loaded);

$/ ="\n";

BEGIN {
	# set to 1 to enable timing_log
	# (contains information about time taken by scripts to run)
	$main::logTimingData = 0;

	# begin Timing code
	if( $main::logTimingData == 1 ) {
		use Benchmark;
		$main::beginTime = new Benchmark;
	}
	# end Timing code

	# Setting these time out comstants to zeros removes the time constraint completely. (zero = infinity :=)  )
	$main::TIME_OUT_CONSTANT = 60;                   # one minute wait for on screen problems
	$main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT = 1200;  #twenty minutes
	$main::CLASS_DOWNLOAD_NICE = 5;   # higher numbers indicated lower priorities
	# $main::DOWNLOAD_TIME_OUT_CONSTANT = 300;         # give it five minutes
	# $main::DOWNLOAD_NICE = 2;

	# ATTENTION:  The handlers PG_floating_point_exception_handler and PG_warnings_handler
	# have to be installed after CGI::Carp is called since it also
	# modifes the die and warn labels. Finding the right warning mechanism using these two
	# methods bears further investigation
	# They are defined in Global.pm
	$SIG{'FPE'}  = \&Global::PG_floating_point_exception_handler;
	$SIG{__WARN__}=\&Global::PG_warnings_handler;
	$SIG{'TERM'} = sub {die '[',scalar(localtime),"] Caught a SIGTERM, Error: $!   stopped at $0\n"; };
	$SIG{'PIPE'} = sub {$main::SIGPIPE = 1, die '[',scalar(localtime),"] Caught a SIGPIPE, Error: $!   stopped at $0\n"; };
	$SIG{ALRM} = sub { $main::SIG_TIME_OUT = 1; exit(0) };

	alarm($main::TIME_OUT_CONSTANT);
	# By explicitly catching the signals and dieing one forces the execution of the END statements which clean up the files.
};

################################################################################
# main #########################################################################
################################################################################

&CGI::ReadParse;
my %inputs=%main::in;
my $query = $main::in{CGI};

# verify that the rest of the information has been received
my $Course = $inputs{'course'};
my $User = $inputs{'user'};

my @local_psvns = $query -> param('local_psvns');
my $psvn = $local_psvns[0]; # get the first one for doing problem sets
$inputs{'probSetKey'} = $psvn; # only used by htmlBOTTOM
my $Session_key = $inputs{'key'};

&Global::getCourseEnvironment($Course);

my $scriptDirectory        = getWebworkScriptDirectory();
my $databaseDirectory      = getCourseDatabaseDirectory();
my $courseScriptsDirectory = getCourseScriptsDirectory();
my $templateDirectory      = getCourseTemplateDirectory();
my $tempDirectory          = getCourseTempDirectory();

eval{require "${courseScriptsDirectory}$Global::displayMacros_pl";};
eval{require "${scriptDirectory}$Global::DBglue_pl";};
eval{require "${scriptDirectory}$Global::classlist_DBglue_pl";};
eval{require "${scriptDirectory}$Global::HTMLglue_pl";};
eval{require "${scriptDirectory}$Global::FILE_pl";};

# load the modules to be used in PGtranslator
require "${courseScriptsDirectory}PG_module_list.pl"
	or wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl");

my $keyFile = &Global::getCourseKeyFile($Course);
my $permissionsFile = &getCoursePermissionsFile($Course);

# check to see if prob set has been selected
if(not defined($psvn) or $psvn eq "") {
	selectionError();
	exit;
}

# log access
&Global::log_info('', query_string);

&verify_key($inputs{'user'}, $Session_key, $keyFile, $Course);
my $permissions = &get_permissions($User,$permissionsFile);

&attachProbSetRecord($psvn);
my $login_name_for_psvn = &getStudentLogin($psvn);
attachCLRecord($login_name_for_psvn);

my $setNumber=&getSetNumber($psvn);
$setNumber = $inputs{'setNo'} if defined $inputs{'setNo'};  ## script called from profChangeDates.pl

# keep strict happy -sh
my $tempTexFileBaseName;

# check to see that it is after the open date
my ($currentTime,$odts,$ddts,$remainingTime, $TimeString);
$currentTime = time;
$odts=&getOpenDate($psvn);
$ddts=&getDueDate($psvn);
$remainingTime=$ddts-$currentTime;

if($currentTime<$odts && $permissions !=$Global::instructor_permissions) {
	print &htmlTOP("Before open date error");
	print "<CENTER><h2>Sorry, cannot download or do problem set $setNumber yet.
	<BR>It is before the open date.</h2></CENTER>";
	print &htmlBOTTOM("downloadPS.pl",\%inputs);
    exit(0);
}

my %PSVNHashForSet = %{getPSVNHashForSet($setNumber)};
my $action = $inputs{'action'};
my $downloadType= $inputs{'downloadType'}; # either pdf, ps, tex, or dvi

# Verify that the problem set has been created if a psvn number has been passed
unless ($action eq 'Get_all_copies') {
    unless (defined $PSVNHashForSet{$psvn} ) {
	    print 	&htmlTOP("Problem set version number $psvn not created");
        print ( "Pin number $psvn was not created for set $setNumber");
        print   &htmlBOTTOM("downloadPS.pl", \%inputs);
        exit(0);
    }
}

my $save_errors = '';

if ($action eq 'Do problem set' or $action eq 'Do_problem_set') { displayProbSet(); }
elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { downloadAllSets(); }
elsif ($action eq 'Get_all_copies') { downloadAllSets(); }
else { wwerror($0, "Unknown action: $action"); }

# begin Timing code
#my $endTime = new Benchmark;
#&Global::logTimingInfo($main::beginTime,$endTime,$0,$Course,$User);
# end Timing code

exit;

################################################################################
# displayProbSet ###############################################################
################################################################################

sub displayProbSet
{
    my $studentName=&CL_getStudentName($login_name_for_psvn);
    my $probHeaderFileName = &getProbHeaderFileName($psvn);

	sub numerical { $a <=> $b};
	my @problems=sort numerical &getAllProblemsForProbSetRecord($psvn);
	my $numberOfProblems = @problems;

    print &probSet_htmlTOP("Problem Set $setNumber from  $inputs{'course'} for $studentName");
					  #see subroutines at the bottom of this file
	                  #this allows the use of a small gif for the webwork logo
	                  #and takes up less screen real estate.

    print &probSet_titleBar("Problem Set $setNumber from  $inputs{'course'} for $studentName");

    print <<"ENDOFHTML";
<TABLE BORDER=1>
	<TR>
		<!-- Row 1 Column 1 -->
		<TD>
Select one of the $numberOfProblems problems to try:
<FORM METHOD=POST ACTION="$Global::processProblem_CGI">
<INPUT TYPE=HIDDEN NAME=probSetKey VALUE=$psvn>
<P>
<SELECT NAME=probNum SIZE=11>
ENDOFHTML

    my ($problemAttempted, $problemStatus, $longProblemStatus);
    foreach my $problem (@problems) {
	    $problemStatus = getProblemStatus($problem,$psvn);
	    $problemAttempted = getProblemAttempted($problem,$psvn);

	    if (!$problemAttempted) {
		    $longProblemStatus 	= '';
	    } elsif ($problemStatus  >= 0 and $problemStatus <=1 ) {
	        my $percentCorr = int(100*$problemStatus+.5);
		    $longProblemStatus = "${percentCorr}\% correct"
	    } else {
		    $longProblemStatus = 'unknown status'; # default value
	    }
	    print "<OPTION VALUE=\"$problem\">Problem $problem -- $longProblemStatus</OPTION>\n";
	}

	# nice note to warn if there's less than one day left to complete problem set
    if ($remainingTime < 86400 and $remainingTime > 0)  {
   		$TimeString = "<BR><EM>Note: you have less than one day left to complete this problem set</EM>";
    } else {
  		$TimeString = "";
    }

    print "</SELECT><BR>";

	my $practiceUser = $Global::practiceUser;
	if (($currentTime > $ddts) or ($User =~ /^$practiceUser/)) {		
		print '<INPUT type="checkbox" name="show_old_answers" value="1"> Show my old answers<BR>';
	}
	else {	
		print '<INPUT type="checkbox" name="show_old_answers" value="1" checked> Show my old answers<BR>';
	}
    
    print &sessionKeyInputs(\%inputs);
    
    my $mode = $inputs{'Mode'};
    $mode = $Global::htmlModeDefault unless ($mode);
    &displaySelectModeLine($mode); ## displays mode select buttons
		## displaySelectModeLine() is in "${courseScriptsDirectory}$Global::displayMacros_pl"
    print <<"ENDOFHTML";
<BR>
<INPUT TYPE=SUBMIT VALUE="Get Problem">
$TimeString
</FORM>
ENDOFHTML

    print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>";
    print &sessionKeyInputs(\%inputs);

    print <<"ENDOFHTML";
<INPUT TYPE=HIDDEN NAME="probSetKey" VALUE=$psvn>
<INPUT TYPE=SUBMIT VALUE="Problem Sets">
</FORM>
		</TD>
		<!-- Row 1 Column 2 -->
		<TD>
ENDOFHTML


	# process problem and save @printlines
	my $probHeader = $Global::PROB_HEADER;  # default value
	if ((defined($probHeaderFileName)) and ($probHeaderFileName =~ /\S/)) {
		$probHeader = $probHeaderFileName;
    }
    
	# use $probHeader as default unless $probHeaderFileName is defined in the set definition file
    my $source;
    if (-e "${templateDirectory}$probHeader") {
        unless (-r "${templateDirectory}$probHeader") {
	        wwerror($0, "Can't read ${templateDirectory}$probHeader");
        }
        open(PROB,"<${templateDirectory}$probHeader");
        $source = join("",<PROB>);
        close(PROB);
    }
    
    # translate the problem header file
	my %envir=defineProblemEnvir($mode,0,$psvn,$Course);
	
	my $pt = new PGtranslator; # pt stands for problem translator;
	$pt->environment(\%envir);
	$pt->initialize();
	$pt->set_mask();
	$pt->source_string($source);
	$pt->unrestricted_load("${courseScriptsDirectory}PG.pl");
	$pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl");
	$pt->translate();
	
	my $PG_PROBLEM_TEXT_REF = $pt->ra_text();
	my $PG_HEADER_TEXT_REF  = $pt->r_header; #\$PG_HEADER_TEXT;
	my $PG_ANSWER_HASH_REF  = $pt->rh_correct_answers;
	my $PG_FLAGS_REF        = $pt->rh_flags;
	
	my @printlines;
	if($mode eq "HTML" || $mode eq 'HTML_tth') {
		@printlines = @{$PG_PROBLEM_TEXT_REF};
		#@printlines = @{$pt->ra_text()};
	}
	elsif ($mode eq 'Latex2HTML') {
		@printlines =
			&createDisplayedInsert($setNumber,$probHeader,$psvn,$Course,$PG_PROBLEM_TEXT_REF);
	}
	print @printlines;
	print "</TD></TR></TABLE>";

	print &htmlBOTTOM('welcomeAction.pl', \%inputs,'probSetHelp.html');
}

################################################################################
# downloadAllSets (and related subroutines) ####################################
################################################################################

###################
# downloadAllSets #
###################

sub downloadAllSets {
	system("/usr/bin/renice +$main::CLASS_DOWNLOAD_NICE -p $$ 1>/dev/null") && warn "Could not renice process. pid $$";
	alarm( $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT);
	
	my $downloadMulti = "unknown";
	$downloadMulti = "multistudent" if $action eq "Get_all_copies";
	$downloadMulti = "multiset" if $action eq "Get_hard_copy";
	
	my @psvns_to_download = $query->param('local_psvns');
	my $num_psvns_to_download = @psvns_to_download;
	my $max_psvns_to_download = $Global::max_num_of_ps_downloads_allowed;
	
	if($num_psvns_to_download > 1 and $permissions != $Global::instructor_permissions) {
		wwerror("Non-professors are not permitted to download more than one problem set at a time.");
	}
	
	if(@psvns_to_download > $Global::max_num_of_ps_downloads_allowed) {
		my $tooManyWhat = $downloadMulti eq "multiset" ? "problem sets" : "students";
		wwerror("Too many $tooManyWhat are selected for download.",
			"The maximum number of $tooManyWhat which can be downloaded at one time is $Global::max_num_of_ps_downloads_allowed."
			." You selected $num_psvns_to_download. Go back and select fewer $tooManyWhat."
			." (This maximun is set by the variable \$max_num_of_ps_downloads_allowed in Global.pm.)");
	}
	
	my ($cumulativeTexSource, $currentTexSourceRef, $currentTexSource, $currentTexErrorRef);
	
	# this could be used when eliminating pre-foreach createTexSourceHandleErrors call
	# s/\\end\{document\}.*?\\begin\{document\}/\n\\newpage\n/s;
	
	$tempTexFileBaseName = "${tempDirectory}Temp_downloadAllSets_$User";
	my $first_psvn = $psvns_to_download[0];
	
	my $current_psvn = shift @psvns_to_download;
	($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn);
	@psvns_to_download = () if(@$currentTexErrorRef);
	$currentTexSource = $$currentTexSourceRef;
	$currentTexSource =~ s|\\end\{document\}\s$|\n|s;
	$cumulativeTexSource .= $currentTexSource;
	
	foreach $current_psvn (@psvns_to_download) {
		($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn);
		@psvns_to_download = () if(@$currentTexErrorRef);
		$currentTexSource = $$currentTexSourceRef;
		$currentTexSource =~ s|^.*?\\begin\{document\}|\n\\newpage\n|s;
		$currentTexSource =~ s|\\end\{document\}\s$|\n|s;
		$cumulativeTexSource .= $currentTexSource;
	}
	
	$cumulativeTexSource .= "\n\\end{document}\n";
	
	open TEXOUTPUT, ">$tempTexFileBaseName.tex"
		or wwerror("Can't open $tempTexFileBaseName.tex for output.");
	print TEXOUTPUT $cumulativeTexSource;
	close TEXOUTPUT;
	
	if(@$currentTexErrorRef) {
		PG_error_print($tempTexFileBaseName, $current_psvn, @$currentTexErrorRef);
	} else {
		$downloadType = lc $downloadType;
		my $mimeType = prepareHardcopy($tempTexFileBaseName, $downloadType);
		
		my ($setName, $userName);
		&attachProbSetRecord($first_psvn);
		if($downloadMulti eq "multistudent") {
			if($num_psvns_to_download == 1) {
				$setName = getSetNumber($first_psvn);
				$userName = getStudentLogin($first_psvn);
			} else {
				$setName = getSetNumber($first_psvn);
				$userName = "multistudent";
			}
		} elsif($downloadMulti eq "multiset") {
			if($num_psvns_to_download == 1) {
				$setName = getSetNumber($first_psvn);
				$userName = getStudentLogin($first_psvn);
			} else {
				$setName = "multiset";
				$userName = getStudentLogin($first_psvn);
			}
		}
		my $hardCopyName = "$Course.$userName.$setName.$downloadType";
		
		open(TEXINPUT, "$tempTexFileBaseName.$downloadType")
			or wwerror($0, "Can't open $tempTexFileBaseName.$downloadType: $!\n");
		print "Content-type: $mimeType\n";
		print "Content-disposition: attachment; filename=\"$hardCopyName\"\n\n";
		print while (<TEXINPUT>);
		close TEXINPUT;
	}
}

###################
# createTexSource #
###################

sub createTexSource {
	my $psvn = shift;

	# Check that the psvn corresponds to the user and that it is after the open date.
	# This should only fail if someone is trying to break into WeBWorK.
	&attachProbSetRecord($psvn);
	$login_name_for_psvn = &getStudentLogin($psvn);
	attachCLRecord($login_name_for_psvn);

	if ((($User ne &getStudentLogin($psvn)) ||($currentTime < $odts))
	    and ($permissions != $Global::instructor_permissions)
	    and ($permissions != $Global::TA_permissions))
	{
		&hackerError;
		exit;
	}

	my $probSetHeader = $Global::SET_HEADER;
	my $setHeaderFileName = &getSetHeaderFileName($psvn);

	my $answersRequestedQ = 0;
	$answersRequestedQ=	 $inputs{'ShowAns'} if defined($inputs{'ShowAns'});

	my $adts=&getAnswerDate($psvn);
	my $displayCorrectAnswersQ = 0;	 #initialize
	$displayCorrectAnswersQ =1 if  $answersRequestedQ && ($currentTime > $adts);
	$displayCorrectAnswersQ =1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions);

	my $texSource ='';

	print STDERR "%%Creating a tex version of set $setNumber<BR>\n" if $debugON;
	print STDERR "%%For", &CL_getStudentName($login_name_for_psvn), "psvn=$psvn<BR>\n" if $debugON;

	# print TeX preamble and header
	$texSource .= &texInput($Global::TEX_SET_PREAMBLE);
	$texSource .= &texInput($Global::TEX_SET_HEADER);

	# print set header
	my $mode = "TeX";
	my @PG_COMPILE_ERRORS = ();
	if ((defined($setHeaderFileName)) and $setHeaderFileName =~ /\S/) {
		$probSetHeader = $setHeaderFileName;
	}
	if (open(INPUT,"${templateDirectory}$probSetHeader")) {
		$probSetHeader =~ /\.([^\.]*)$/;
		my $displayMode = $1;

		if ($displayMode eq 'pg') {
			my %envir=defineProblemEnvir($mode, 0, $psvn, $Course, undef());
			my $input_string=  join("",<INPUT>);
			my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF);
			
# BEGIN fork
			if (open TEX_PIPE, "-|") {
				# parent:
				local $/ = "\n";
				my $curr_pg_compile_error = <TEX_PIPE>;
				chomp $curr_pg_compile_error;
				push @PG_COMPILE_ERRORS, $curr_pg_compile_error if $curr_pg_compile_error;
				
				undef $/;
				$texSource .= <TEX_PIPE>;
			} else {
				# child:
				$texSource = ''; # clear this at beginning of fork
				@PG_COMPILE_ERRORS = (); # clear this as well
# -----
				my $pt = new PGtranslator;
				$pt -> evaluate_modules( @{main::modules_to_evaluate}) ;
				$pt -> load_extra_packages(@{main::extra_packages_to_be_loaded});
				# The variables in the two preceding lines are	defined in PG_module_list.pl
				# require "${courseScriptsDirectory}PG_module_list.pl";
				# (Modules are defined by require statement above found near the top of this file)
				$pt->environment(\%envir);
				$pt->initialize();
				$pt->set_mask();
				$pt->source_string($input_string);
				$pt->unrestricted_load("${courseScriptsDirectory}PG.pl");
				$pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl");
				$pt->translate();
				
				$PG_PROBLEM_TEXT_REF = $pt->ra_text();
				$PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT;
				$PG_ANSWER_HASH_REF = $pt->rh_correct_answers;
				$PG_FLAGS_REF = $pt->rh_flags;
				
				$texSource .= join '', @{$PG_PROBLEM_TEXT_REF};
				
# begin non-FORK code
#				if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} == 1) {
#					push(@PG_COMPILE_ERRORS, qq{<A HREF="#problem0">$probSetHeader</A>} );
#				}
# end non-FORK code

# begin FORK-only code	
			my $stupid_forked_error_string;		
			if (defined($PG_FLAGS_REF->{'error_flag'}) and	$PG_FLAGS_REF->{'error_flag'} ==1) {
				$texSource = qq{<A HREF="#problem0">$probSetHeader</A>} . "\n" . $texSource;
			} else {
				$texSource = "\n" . $texSource;
			}
# end FORK code
				
				if (defined($Global::WARNINGS) and $Global::WARNINGS) {
					my $warnings = '{\\bf WARNINGS:\par{\\tiny ' . $Global::WARNINGS . ' }}';
					$warnings =~ s|/|\\\-/|g;  # allow linebreaks in the middle of URLs
					$warnings =~ s/<br>/\\par\n/ig; # introduce breaks at linebreaks and paragraphs
					$warnings =~ s/<p>/\\par\n/ig;	
					$warnings =~ s/\#/\\\#/g; # protect against some of the symbols which are reserved in tex 
					$warnings =~ s/\_/\\\_/g;
					$warnings =~ s/\>/\\\>/g;
					$warnings =~ s/\</\\\</g;
					$texSource .= $warnings;
				}
				$Global::WARNINGS = ''; # reset the Global::WARNINGS parameter
# -----
				print $texSource;
				exit;
			}
# END fork
		}	else {
			$texSource .= "Don't understand languages with extension $displayMode.<BR>\n";
		}
		close INPUT;
	} else {
		print STDERR ( "Can't open ${templateDirectory}${probSetHeader}\n") if $debugON;
		wwerror("$0", "\n######## Could not open the set header file: ${templateDirectory}${probSetHeader}","","");
	}

	# Print problems
	my @problems = sort { $a <=> $b } &getAllProblemsForProbSetRecord($psvn);
	my @refSubmittedAnswers = ();

	my $probNum;
	foreach $probNum (@problems) {
		my $source;
		my $probFileName = &getProblemFileName($probNum,$psvn);
		if (-e "${templateDirectory}$probFileName") {
			unless (-r "${templateDirectory}$probFileName") {
				wwerror($0, "Can't read ${templateDirectory}$probFileName");
			}
			open(PROB,"<${templateDirectory}$probFileName");
			$source = join("",<PROB>);
			close(PROB);
		}
		local($^W) =0; ##########CHANGE THIS BACK!!!! # what do you mean by that?
		my %envir=defineProblemEnvir('TeX',$probNum,$psvn,$Course,undef());
		my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF,$PG_EVALUATED_ANSWERS_REF);

# BEGIN fork
		if (open TEX_PIPE, "-|") {
			# parent:
			local $/ = "\n";
			my $curr_pg_compile_error = <TEX_PIPE>;
			chomp $curr_pg_compile_error;
			push @PG_COMPILE_ERRORS, $curr_pg_compile_error if $curr_pg_compile_error;
			
			undef $/;
			$texSource .= <TEX_PIPE>;
		} else {
			# child:
			$texSource = ''; # clear this at beginning of fork
			@PG_COMPILE_ERRORS = (); # clear this as well
# -----
			my $pt = new PGtranslator;	 #pt stands for problem translator;
			$pt->environment(\%envir) ;
			$pt->initialize();
			$pt-> set_mask();
			$pt->source_string($source);
			$pt->unrestricted_load("${courseScriptsDirectory}PG.pl");
			$pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl");
			$pt->translate();

			$PG_PROBLEM_TEXT_REF      = $pt->ra_text();
			$PG_HEADER_TEXT_REF       = $pt->r_header;#\$PG_HEADER_TEXT;
			#$PG_ANSWER_HASH_REF       = $pt->rh_correct_answers;
			$PG_EVALUATED_ANSWERS_REF = $pt->process_answers;
			$PG_FLAGS_REF             = $pt ->rh_flags;

			$texSource .= join '', @{$PG_PROBLEM_TEXT_REF};
			
# begin non-FORK code
#			if (defined($PG_FLAGS_REF->{'error_flag'}) and	$PG_FLAGS_REF->{'error_flag'} ==1) {
#				push(@PG_COMPILE_ERRORS, qq{<A HREF="#problem$probNum">$probNum</A>} );
#			}
# end non-FORK code

# begin FORK-only code	
			if (defined($PG_FLAGS_REF->{'error_flag'}) and	$PG_FLAGS_REF->{'error_flag'} ==1) {
				$texSource = qq{<A HREF="#problem$probNum">$probNum</A>} . "\n" . $texSource;
			} else {
				$texSource = "\n" . $texSource;
			}
# end FORK code
			
			if ($displayCorrectAnswersQ) {
				my %correctAnswerHash = ();
				my @correctAnswerList = ();
				my %submittedAnswerHash = ();
				
				if (ref($PG_EVALUATED_ANSWERS_REF) eq 'HASH') {
					%correctAnswerHash = %$PG_EVALUATED_ANSWERS_REF;
				} else {
					warn "ERROR: Please pass the PG answer list as a hash not a list.";
				}

				if (%correctAnswerHash) {
					my ($correctFlag,$normalizedCorrectAnswer,
						$normalizedSubmittedAnswer,
						$answerMessage) = ();
					
					# determine the correct order for the answers
					my @answer_entry_order =
						(defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}))
							? @{$pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}}
							: keys %{$pt->rh_evaluated_answers};

					$texSource .= "Correct Answers:\\par\\begin{itemize}\n";
					foreach my $ky (@answer_entry_order) {
						$normalizedCorrectAnswer = $correctAnswerHash{$ky}->{correct_ans};
						$normalizedCorrectAnswer =~ s/\^/\\\^\{\}/g;
						$normalizedCorrectAnswer =~ s/\_/\\\_/g;
						$texSource .= "\\item $normalizedCorrectAnswer\n";

					}
					$texSource .= "\\end{itemize} \\par\n";
				}
			}
				
			if (defined($Global::WARNINGS) and $Global::WARNINGS) {
				my $warnings = '{\\bf WARNINGS:\par{\\tiny ' . $Global::WARNINGS . ' }}';
				unless (@PG_COMPILE_ERRORS) { # prepare warnings for TeX output in this case
					$warnings =~ s|/|\\\-/|g; # allow linebreaks in the middle of URLs
					$warnings =~ s/<br>/\\par\n/ig; # introduce breaks at linebreaks and paragraphs
					$warnings =~ s/<p>/\\par\n/ig;	
					$warnings =~ s/\#/\\\#/g; # protect against some of the symbols which are reserved in tex 
					$warnings =~ s/\_/\\\_/g;
					$warnings =~ s/\>/\\\>/g;
					$warnings =~ s/\</\\\</g;
					$texSource .= $warnings;
				}
			}
			$Global::WARNINGS = '';	  #reset the Global::WARNINGS parameter
# -----
			print $texSource;
			exit;
		}
# END fork
	} # this is the end of the foreach problem loop

	# print Tex postamble
	$texSource .= &texInput($Global::TEX_SET_FOOTER);

	return \$texSource, \@PG_COMPILE_ERRORS;
}

###################
# prepareHardcopy #
###################

sub prepareHardcopy
{
	my ($texFileBaseName, $targetFormat) = @_;
	my $mimeType;
	
	chdir $tempDirectory;
	
	my $dviCommandLine = "$Global::externalLatexPath $texFileBaseName.tex >/dev/null 2>/dev/null";
	my $psCommandLine = "$Global::externalDvipsPath -o $texFileBaseName.ps $texFileBaseName.dvi >/dev/null 2>/dev/null";
	my $pdfCommandLine = "$Global::externalGsPath -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$texFileBaseName.pdf -c save pop -f $texFileBaseName.ps";
#	my $pdfCommandLine = "$Global::externalPs2pdfPath $texFileBaseName.ps $texFileBaseName.pdf";
	
	# make sure that you are not using old copies of the following files:
	unlink("$texFileBaseName.dvi","$texFileBaseName.ps", "$texFileBaseName.pdf"); 
	
	# we use logPrint() for TeX->DVI errors as they are usually caused 
	if($targetFormat eq "pdf") {
		system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 
		system($psCommandLine);  -e "$texFileBaseName.ps" or die "ps generation failed.";
		system($pdfCommandLine); -e "$texFileBaseName.pdf" or die "pdf generation failed.";
		$mimeType = "application/pdf";
	} elsif($targetFormat eq "ps") {
		system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 
		system($psCommandLine);  -e "$texFileBaseName.ps" or die "ps generation failed.";
		$mimeType = "application/postscript";
	} elsif($targetFormat eq "dvi") {
		system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 
		$mimeType = "application/x-dvi";
	} elsif($targetFormat eq "tex") {
		$mimeType = "application/tex";
	} else {
		die "unrecognized format: $targetFormat";
	}
	
	return $mimeType;
}

##################
# PG_error_print #
##################

sub PG_error_print
{
	my ($tempTexFileBaseName, $current_psvn, @errors) = @_;
	
	# get set name and student name from psvn
	&attachProbSetRecord($current_psvn);
	my $userName = &getStudentLogin($current_psvn);
	my $setName = &getSetNumber($current_psvn);
	
	# print error page header
	print &htmlTOP("PG compile error");
	print "<H3>PG error while compiling problem number", (@errors>1) ? 's ' : ' ',
		join(', ', @errors), " in problem set $setName for $userName.</H3>";
	print "<h3>TeX source file:</h3>";
	
	# open temp tex file
	if(open TEXINPUT, "$tempTexFileBaseName.tex") {
		print "<pre>\n";
		my $lineNumber = 1;
		while(<TEXINPUT>) {
			if(/<A NAME/) { print $_; }
			else { print protect_HTML("$lineNumber $_"), "\n"; }
			$lineNumber++;
		}
		print "</pre>\n";
		close TEXINPUT;
	} else {
		print "<p>Unable to open TeX source file:<br><tt>$tempTexFileBaseName.tex</tt></p>";
	}
	
	# print page footer
	print &htmlBOTTOM("welcomeAction.pl", \%inputs);
	exit;
}

sub logPrint {
	my $texFileBaseName=shift;
    print &htmlTOP("TeX Error or error in creating PostScript file");
    open (LOGFILE, " $texFileBaseName.log")
	|| print  "<H3>Can't open log file:</H3> path= $texFileBaseName.log<BR>$!<BR><BR>"  ;


    print "<H3>TeX Error Log:</H3>";
    my $print_error_switch = ($debugON) ? 1: 0;
    my $out='';
    #warn ord $/, ord  "\n", ord "\r";
    #warn "length of separator = ", length($/);
    $/ = "\n";
    #warn ord $/, ord  "\n", ord "\r";
    while (<LOGFILE>) {
	    $out = $_;
	    $print_error_switch = 1 if $out =~ /^!/;  # after a fatal error start printing messages
		print protect_HTML($out)."<BR>\n" if $print_error_switch;
    }
    close(LOGFILE);

    open (TEXFILE, "$texFileBaseName.tex")
	|| print "<H3>Can't open tex source file:</H3> path= $texFileBaseName.tex:<BR> $!<BR><BR>\n";
    print "<BR>\n<H3>TeX Source File:</H3><BR>\n";
    print "<PRE>";

    my $lineNumber = 1;
    while (<TEXFILE>) {
		print protect_HTML("$lineNumber $_")."\n";
        $lineNumber++;
    }
    close(TEXFILE);
    print "</PRE>";
    print &htmlBOTTOM("welcomeAction.pl", \%inputs);
}
sub protect_HTML {
	my $line = shift;
	chomp($line);
	$line =~s/\&/&amp;/g;
	$line =~s/</&lt;/g;
	$line =~s/>/&gt;/g;
	$line;
}
sub selectionError {
    print &htmlTOP("Selection error");
    print"<H2>Error:</H2>  You must first select a problem set in order to download a hard copy!\n";
    print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>";
    print &sessionKeyInputs(\%inputs);
    print <<"ENDOFHTML";
  <INPUT TYPE=SUBMIT VALUE="Return to Welcome Page">
</FORM>
ENDOFHTML
    print &htmlBOTTOM("welcomeAction.pl", \%inputs);
}

sub probSet_htmlTOP {
    my ($title, $bg_url) = @_;
    my $background_url = $bg_url || $Global::background_plain_url;


    my $out = <<ENDhtmlTOP;
content-type: text/html
Expires: 0

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
<HTML>
<HEAD>
<TITLE>$title</TITLE>
</HEAD>
<BODY BACKGROUND="$background_url"><p>
<P>

ENDhtmlTOP
    $out;
}

sub probSet_titleBar {
	my ($title) = @_;
	my $title_bar = "";
	$title_bar .= qq{
		<TABLE BORDER="0" WIDTH="100%">
		<TR ALIGN=CENTER  >
		<TD ALIGN=LEFT >
		<A HREF="$Global::webworkDocsURL">
		<IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A>
		</TD>
		<TD VALIGN=MIDDLE>
		<H2 ALIGN=CENTER>
		$title
		</H2>
		</TD>
		<TD ALIGN=RIGHT >
		<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>
	};
	my $inputkeys = &sessionKeyInputs(\%inputs);

	$title_bar .= qq{
		$inputkeys
		<INPUT TYPE=HIDDEN NAME=\"probSetKey\" VALUE=$psvn>
		<INPUT TYPE=SUBMIT VALUE=\"Problem Sets\">
		</FORM>
		</TD>
	    </TABLE>
	};
	$title_bar;
}

sub hackerError  { ## prints hacker error message

    my $msg = "Attempt to hack into WeBWorK	\n Remote Host is: ". remote_host()."\n";
    $msg .= query_string;
    &Global::log_error('hacker error', $msg);	  ## log attempt

    ## notify by email

   my $toAdd = $Global::feedbackAddress;

    my $emailMsg = "To: $toAdd
Subject: Attempt to hack into WeBWorK

Here are the details on the attempt to hack into weBWorK:\n
$msg
\n";

	my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20);
	$smtp->mail($Global::webmaster);
	$smtp->recipient($Global::feedbackAddress);
	$smtp->data($msg);
	$smtp->quit;


#    my $SENDMAIL = $Global::SENDMAIL;
#    open (MAIL,"|$SENDMAIL");
#    print MAIL "$emailMsg";
#    close (MAIL);

    print   &htmlTOP("Hacker Error"),
                        "<H2>Error:Please do not try to hack into WeBWorK!</H2>",
                        startform(-action=>"${Global::cgiWebworkURL}${Global::welcomeAction_CGI}"),
                        "<p>",
                        &sessionKeyInputs(\%inputs),
                        hidden(-name=>'local_psvns', -value=>$psvn),
                        hidden(-name=>'action', -value=>'Do_problem_set'),
                        submit(-value=>"Return to Problem Set"),
                        endform(),
                        &htmlBOTTOM($0, \%inputs);
}

sub defineProblemEnvir {
    my ($mode,$probNum,$psvn,$courseName,$refSubmittedAnswers)      =   @_;
    my %envir=();
    my $loginName =	&getStudentLogin($psvn);
	##how to put an array submittedAnswers in a hash??
    $envir{'refSubmittedAnswers'}  	=   $refSubmittedAnswers if defined($refSubmittedAnswers);
    $envir{'psvnNumber'}	   		=   $psvn;
    $envir{'psvn'}		   			=   $psvn;
    $envir{'studentName'}	   		=   &CL_getStudentName($loginName);
	$envir{'studentLogin'}	    	=	$loginName;
	$envir{'sectionName'}	    	=	&CL_getClassSection($loginName);
	$envir{'sectionNumber'}	    	=	&CL_getClassSection($loginName);
	$envir{'recitationName'}	    =	&CL_getClassRecitation($loginName);
	$envir{'recitationNumber'}	    =	&CL_getClassRecitation($loginName);
	$envir{'setNumber'}	    		=	&getSetNumber($psvn);
	$envir{'questionNumber'}      	=	$probNum;
	$envir{'probNum'} 	    		=	$probNum;
	$envir{'openDate'}	    		=	&getOpenDate($psvn);
	$envir{'formatedOpenDate'}    	=	&formatDateAndTime(&getOpenDate($psvn));
	$envir{'formattedOpenDate'}    	=	&formatDateAndTime(&getOpenDate($psvn));
	$envir{'dueDate'} 	    		=	&getDueDate($psvn);
	$envir{'formatedDueDate'}     	=	&formatDateAndTime(&getDueDate($psvn));
	$envir{'formattedDueDate'}     	=	&formatDateAndTime(&getDueDate($psvn));
	$envir{'answerDate'}	    	=	&getAnswerDate($psvn);
	$envir{'formatedAnswerDate'}  	=	&formatDateAndTime(&getAnswerDate($psvn));
	$envir{'formattedAnswerDate'}  	=	&formatDateAndTime(&getAnswerDate($psvn));
	$envir{'problemValue'}	    	=	&getProblemValue($probNum,$psvn);
	$envir{'fileName'}	    		=	&getProblemFileName($probNum,$psvn);
	$envir{'probFileName'}	    	=	&getProblemFileName($probNum,$psvn);
	$envir{'languageMode'}	    	=	$mode;
	$envir{'displayMode'}	    	=	$mode;
	$envir{'outputMode'}	    	=	$mode;
	$envir{'courseName'}	    	=	$courseName;
	$envir{'sessionKey'}	    	=	( defined($inputs{'key'}) ) ?$inputs{'key'} : " ";

	# initialize constants for PGanswermacros.pl
	$envir{'numRelPercentTolDefault'} 	=     getNumRelPercentTolDefault();
	$envir{'numZeroLevelDefault'}		=     getNumZeroLevelDefault();
	$envir{'numZeroLevelTolDefault'} 	=     getNumZeroLevelTolDefault();
	$envir{'numAbsTolDefault'} 			=     getNumAbsTolDefault();
	$envir{'numFormatDefault'}			=     getNumFormatDefault();
	$envir{'functRelPercentTolDefault'} =     getFunctRelPercentTolDefault();
	$envir{'functZeroLevelDefault'} 	=     getFunctZeroLevelDefault();
	$envir{'functZeroLevelTolDefault'} 	=     getFunctZeroLevelTolDefault();
	$envir{'functAbsTolDefault'} 		=     getFunctAbsTolDefault();
	$envir{'functNumOfPoints'} 			=     getFunctNumOfPoints();
	$envir{'functVarDefault'} 			=     getFunctVarDefault();
	$envir{'functLLimitDefault'} 		=     getFunctLLimitDefault();
	$envir{'functULimitDefault'} 		=     getFunctULimitDefault();
	$envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration();
	$envir{'numOfAttempts'}             =     undef(); # this is defined only for problems

	# defining directorys and URLs
	$envir{'templateDirectory'}   		=	&getCourseTemplateDirectory();
	$envir{'classDirectory'}   			=	$Global::classDirectory;
	$envir{'cgiDirectory'}   			=	$Global::cgiDirectory;
	$envir{'macroDirectory'}   			=	getCourseMacroDirectory();
	$envir{'courseScriptsDirectory'}   	=	getCourseScriptsDirectory();
	$envir{'htmlDirectory'}             =   getCourseHtmlDirectory();
	$envir{'htmlURL'}   				=	getCourseHtmlURL();
	$envir{'tempDirectory'}             =   getCourseTempDirectory();
	$envir{'tempURL'}                   =   getCourseTempURL();
	$envir{'scriptDirectory'}   		=	$Global::scriptDirectory;
	$envir{'webworkDocsURL'}   			=	$Global::webworkDocsURL;
	$envir{'externalTTHPath'}   		=	$Global::externalTTHPath;


	$envir{'inputs_ref'}                =  \%inputs;


	my $seed		= &getProblemSeed($probNum, $psvn);
	$seed			= 1111 unless defined($seed);
	$envir{'problemSeed'}	   	=   $seed if defined($seed);

	# here is a way to pass environment variables defined in webworkCourse.ph
	my $k;
	foreach $k (keys %Global::PG_environment ) {
		$envir{$k} = $Global::PG_environment{$k};
	}
	%envir;
}

################################################################################
# cleanup routines #############################################################
################################################################################

BEGIN {
	# This subroutine cleans up temporary files after the postscript copy has been created.
	sub cleanup_downloadPS {
	    unless (defined($action) and ($action eq 'Do problem set' or $action eq 'Do_problem_set')) {
	        my $ERRORS = $save_errors;
	        unless ($debugON) {
			    eval {
	                chdir $tempDirectory;
	                unlink(
	                	"#tempTexFileBaseName.dvi",
	                	"$tempTexFileBaseName.ps",
	                	"$tempTexFileBaseName.pdf",
		            	"$tempTexFileBaseName.log",
		            	"$tempTexFileBaseName.aux",
		            	"$tempTexFileBaseName.tex"
		            );
	                unlink("${tempDirectory}eps/${login_name_for_psvn}*.eps");
	            };
	        $ERRORS .= $ERRORS . $@;
		    }
		    my $query = query_string();
		    $query = "" unless defined($query);
		    wwerror("$0", "ERROR: in downloadPS subroutine of welcomeAction.pl $ERRORS","","",$query) if $ERRORS;
	    }
	}
}

END {
   if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) {
    	alarm(0);  # turn off the alarm
	my $hard_copy_message = qq{Content-type: text/html\n\n
	    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
	    <HTML><BODY BGCOLOR = "FF99CC">
	    <BLOCKQUOTE><H3>WeBWorK hard copy download time out.</H3>\n
		<H4>This download was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4>  This may be because the
		WeBWorK server is extraordinarily busy, or because there was an error in the problem,
		or because you tried to download a set with too many  problems (more than 50).<P>\n
        Use the back button to return to the previous page and try again.<BR>\n
        If the problem is repeated you can report this to your instructor using the feedback button.
        <P>
        Because the WeBWorK server at the Unversity of Rochester is experiencing heavy use we have made downloading
        hard copies a low priority during the times of very heavy useage.  It will be helpful if you
        download hard copies during times when the load is not too heavy.
        <P>
        The load is usually heaviest in the evenings , particularly a few hours before assignments
        are due.  The best times to download hard copies are in the morning and afternoon
         -- or an hour after the due date and time of the previous assignment -- nobody is using the system then :-)
         </BLOCKQUOTE></BODY></HTML>
        };
     my $do_problem_message = qq{Content-type: text/html\n\n
        <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
        <HTML><BODY BGCOLOR = "FF99CC">
	    <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n
		<H4>Your request (action = $action) was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4>
		This is probably because the
		WeBWorK server is extraordinarily busy.<P>\n
		You should be warned that WeBWorK response will be unusually slow.  If possible you should try
		to use WeBWorK at another time when the load is not as high.  The highest useage periods are in the
		evening, particularly in the two hours before assignments are due.<P>\n
        Use the back button to return to the previous page and try again.<P>\n
        If the high useage problem continues you can report this to your instructor using the feedback button.
        <P>

         </BLOCKQUOTE></BODY></HTML>
        };
     if ($action eq 'Get hard copy' or $action eq 'Get_hard_copy')  {
     	print $hard_copy_message;
     } else{
     	print $do_problem_message;
     }


   }

	# begin Timing code
	if( $main::logTimingData == 1 ) {
		my $endTime = new Benchmark;
		my $error_str='';

		if ($main::SIGPIPE) {
			$error_str = 'broken PIPE--';
		} elsif ($main::SIG_TIME_OUT) {
			$error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --";
		} elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') {
			$error_str = 'successful download --  ';
		}

		&Global::logTimingInfo($main::beginTime,$endTime,$error_str.'welcomeAction.pl',$Course,$User);
	}
	# end Timing code
	
	cleanup_downloadPS();
}

1;