#!/usr/local/bin/webwork-perl # This file is processProblem8.pl # This is a special version of processProblem.pl # made to be used as an editor # It is called from a form with inputs # 'user', # 'key' # 'course' # 'probSetKey' and # 'probNum' # and in addition # 'Mode' (for either TeX mode or HTML mode or Latex2HTML mode) # 'show_old_answers' (whether or not student's old answers should be filled in) # 'ShowAns' (asks for answer to be shown -- only available for instructors) # 'answer$i' (the answers -- if any --provided to the questions) # 'showEdit' (checks if the ShowEditor button should be shown and clicked) # 'showSol' (checks if the solution button ishould be shown and clicked) # as well as # 'source' when an edited source is provided by a web based editor # 'seed' when a new seed is provided by a web based editor # 'readSourceFromHTMLQ' # 'action' which can be 'Save updated version' or 'Read problem from disk' or # 'Submit Answers' or 'Preview Answers' or 'Preview Again' # 'probFileName' # 'languageType' use strict; use lib '.'; use webworkInit; # WeBWorKInitLine use CGI qw(:standard); use Net::SMTP; use Global; use Auth; use Safe; use MIME::Base64 qw( encode_base64 decode_base64) ; use WeBWorK::PG::Translator; use PGtranslator; # this is now a stub use WeBWorK::PG::ImageGenerator; BEGIN { # set to 1 to enable timing_log # (contains debugging info about time taken by scripts to run) $main::logTimingData = 1; # begin Timing code if( $main::logTimingData == 1 ) { use Benchmark; $main::beginTime = new Benchmark; } # end Timing code $main::TIME_OUT_CONSTANT = 60; # one minute wait for on screen problems $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) }; # ## 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; alarm($main::TIME_OUT_CONSTANT); }; use vars qw ( $questionNumber $STRINGforOUTPUT $languageMode $ansCount $openDate $cgiURL $studentName $pinNumber $submittedAnswers $setNumber $answerDate $dueDate $studentLogin $problemValue $safeCompartment $psvnNumber $fileName $probNum $sectionName $sectionNumber $recitationName $recitationNumber $sessionKey $courseName $modules_to_evaluate $extra_packages_to_be_loaded ); eval { # This hardwires access to these modules/objects. ################################################ #switched to object-oriented interface with CGI #DME 6/15/2000 my $cgi = new CGI; if( $CGI::VERSION < 2.5 ) { die "This version of WeBWorK requires at least version 2.50 of the CGI.pm library"; } my %inputs = $cgi -> Vars(); # get information from CGI inputs (see also below for additional information) my $Course = $inputs{'course'}; my $User = $inputs{'user'}; # define these for the timingLogInfo $main::Course = $Course; $main::User = $User; $main::Action = $inputs{'action'}; my $Session_key = $inputs{'key'}; my $randpsvn = 22222; #int rand(1111,9999); my $psvn = $inputs{'probSetKey'}; #psvn stands for Problem Set Version Number my $probNum = 1; $probNum = $inputs{'probNum'} if defined($inputs{'probNum'}); my $nextProbNum = $probNum +1 if defined($probNum); my $previousProbNum = $probNum -1 if defined($probNum); my $mode = "HTML"; $mode = $inputs{'Mode'} if defined( $inputs{'Mode'} ); $main::display_mode = $mode; # this is only used for the timing messages. my $showEdit = $inputs{'showEdit'}; my $show_old_answers = 0; $show_old_answers = $inputs{'show_old_answers'} if defined($inputs{'show_old_answers'}); # verify that information has been received unless($Course && $User && $Session_key && $psvn) { my $error_msg = $cgi -> remote_host() . ' ' . $cgi -> user_agent() . ' ' . $cgi -> query_string(); &wwerror("$0, missing data", "The script did not receive the proper input data. Course is $Course, user is $User, session key is $Session_key, psvn is $psvn",'','',$error_msg ); } # establish environment for this script &Global::getCourseEnvironment($Course); my $macroDirectory = getCourseMacroDirectory(); my $databaseDirectory = getCourseDatabaseDirectory(); my $htmlDirectory = getCourseHtmlDirectory(); my $htmlURL = getCourseHtmlURL(); my $scriptDirectory = getWebworkScriptDirectory(); my $templateDirectory = getCourseTemplateDirectory(); my $courseScriptsDirectory = getCourseScriptsDirectory(); require "${courseScriptsDirectory}$Global::displayMacros_pl"; require "${scriptDirectory}$Global::DBglue_pl"; require "${scriptDirectory}$Global::classlist_DBglue_pl"; require "${scriptDirectory}$Global::HTMLglue_pl"; require "${scriptDirectory}$Global::FILE_pl"; my $permissionsFile = &Global::getCoursePermissionsFile($Course); my $permissions = &get_permissions($User,$permissionsFile); my $keyFile = &Global::getCourseKeyFile($Course); #################################################################### # load the modules to be used in PGtranslator # # we need to support the above file, but we've changed how # evaluate_modules and load_extra_packages work so that they use an # instance variable. so what we do is use a stub PGtranslator class to # store the list of included modules in a package variable for later # retrieveal. require "${courseScriptsDirectory}PG_module_list.pl" or wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl"); #################################################################### # log access &Global::log_info('', $cgi -> query_string); unless ($User eq "practice666" ) { #verify session key &verify_key($User, $Session_key, "$keyFile", $Course, \%inputs); } ##right now $probNum cannot possibly be "", because its default is 1 ##is that how it should be? ###Should problemBank2 be substituted by some Global variable???### if($probNum eq "" && ($Course ne "problemBank2") ) { &selectionError; die "Content-type: text/html\n\n ERROR: in $Global::processProblem_CGI near &selectionError"; } # get the rest of the information from the CGI script # get language type my $displayMode = defined($inputs{'languageType'}) ?$inputs{'languageType'}:'pg'; # get answers # Decide whether answers have been submitted. my $answers_submitted =0; $answers_submitted = 1 if defined($inputs{answer_form_submitted}) and 1 == $inputs{answer_form_submitted}; $answers_submitted = 0 if defined($inputs{'action'}) and ( $inputs{'action'} =~ /Paste Answer/ ); # Decide whether preview_mode has been selected my $preview_mode =0; $preview_mode = 1 if defined($inputs{'action'}) and (( $inputs{'action'} =~ /Preview Answer/ ) or ( $inputs{'action'} =~ /Preview Again/ )); my $answersRequestedQ = 0; $answersRequestedQ= $inputs{'ShowAns'} if defined($inputs{'ShowAns'}); my $solutionsRequestedQ= 0; $solutionsRequestedQ= $inputs{'ShowSol'} if defined($inputs{'ShowSol'}); my $hintsRequestedQ= 0; $hintsRequestedQ= $inputs{'ShowHint'} if defined($inputs{'ShowHint'}); my $doNotRecordAnsRequestedQ= 0; $doNotRecordAnsRequestedQ= $inputs{'doNotRecordAns'} if defined($inputs{'doNotRecordAns'}); # # # cache information about the problem set (from the webwork-database) # and begin constructing the environment for constructing and displaying the problem &attachProbSetRecord($psvn); &attachCLRecord(&getStudentLogin($psvn)); # Get information from database my ($currentTime,$odts,$ddts,$adts); $currentTime = time; $odts = &getOpenDate($psvn); $ddts = &getDueDate($psvn); $adts = &getAnswerDate($psvn); my ($setNumber,$numberOfProblems); $setNumber = &getSetNumber($psvn); $numberOfProblems = &getAllProblemsForProbSetRecord($psvn); my $setNumber_display = $setNumber; $setNumber_display =~ s/_/ /g; # If answers have not been submitted and previous answers have been saved, patch them in # unless $show_old_answers = 0 unless ($answers_submitted or !$show_old_answers) { my $student_answers = getProblemStudentAnswer($probNum,$psvn); if (defined $student_answers) { my $rh_answer_hash = decode_submitted_answers($student_answers); my %answer_hash = %$rh_answer_hash; my ($label, $value); foreach $label (keys %answer_hash) {$inputs{$label} = $answer_hash{$label};} } } $show_old_answers = $inputs{'original_show_old_answers'} if defined( $inputs{'original_show_old_answers'} ); ## if returning from previewing, restore the original_show_old_answers mode # Determine language from the file extension(e.g. file.pg or file.pz) $displayMode = &getProblemFileName($probNum,$psvn); $displayMode = $inputs{'probFileName'} if defined($inputs{'probFileName'}); $displayMode =~ s/^.*\.([^\.]*)$/$1/; # get problem name my $probFileName = &getProblemFileName($probNum,$psvn); $probFileName = $inputs{'probFileName'} if defined($inputs{'probFileName'}); # determine time status. # 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. if ( ( ( $User ne &getStudentLogin($psvn)) ||($currentTime < $odts) ) and ($permissions != $Global::instructor_permissions) and ($permissions != $Global::TA_permissions) ) { &hackerError; exit; } ## check to see if it is after due + answer date, if so, put note by ## submit answer button (below) my $dueDateNote = ""; my $answerNote = ""; if($currentTime>$ddts) {$dueDateNote=" Note: it is after the due date.\n";} if($currentTime>$adts) {$answerNote= " Answers available.\n";} # determine display defaults my ($displayCorrectAnswersQ,$displayShowAnswerLineQ); $displayShowAnswerLineQ = ($permissions == $Global::instructor_permissions) || ($currentTime > $adts) ; $displayCorrectAnswersQ = 1 if $answersRequestedQ && ($currentTime > $adts); $displayCorrectAnswersQ = 1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions); my $displaySolutionsQ = 0; $displaySolutionsQ = 1 if $solutionsRequestedQ && ($currentTime > $adts); $displaySolutionsQ = 1 if $solutionsRequestedQ && ($permissions == $Global::instructor_permissions); my $displayHintsQ = 0; $displayHintsQ = 1 if $hintsRequestedQ; #check if we need to save the updated version of the text my $problem_has_been_saved = ''; if ( defined($inputs{'action'}) && ( $inputs{'action'} eq 'Save updated version' ) && ($permissions == $Global::instructor_permissions) && defined($inputs{'source'}) ) { my $temp_source = decodeSource($inputs{'source'}); $temp_source=~ s/\r\n/\n/g; #$temp_source = $cgi -> unescape( $temp_source ); saveProblem($temp_source, $probFileName); $problem_has_been_saved = "

Current version of the problem ${templateDirectory}$probFileName has been saved.

The original version has been appended to the file ${templateDirectory}$probFileName.bak .
"; undef($inputs{'source'}); # make sure that we read input from the saved version } #check if we need to save the updated version of the text as a new problem if ( defined($inputs{'action'}) && ( $inputs{'action'} eq 'Save as' ) && ($permissions == $Global::instructor_permissions) && defined($inputs{'source'}) ) { my $temp_source = decodeSource( $inputs{'source'} ); $temp_source=~ s/\r\n/\n/g; #$temp_source = $cgi -> unescape( $temp_source ); my $new_file_name = $inputs{'new file name'}; saveNewProblem($temp_source, $new_file_name); $problem_has_been_saved = "

The file ${templateDirectory}$new_file_name has been saved.

The new problem must be added to the set definition file and the set must be rebuilt before the new problem will be displayed as part of the regular set.
"; } # get the text source of the problem # first determine whether to load the source (and seed) from the calling HTML form or from the disk my $readSourceFromHTMLQ =0; $readSourceFromHTMLQ = 1 if ( # load source from HTML if these conditions are met: ($permissions == $Global::instructor_permissions || # only instructors can modify the source ($User eq "practice666" )) && # practice666 can generate source defined($inputs{'source'}) && # there is a source field in the form defined($inputs{'seed'}) && # you need a seed field as well defined($inputs{'readSourceFromHTMLQ'}) && $inputs{'readSourceFromHTMLQ'} == 1 # and the calling form asks that its source be read ); # Over ride button forces reading the source from the disk. if (defined($inputs{'action'}) and $inputs{'action'} eq 'Read problem from disk') { $readSourceFromHTMLQ = 0; $inputs{refreshCachedImages} = 1; # force the Latex2HTML rendering to be redone } # Determine whether to insert the source into the outgoing form. my $insertSourceIntoFormQ = 0; $insertSourceIntoFormQ = 1 if ( # insert the source field into forms only if these conditions are met: ($permissions == $Global::instructor_permissions) || # only instructors can modify the source ($User eq "practice666" ) # practice666 can also ); # Now lets get the source and the seed. my $source; my $seed; if ( $readSourceFromHTMLQ ) { # $source = $inputs{'source'}; $source = decodeSource($inputs{'source'}); # if ( defined($inputs{'source_encoded_using'}) ) { # the source has been encoded and we need to decode it first # if ( $inputs{'source_encoded_using'} eq 'base64_encode' ) { # $source = decode_base64($source); # } # elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) { # $source = $cgi -> unescape($source); # } # elsif ( $inputs{'source_encoded_using'} eq 'none' ) { # # no action needed # # } # elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns' ) { # $source =~s/ /\n/g; warn "uncoding escaped returns"; # $source =~s/\r\n/\n/g; # } # else { # warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}"; # } # } ##substitute carriage return with a newline ##otherwise EndOfText construction does not work ##browsers always have \r\n at the end of the line $source=~ s/\r\n/\n/g; # get seed from the appropriate place $seed = $inputs{'seed'}; } elsif ($probFileName eq '') { $probFileName = "New File"; $source = ''; $seed ="11111"; # perhaps we can pick a better initial value for the seed. } else { if (-e "${templateDirectory}$probFileName" ) { #print "|$probFileName|
"; unless (-r "${templateDirectory}$probFileName") { wwerror($0, "Can't read ${templateDirectory}$probFileName"); } open(PROB,"<${templateDirectory}$probFileName"); $source = join('',); close(PROB); } else { wwerror($0, "

Error: The problem ${templateDirectory}$probFileName could not be found!

"); } $seed = &getProblemSeed($probNum, $psvn); } ################################################## # begin processing problem ################################################## my %envir=defineProblemEnvir($mode,$probNum,$psvn,$Course); # my @envir_array = %envir; # warn "@envir_array"; #DEBUG ##Need to check what language is used here #this comes from createDisplayedProblem in displayMacros my @printlines; #this is no longer used DME 6/15/2000 #my $refSubmittedAnswers=$envir{'refSubmittedAnswers'}; # require "${courseScriptsDirectory}PG_module_list.pl"; # (Modules are defined by this require statement found near the top of this file, outside the loop.) my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator; $pt->{ra_included_modules} = [ @PGtranslator::class_modules ]; # copy from PGtranslator stub $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 at Indiana. my $imgen=""; if($mode eq 'HTML_dpng') { # for John Jones' WW1 ImageGenerator: #$imgen = new ImageGenerator; #$imgen->initialize(\%envir); # for Sam's WW2 ImageGenerator: $imgen = WeBWorK::PG::ImageGenerator->new( tempDir => $Global::tempDirectory, latex => $Global::externalLatexPath, dvipng => $Global::externalDvipngPath, useCache => 1, cacheDir => $Global::equationCacheDirectory, cacheURL => $Global::equationURL, cacheDB => $Global::equationCacheDB, ); } $envir{imagegen} = $imgen; $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 -> unrestricted_load("${courseScriptsDirectory}IO.pl"); $pt -> rf_safety_filter( \&safetyFilter); # install blank safety filter $pt -> translate(); # dereference some flags returned by createPGtext; if ( defined( $pt ->rh_flags ) ) { $main::showPartialCorrectAnswers = $pt ->rh_flags->{'showPartialCorrectAnswers'}; $main::recordSubmittedAnswers = $pt ->rh_flags->{'recordSubmittedAnswers'}; $main::refreshCachedImages = $pt ->rh_flags->{'refreshCachedImages'}; } # Code for logging students's answers to allow inspection of answer history. logCourseData($User,$setNumber,$probNum,\%inputs,$pt) if ($answers_submitted and !$preview_mode and $main::recordSubmittedAnswers); # Don't log previewed answers nor answer which are supposed to be anonymous # $Global::logCourseAnswerData must be 1 in order to activate this subroutine. # End student answer logging code. if($mode eq 'HTML_dpng') { my $forceRefresh=0; if($inputs{'refreshCachedImages'} || $main::refreshCachedImages || $displaySolutionsQ || $displayHintsQ) { $forceRefresh=1; } # for both John Jones' WW1 ImageGenerator and Sam's WW2 ImageGenerator: $imgen->render('refresh'=>$forceRefresh); # Can force new images } # massage problem text if necessary. if($mode eq "HTML" || $mode eq 'HTML_tth' || $mode eq 'HTML_dpng' || $mode eq 'HTML_jsMath' || $mode eq 'HTML_asciimath' || $pt ->rh_flags->{'error_flag'}) { @printlines=@{ $pt->ra_text() }; } elsif ($mode eq 'Latex2HTML') { my %PG_flags = %{ $pt->rh_flags() }; $PG_flags{'refreshCachedImages'} = $inputs{'refreshCachedImages'}; $PG_flags{'refreshCachedImages'} = 1 if $main::refreshCachedImages; $PG_flags{'refreshCachedImages'} = 1 if $displaySolutionsQ; $PG_flags{'refreshCachedImages'} = 1 if $displayHintsQ; @printlines = &createDisplayedProblem($setNumber,$probNum,$psvn,$pt->ra_text(),\%PG_flags ); @printlines = &l2h_sticky_answers($envir{'inputs_ref'}, \@printlines, $pt->rh_flags() ); # @printlines = &l2h_update_keys($envir{'sessionKey'}, \@printlines); } elsif ($mode eq "TeX") { #TEMPORARY KLUDGE @printlines = @{$pt->ra_text() }; } else { @printlines="$0: Error: Mode |$mode| is not HTML, HTML_tth, HTML_dpng, HTML_jsMath,HTML_asciimath or Latex2HTML."; } # Determine the problem_state # Determine the recorded score my $recorded_score = getProblemStatus($probNum, $psvn); # Initialize the variables reporting the answers my $rh_answer_results = {}; my $rh_problem_result = {}; my $rh_problem_state = {}; my $record_problem_message = ''; my $answer_line_text = ''; my $preview_text = ''; my $expected_answer_count = keys( %{ $pt -> rh_correct_answers() } ); # count the number of correct answers # Determine which problem grader to use #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE}; if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty if ($problem_grader_to_use eq 'std_problem_grader') { # Reset problem grader to standard problem grader. $pt->rf_problem_grader($pt->rf_std_problem_grader); } elsif ($problem_grader_to_use eq 'avg_problem_grader') { # Reset problem grader to average problem grader. $pt->rf_problem_grader($pt->rf_avg_problem_grader); } elsif (ref($problem_grader_to_use) eq 'CODE') { # Set problem grader to instructor defined problem grader -- use cautiously. $pt->rf_problem_grader($problem_grader_to_use) } else { warn "Error: Could not understand problem grader flag $problem_grader_to_use"; #this is the default set by the translator and used if the flag is not understood #$pt->rf_problem_grader($pt->rf_std_problem_grader); } } else {#this is the default set by the translator and used if no flag is set. #$pt->rf_problem_grader($pt->rf_std_problem_grader); } } # creates and stores a hash of answer results: $rh_answer_results if ($answers_submitted == 1) { $pt -> process_answers(\%inputs); } else { $pt -> process_answers({}); ## pass a ref to an empty hash to process_answers ## so that problem graders messages will be ## output even when looking at a problem the ## first time } #################################################################### # If preview mode has been selected, build the preview page and exit #################################################################### if (($preview_mode ==1) and ($answers_submitted ==1)) { my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ? $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; $preview_text = preview_answers( $pt->rh_evaluated_answers, $rh_problem_result, { ANSWER_ENTRY_ORDER => $ra_answer_entry_order, ANSWER_PREFIX => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr' } ); build_preview_page(); exit(0); } #################################################################### # set the problem state. # Record the grade and report the answer results #################################################################### $pt->rh_problem_state({ recorded_score => $recorded_score , num_of_correct_ans => &getProblemNumOfCorrectAns($probNum,$psvn) , num_of_incorrect_ans => &getProblemNumOfIncorrectAns($probNum,$psvn) } ); my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ? $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, ANSWER_ENTRY_ORDER => $ra_answer_entry_order ); # grades the problem. # If there was a syntax error, do not report partial correct answers: $main::showPartialCorrectAnswers = 0 if defined($rh_problem_result->{show_partial_correct_answers}) and $rh_problem_result->{show_partial_correct_answers} == 0; if ($answers_submitted == 1) { # Store the answers an an encoded form in the database my $saved_submitted_answers_string = encode_submitted_answers($ra_answer_entry_order); # If an answer form has been submitted format answer message, # record problem status and format the record_problem_message # check if before due date and number of incorrect attempts is # below limit (if any). If so, record answer $record_problem_message = ''; my $attemptsRemaining = getProblemMaxNumOfIncorrectAttemps($probNum,$psvn) - getProblemNumOfCorrectAns($probNum,$psvn) - getProblemNumOfIncorrectAns($probNum,$psvn); ## Professors and TA's are allowed to submit answers without results being recorded my $doNotRecordAnswers = 0; if (($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions)) { $doNotRecordAnswers = 1 if $doNotRecordAnsRequestedQ; } # Allow some leeway in the accepting of answers. Davide Cervone if ( (not $doNotRecordAnswers) and ($currentTime<=$ddts+$Global::dueDateLeeway) and ( ( getProblemMaxNumOfIncorrectAttemps($probNum,$psvn) < 0 ) or ( $attemptsRemaining >= 1 )) ) { &save_problem_state($saved_submitted_answers_string,$rh_problem_state,$probNum,$inputs{'user'},$psvn); } else { if ($doNotRecordAnswers){ $record_problem_message = "Note: Answer not recorded.
"; } elsif ($currentTime>$ddts+$Global::dueDateLeeway){ $record_problem_message = "Note: Answer not recorded - it is after the due date.
"; } else { $record_problem_message = "Note: Answer not recorded - You have already attempted this problem the maximum allowed number of times.
"; } } #################################################################### # Format the answer section of the displayed problem #################################################################### my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ? $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; $answer_line_text = display_answers( $pt->rh_evaluated_answers, $rh_problem_result, { displayCorrectAnswersQ => $displayCorrectAnswersQ, showPartialCorrectAnswers => $main::showPartialCorrectAnswers, ANSWER_ENTRY_ORDER => $ra_answer_entry_order, ANSWER_PREFIX => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr' } ); } #################################################################### ### format problem status message ### #################################################################### my $status = getProblemStatus($probNum,$psvn); my $attempted = getProblemAttempted($probNum,$psvn); my $problemStatusMessage = ''; if ( !$attempted) { $problemStatusMessage = "Our records show problem $probNum of set $setNumber_display has not been attempted."; # default value } elsif ($status >= 0 and $status <=1) { my $percentCorr = int(100*$status+.5); my $problemValue = &getProblemValue($probNum,$psvn); my $score = round_score($status*$problemValue); my $pts = 'points'; if ($score == 1) {$pts = 'point';} $problemStatusMessage = "Our records show problem $probNum of set $setNumber_display has a score of ${percentCorr}\% ($score $pts)."; } else { $problemStatusMessage = "Our records show problem $probNum of set $setNumber_display has an unknown status."; } ########## end format problem status message ####### ########################################################## ###### format messages about time remaining. Contributed by Davide Cervone. ########################################################## my $currentTimeMessage = ''; if (($Global::showRemainingTime) and (($ddts-$currentTime) < $Global::startShowingRemainingTime)) { my ($ctime) = formatDateAndTime($currentTime); my ($rtime) = formatTimeRemaining($ddts-$currentTime); $currentTimeMessage = "You have $rtime remaining to complete this problem (reload page to update times)."; } sub formatTimeRemaining { my ($seconds) = @_; return("no time") if ($seconds <= 0); my ($minutes) = int($seconds/60); my ($hours) = int($minutes/60); my ($days) = int($hours/24); my ($message) = "about"; if ($days > 1) {$message = "$days days"} elsif ($days == 1) {$message = "1 day"} else { if ($hours > 1) {$message = "$hours hours"} elsif ($hours == 1) {$message = "1 hour"} $minutes -= 60*$hours; $minutes++ if ($seconds >= 30); if ($minutes > 1) {$message .= " $minutes minutes"} elsif ($minutes == 1) {$message .= " 1 minute"} if ($hours == 0) { if ($minutes == 0) {if ($seconds > 1) {$message = "$seconds seconds"} else {$message = "1 second"}} if ($minutes < 30) { $message = ''.$message.''; $message =~ s/(.*)About /About$1/; } } } return $message; } ########## end format time remaining message ####### ########################################################## ###### format messages about number of attempts remaining. ########################################################## my $maxNumOfIncorrectAttempts = &getProblemMaxNumOfIncorrectAttemps($probNum,$psvn); my $numOfCorrectAns = &getProblemNumOfCorrectAns($probNum,$psvn); my $numOfIncorrectAns = &getProblemNumOfIncorrectAns($probNum,$psvn); my $numOfAttempts = $numOfCorrectAns + $numOfIncorrectAns; my $maxAttemptNote = ""; my $attemptsRemaining = $maxNumOfIncorrectAttempts -$numOfAttempts; # ################################################# # begin printing the HTML text # ################################################# my $Edited = ''; my $bg_color = undef; $bg_color = $Global::bg_color if $Global::WARNINGS ; $Edited = "EDITED " if $readSourceFromHTMLQ; $Edited = "NEW FILE " if (defined($inputs{'action'}) and ($inputs{'action'} eq 'Save as')); print &processProblem_htmlTOP("${Edited}Problem $probNum", ${ $pt->r_header }, $bg_color # background color ); #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. #text in case the problem has been saved print $problem_has_been_saved; ################print Navigation Bar ########### print &format_navigation_bar($previousProbNum,$nextProbNum,$numberOfProblems); ##############print warning about setting the Encoding properly############### my $browser = $cgi -> user_agent(); # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) | $browser =~ m|Mozilla/([\d.]+)|; my $version = $1; print( qq!

WARNING: Versions of Netscape before 4.0 running on a Macintosh computer will not be able to display all the math symbols correctly in formatted text mode. Square root and integral signs may disappear entirely. Please use another mode.

When using Netscape 4 or greater on a Macintosh computer, set your fonts by choosing
View -->Encoding-->Western(MacRoman) from the menu. This will make square root signs and integral signs display correctly.

!) if ($mode eq 'HTML_tth' && $browser =~/Macintosh/ && $version < "4"); ###############begin Answer Section########### if ($answers_submitted ==1) { # print "
Problem grader message is:
" , $rh_problem_result->{msg} if defined($rh_problem_result->{msg}); print $answer_line_text, $record_problem_message; print( "
Problem grader errors are " . $rh_problem_result->{errors} ) if $rh_problem_result->{errors}; } print "\r\n\r\n"; ################begin Problem Text ########### print "\n",$cgi -> startform(-action=>"$Global::processProblem_CGI"),"\n\n"; print "\r\n\r\n"; print @printlines; print "\r\n\r\n"; print '

'; ################print Submit button and display check boxes########### print 'Note:' . $pt->rh_problem_result->{msg} . '
' if ($pt->rh_problem_result->{msg}); print "$currentTimeMessage

"; my $s = ''; if( $expected_answer_count > 1) { $s = 's'; #makes the Answer button plural (purely cosmetic) } # Decide whether the Do not save answers is visible if (($User ne &getStudentLogin($psvn)) and ( ($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions) ) ) { print $cgi -> checkbox(-name=>'doNotRecordAns', -value=>1, -label=>"Do Not Record Answer$s", -checked, -override => 1), "\n\t"; } else { print $cgi -> hidden(-name=>'doNotRecordAns', -value => 0,override => 1), "\n\t"; } # Decide whether the showHint line is visible if ( defined($pt ->rh_flags->{'hintExists'}) and ($pt ->rh_flags->{'hintExists'} ==1) and ($numOfAttempts >= $pt ->rh_flags->{'showHintLimit'}) ) { print $cgi -> checkbox(-name=>'ShowHint', -value=>1, -label=>"Show Hint", -override => 1); } else { print $cgi -> hidden(-name=>'ShowHint', -value=>0, -override => 1), "\n\t"; } # Decide whether the showAnswer line is visible if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ) { print $cgi -> checkbox(-name=>'ShowAns', -value=>1, -label=>"Show Correct Answer$s", -override => 1), "\n\t"; } else { print $cgi -> hidden(-name=>'ShowAns', -value => 0,-override => 1), "\n\t"; } # Decide whether the showSolution line is visible if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ and defined($pt ->rh_flags->{'solutionExists'}) and $pt ->rh_flags->{'solutionExists'} ==1) { print $cgi -> checkbox(-name=>'ShowSol', -value=>1, -label=>"Show Solution$s", -override => 1); } else { print $cgi -> hidden(-name=>'ShowSol', -value=>0, -override => 1), "\n\t"; } ## check to see if $numOfAttempts is approaching or at the limit ## $maxNumOfIncorrectAttempts. If so, put note by ## submit answer button (below) ## $maxNumOfIncorrectAttempts = -1 means unlimited attempts my $plural = ''; $plural = 's' if $attemptsRemaining > 1; if(($maxNumOfIncorrectAttempts >= 0) and ($attemptsRemaining <= 0) and ($currentTime<=$ddts)) { $maxAttemptNote = " Note: You have already attempted this problem the maximum allowed number of times.\n"; } elsif (($maxNumOfIncorrectAttempts >= 0) and ($attemptsRemaining <= $Global::maxAttemptsWarningLevel) and ($currentTime<=$ddts) ) { $maxAttemptNote = " Note: You are allowed only $attemptsRemaining more attempt$plural at this problem.\n"; } ############# print hidden information about problem and set print $cgi -> hidden( -name => 'probNum', -value => $probNum ), "\n\t", $cgi -> hidden( -name => 'probSetKey', -value => $psvn ), "\n\t", $cgi->hidden( -name=>'show_old_answers', -value=>$show_old_answers), "\n\t", $cgi -> hidden( -name => 'answer_form_submitted', -value => 1 ); # alerts the problem to show answers. my $button_style = 'width: 12em'; #sessionKeyInputs() in scripts/HTMLglue.pl print &sessionKeyInputs(\%inputs), "
", qq!$maxAttemptNote $dueDateNote $answerNote!, "
", $cgi -> submit( -name => 'action', -value=>"Submit Answer$s", -style=>$button_style), # -onClick=>"submitProblem()" # this javaScript call caused problems on some older browsers -- removed temporarily while we find a fix "\n\t", $cgi -> submit( -name => 'action', -value=>"Preview Answer$s", -style=>$button_style),"\n\t"; if ($mode ne 'TeX') { #TEMPORARY KLUDGE my $displayMode_hidden_inputs = displaySelectModeLine_string($mode); $displayMode_hidden_inputs =~ s/
//g; # remove returns to get one line display print "
$displayMode_hidden_inputs
"; } # $source =~ s/([^\r])\n/$1\r\n/g; # replace any bare \n by \r\n # $source =~ s/\n/ /g; # my $sourceAsHTMLEncodingMethod = 'escaped_returns'; # this makes iCab work properly my $sourceAsHTMLEncodingMethod = 'base64_encode'; my $sourceAsHTML = encode_base64($source); if ($readSourceFromHTMLQ ) { # reading from source is a sticky option. print $cgi -> hidden(-name => 'readSourceFromHTMLQ', -value => "1" ); print "
\r\n", $cgi -> hidden(-name => 'source_encoded_using', -value => $sourceAsHTMLEncodingMethod, -override => 1), "
\r\n", $cgi -> hidden(-name => 'source', -value => $sourceAsHTML, -override => 1), "
\r\n", $cgi -> hidden(-name => 'seed', -value => "$seed" ); } print "\r\n\r\n"; if ($readSourceFromHTMLQ ) { print $cgi -> submit(-name => 'action', -value => 'Read problem from disk'); # this allows an override about reading from the HTML source # This ensures that we are using the current (possibly changed) # seed even if we are resubmitting answers to a question. } print $cgi -> endform(); print "\r\n\r\n"; ############################################################# ## End of main form, containing the problem and answer rules ############################################################# ##print the form to get the editor in a different window if the ##person using WeBWorK has professor permissions ############################################################# ## Show editor form ############################################################# if ($insertSourceIntoFormQ) { print "\n\n\n"; print "


\n\n\n
"; print $cgi -> startform(-action=>"$Global::problemEditor_CGI", -target=>'editor'), &sessionKeyInputs(\%inputs), $cgi -> hidden( -name =>'source_encoded_using', -value => $sourceAsHTMLEncodingMethod, -override =>1), "\r\n", $cgi -> hidden( -name =>'source', -value => $sourceAsHTML, -override =>1), "\r\n", $cgi -> submit( -name =>'action', -value => "Show Editor", -style=> $button_style), "\r\n", $cgi -> hidden( -name =>'probSetKey', -value => $psvn), "\r\n", $cgi -> hidden( -name =>'probNum', -value => $probNum), "\n", $cgi -> hidden( -name =>'Mode', -value => $mode, -override =>1), "\r\n", $cgi -> hidden( -name =>'seed', -value => $seed, -override =>1), "\r\n", $cgi -> endform(); # Code for logging students's answers to allow inspection of answer history. if ($Global::logCourseAnswerData) { print ""; print $cgi->startform(-action=>"$Global::showPastAnswers_CGI", -target=>'information'), &sessionKeyInputs(\%inputs), $cgi->hidden(-name => 'probNum', -value=>$probNum), "\n", $cgi->hidden(-name => 'setNum', -value=>$setNumber), "\n", $cgi->hidden(-name => 'User', -value=>getStudentLogin($psvn)), "\n", $cgi->submit(-name => 'action', -value=>'Show Past Answers', -style=> $button_style), "\n", $cgi->endform(); print "
\n"; } # End code for logging students's answers } ############################################################# ## End "Show editor" form ################################################################ print &htmlBOTTOM($0, \%inputs, 'processProblemHelp.html'); $main::Course = $Course; $main::User = $User; exit(0); ### DONE ### ############################################ ## SUBROUTINES specific to processProblem.pl # this normally loads in macro files -- but for the demo this is done by hand. sub save_problem_state { my ($saved_submitted_answers_string,$rh_problem_state, $num,$user, $psvn)=@_; # define constants my $DELIM = $Global::delim; my $scoreFilePrefix = $Global::scoreFilePrefix; my $dash = $Global::dash; my $numericalID = $Global::numericalGroupID; $numericalID = $Global::numericalGroupID; # #&attachProbSetRecord($psvn); # (not needed); my($setNumber)=&getSetNumber($psvn); my ($scoreFileName)="${databaseDirectory}$scoreFilePrefix$setNumber$dash${psvn}.sco"; unless (-e $scoreFileName) { &createFile($scoreFileName, $Global::sco_files_permission, $numericalID); } open(TEMP_FILE,">>$scoreFileName") || print "Couldn't record answer in $scoreFileName"; my $time = &formatDateAndTime(time); # add time stamp print TEMP_FILE "$num $DELIM " . $rh_problem_state->{recorded_score} . " $DELIM " . $rh_problem_state->{num_of_correct_ans} . " $DELIM" . $rh_problem_state->{num_of_incorrect_ans} . " $DELIM $user $DELIM $time\n"; close(TEMP_FILE); putProblemStudentAnswer($saved_submitted_answers_string,$num,$psvn) if $main::recordSubmittedAnswers; &putProblemNumOfCorrectAns($rh_problem_state->{num_of_correct_ans},$num,$psvn) if defined($rh_problem_state->{num_of_correct_ans}) ; &putProblemNumOfIncorrectAns($rh_problem_state->{num_of_incorrect_ans},$num,$psvn) if defined($rh_problem_state->{num_of_incorrect_ans}); &putProblemAttempted(1,$num,$psvn); ## save_problem_state() is run only if the submit button has been ## hit so that means the problem has been attempted if ( defined($rh_problem_state->{recorded_score}) ) { &putProblemStatus( $rh_problem_state->{recorded_score} ,$num,$psvn); } else { warn "Error no recorded_score has been calculated for this problem."; } #my %temp1 = getProbSetRecord($psvn); #warn "number of correct attempts is pst$num ", $temp1{"pst$num"}; &detachProbSetRecord($psvn); }; sub hackerError { ## prints hacker error message my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". $cgi -> remote_host()."\n"; $msg .= $cgi -> query_string(); # &Global::log_error('hacker error', $cgi -> 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"), "

Error:Please do not try to hack into WeBWorK!

", $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"), $cgi ->p , &sessionKeyInputs(\%inputs), $cgi -> hidden(-name=>'local_psvns', -value=>$psvn), $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'), $cgi -> endform(), &htmlBOTTOM($0, \%inputs); } sub selectionError ## prints error message { print &htmlTOP("Error: need to select problem"), "

Error: You must select a problem!

", $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"), &sessionKeyInputs(\%inputs), $cgi -> hidden(-name=>'local_psvns', -value=>$psvn), $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'), $cgi -> submit(-value=>"Return to Problem Set"), $cgi -> endform(), &htmlBOTTOM($0, \%inputs); } ################################################### sub decodeSource { my $source = shift; warn "Only source embedded in HTML needs to be decoded" unless defined($inputs{'source'}); if ( defined($inputs{'source_encoded_using'}) ) { # the source has been encoded and we need to decode it first if ( $inputs{'source_encoded_using'} eq 'base64_encode' ) { $source = decode_base64($source); } elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) { $source = $cgi -> unescape($source); } elsif ( $inputs{'source_encoded_using'} eq 'none' ) { # no action needed } elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns' ) { $source =~s/ /\n/g; warn "uncoding escaped returns"; $source =~s/\r\n/\n/g; } else { warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}"; } } $source; } sub safetyFilter { # my $answer = shift; # accepts one answer and checks it # $answer = '' unless defined $answer; # my ($errorno, $answerIsCorrectQ); # $answer =~ tr/\000-\037/ /; # #### Return if answer field is empty ######## # unless ($answer =~ /\S/) { # $errorno =1; # "No answer was submitted."; # # return ($answer,$errorno); # } # ######### replace ^ with ** (for exponentiation) # # $answer =~ s/\^/**/g; # ######### Return if forbidden characters are found # unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]+$/ ) { # $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]/#/c; # $errorno = 2; # "There are forbidden characters in your answer: $submittedAnswer
"; # # return ($answer,$errorno); # } # my $answer = shift @_; my $errorno = 0; return($answer, $errorno); } sub processProblem_htmlTOP { my ($title, $header_text, $bg_url) = @_; my $bg_color = $bg_url || $Global::bg_color; $header_text = '' unless defined($header_text); # my $out = header(-type=>'text/html'); # $out .= start_html(-'title'=>$title, # -script=>$header_text, # -background=>$background_url); my $test = $cgi -> user_agent(); # determine the proper charset my $charset_definition; my $browser = $cgi -> user_agent(); # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) | if ($browser =~/Macintosh/ or $browser =~/Mac_PowerPC/) { # do we need to know the mode in order to set this properly?? $charset_definition = q{charset="x-mac-roman";}; } else { $charset_definition =q{}; } my $out = < $title $header_text

ENDhtmlTOP $out; } sub preview_answers_htmlTOP { my ($title, $header_text, $bg_url) = @_; my $bg_color = $bg_url || $Global::bg_color; $header_text = '' unless defined($header_text); my $out = < $title $header_text

ENDhtmlTOP $out; } sub format_navigation_bar { my ($previousProbNum, $nextProbNum,$numberOfProblems) = @_; ## first set up the navigation button forms my $prev_prob_form = ''; unless($previousProbNum <= 0) { $prev_prob_form = join("\n", $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"), $cgi->input({-type=>'IMAGE', -src=>"$Global::previousImgUrl", -alt=>'<--Previous Problem'}), $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'probNum', -value=>"$previousProbNum", -override=>1), $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"), $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers), $cgi->hidden(-name=>'user', -value=>"$inputs{user}"), $cgi->hidden(-name=>'key', -value=>"$inputs{key}"), $cgi->hidden(-name=>'course', -value=>"$inputs{course}"), $cgi->endform() ); } my $prob_list_form = join("\n", $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"), $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}), $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'action', -value=>"Do_problem_set",-override=>1), $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"), $cgi->hidden(-name=>'user', -value=>"$inputs{user}"), $cgi->hidden(-name=>'key', -value=>"$inputs{key}"), $cgi->hidden(-name=>'course', -value=>"$inputs{course}"), $cgi->endform() ); my $next_prob_form = ''; unless($nextProbNum > $numberOfProblems) { $next_prob_form = join("\n", $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"), $cgi->input({-type=>'IMAGE', -src=>"$Global::nextImgUrl", -alt=>'Next Problem-->'}), $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'probNum', -value=>"$nextProbNum", -override=>1), $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"), $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers), $cgi->hidden(-name=>'user', -value=>"$inputs{user}"), $cgi->hidden(-name=>'key', -value=>"$inputs{key}"), $cgi->hidden(-name=>'course', -value=>"$inputs{course}"), $cgi->endform() ); } ## next set up the inner table my $inner_table = $cgi->table( $cgi->Tr( $cgi->td({-align=>'CENTER', -valign=>'MIDDLE'},[$prev_prob_form, $prob_list_form, $next_prob_form]) ) ); ## finally set up the main table my $navigation_bar = $cgi->table({-border=>0,-width=>'100%'}, $cgi->Tr({-align=>'CENTER', -valign=>'TOP'}, $cgi->td({-align=>'LEFT', -valign=>'MIDDLE'},$inner_table), $cgi->td({-align=>'CENTER', -valign=>'MIDDLE'}), $cgi->td({-align=>'RIGHT', -valign=>'TOP', -rowspan=>2}, $cgi->a({-href=>$Global::webworkDocsURL}, $cgi->img({-src=>$Global::squareWebworkGif,-border=>1,-alt=>'WeBWorK Docs'})) ) ), $cgi->Tr( $cgi->td({-align=>'LEFT', -valign=>'BOTTOM'}, $cgi->h4($problemStatusMessage)) ) ); return $navigation_bar; } sub format_preview_navigation_bar { my $curentProbNum = shift; ## first set up the navigation button forms my $current_prob_form = join("\n", $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"), $cgi->input({-type=>'IMAGE', -src=>"$Global::currentImgUrl", -alt=>'Current Problem'}), $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'probNum', -value=>"$curentProbNum", -override=>1), $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"), $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers), $cgi->hidden(-name=>'user', -value=>"$inputs{user}"), $cgi->hidden(-name=>'key', -value=>"$inputs{key}"), $cgi->hidden(-name=>'course', -value=>"$inputs{course}"), $cgi->endform() ); my $prob_list_form = join("\n", $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"), $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}), $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"), $cgi->hidden(-name=>'action', -value=>"Do_problem_set",-override=>1), $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"), $cgi->hidden(-name=>'user', -value=>"$inputs{user}"), $cgi->hidden(-name=>'key', -value=>"$inputs{key}"), $cgi->hidden(-name=>'course', -value=>"$inputs{course}"), $cgi->endform() ); ## next set up the inner table my $inner_table = $cgi->table( $cgi->Tr( $cgi->td({-align=>'CENTER', -valign=>'MIDDLE'},[$current_prob_form, $prob_list_form]) ) ); ## finally set up the main table my $navigation_bar = $cgi->table({-border=>0,-width=>'100%'}, $cgi->Tr({-align=>'CENTER', -valign=>'TOP'}, $cgi->td({-align=>'LEFT', -valign=>'MIDDLE'},$inner_table), $cgi->td({-align=>'RIGHT', -valign=>'TOP', -width=>'20%', -rowspan=>2}, $cgi->a({-href=>$Global::webworkDocsURL}, $cgi->img({-src=>$Global::squareWebworkGif,-border=>1,-alt=>'WeBWorK Docs'})) ) ), $cgi->Tr( $cgi->td({-align=>'LEFT', -valign=>'BOTTOM'}, $cgi->h4("Preview Answers for Problem $probNum of Set $setNumber_display")) ) ); return $navigation_bar; } ##Subroutine saveProblem takes the modified source of the problem and ##saves it to the file with the original problem name and appends the ##old version of the problem to the file problemname.pg.bak sub saveProblem { my ($source, $probFileName)= @_; my $org_source; #######get original source of the problem if (-e "${templateDirectory}$probFileName" ) { unless (-w "${templateDirectory}$probFileName") { wwerror($0, "Can't write to ${templateDirectory}$probFileName.\n" . "No changes were saved.\n" . "Check that the permissions for this problem are 660 (-rw-rw----)\n", "", "", $cgi -> query_string()); } open(PROB,"<${templateDirectory}$probFileName"); $org_source = join("",); close(PROB); } else { wwerror($0, "

Error: The problem ${templateDirectory}$probFileName could not be found!

"); } #######append old version to problemfilename.pg.bak: open BAKFILE, ">>${templateDirectory}${probFileName}.bak" or wwerror($0, "Could not open \n${templateDirectory}${probFileName}.bak for appending.\nNo changes were saved."); my ($sec, $min, $hour, $mday, $mon, $year)=localtime(time); print BAKFILE "##################################################################\n", "##########Date:: $mday-$mon-$year, $hour:$min:$sec################", "\n\n\n"; print BAKFILE $org_source; close BAKFILE; chmod 0660, "${templateDirectory}${probFileName}.bak" || print "Content-type: text/html\n\n CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}.bak"; #######copy new version to the file problemfilename.pg open (PROBLEM, ">${templateDirectory}$probFileName") || wwerror($0, "Could not open ${templateDirectory}$probFileName for writing. Check that the permissions for this problem are 660 (-rw-rw----)"); print PROBLEM $source; close PROBLEM; chmod 0660, "${templateDirectory}${probFileName}" || print "Content-type: text/html\n\n CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}"; } ##Subroutine saveNewProblem takes the modified source of the problem and ##saves it to the file with the $new_file_name sub saveNewProblem { my ($source, $new_file_name)= @_; #######check that the new file name is legal unless ($new_file_name =~ /^\w/ ) { wwerror($0, "The file name or path\n". "$new_file_name\n". "can not begin with a non word character.\n" . "The new version was not saved.\n" . "Go back and choose a different name."); } if ($new_file_name =~ /\.\./ ) { wwerror($0, "The file name or path\n". "$new_file_name\n". "is illegal.\n" . "The new version was not saved.\n" . "Go back and choose a different name."); } #######check that the new file name doesn't exist if (-e "${templateDirectory}$new_file_name" ) { wwerror($0, "The file\n". "${templateDirectory}$new_file_name\n". "already exists.\n" . "The new version was not saved.\n" . "Go back and choose a different file name or\, if you really want to edit\n". "${templateDirectory}$new_file_name\,\n". "go back and hit the \"Save updated version\" button."); } #######copy new version to the file new_file_name open (PROBLEM, ">${templateDirectory}$new_file_name") || wwerror($0, "Could not open ${templateDirectory}$new_file_name for writing. Check that the permissions for the directory ${templateDirectory} are 770 (drwxrwx---) Also check permissions for any subdirectories in the path."); print PROBLEM $source; close PROBLEM; chmod 0660, "${templateDirectory}$new_file_name" || print "Content-type: text/html\n\n CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}$new_file_name"; } sub build_preview_page { print preview_answers_htmlTOP("Preview Answers for Problem $probNum", '',$bg_color); print format_preview_navigation_bar($probNum); print $cgi -> startform(-action=>"$Global::processProblem_CGI"); print $preview_text; ############# print hidden information about problem and set $s = ''; if( $expected_answer_count > 1) {$s = 's'; } print $cgi -> hidden(-name=>'probNum', -value=>$probNum), $cgi -> hidden(-name=>'probSetKey', -value=>$psvn), $cgi -> hidden(-name=>'answer_form_submitted', -value=>1), # alerts the problem to show answers. $cgi -> hidden(-name=>'Mode', -value=>$mode), $cgi -> hidden(-name=>'original_show_old_answers', -value=>$show_old_answers); print &sessionKeyInputs(\%inputs), $cgi->br, $cgi -> submit( -name => 'action', -value=>"Preview Again" ),"\n", $cgi -> submit( -name => 'action', -value=>"Paste Answer$s" ),"\n", $cgi -> submit( -name => 'action', -value=>"Submit Answer$s" ),"\n"; print $cgi -> endform(); print &htmlBOTTOM($0, \%inputs, 'previewAnswersHelp.html'); } sub encode_submitted_answers { ## returns an encoded string my $ra_answer_entry_order = shift; my @answer_labels = @$ra_answer_entry_order; my %answer_hash =(); my ($label,$value,$out_string); # This grabs the array labels that aren't recorded in the ANSWER_ENTRY_ORDER if (defined($pt->{PG_FLAGS_REF}->{KEPT_EXTRA_ANSWERS})){ my @extra_labels = @{$pt->{PG_FLAGS_REF}->{KEPT_EXTRA_ANSWERS}}; my $extra_label; foreach $extra_label (@extra_labels){ push @answer_labels, $extra_label; } } ## we will use ## to joint the hash into a string for storage ## so first we protect # in all keys and values foreach $label (@answer_labels) { $value = (defined $inputs{$label}) ? $inputs{$label} : '' ; $value = substr($value,0,$Global::maxSizeRecordedAns) if length($value) > $Global::maxSizeRecordedAns; #warn "label is |$label| \n"; #warn "val is |$value| \n"; $label =~ s/#/\\#\\/g; $value =~ s/#/\\#\\/g; $answer_hash{$label} = $value; } $out_string = join '##', %answer_hash; ## When using flat databases (gdbm, db), we use '&' and '=' to ## separate values so we must replace all such occurences. We will ## replace then by %% and @@. First we escape any of these. # this is now handled by protect_string in DBglue8 as it is specific to the database used # $out_string =~ s/%/\\%\\/g; # $out_string =~ s/@/\\@\\/g; # $out_string =~ s/&/%%/g; # $out_string =~ s/=/@@/g; #warn "outstring is |$out_string| \n"; $out_string; } sub decode_submitted_answers { ## returns a ref to a hash of submitted answers my $in_string = shift; ## reverse encoding process. See comments in encode_submitted_answers # this is now handled by unprotect_string in DBglue8 as it is specific to the database used # $in_string =~ s/@@/=/g; # $in_string =~ s/%%/&/g; # $in_string =~ s/\\@\\/@/g; # $in_string =~ s/\\%\\/%/g; $in_string =~ s/##$/## /; # This makes sure that the last element has a value. # It may cause trouble if this value was supposed to be nil instead of a space. my %saved_answers = split /##/,$in_string; my ($label,$value); my %answer_hash = (); foreach $label (keys (%saved_answers)) { $value = $saved_answers{$label}; $label =~ s/\\#\\/#/g; $value =~ s/\\#\\/#/g; $answer_hash{$label} = $value; } \%answer_hash; } sub defineProblemEnvir { my ($mode,$probNum,$psvn,$courseName) = @_; 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'} = &getStudentLogin($psvn); $envir{'studentID'} = &CL_getStudentID($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{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); $envir{'dueDate'} = &getDueDate($psvn); $envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); $envir{'answerDate'} = &getAnswerDate($psvn); $envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); # DavideCervone's new parameters $envir{'showRemainingTime'} = $Global::showRemainingTime; $envir{'startShowingRemainingTime'} = $Global::startShowingRemainingTime; $envir{'dueDateLeeway'} = $Global::dueDateLeeway; # end DPVC $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{'useBaseTenLog'} = $Global::useBaseTenLog; $envir{'defaultDisplayMatrixStyle'} = $Global::defaultDisplayMatrixStyle; #kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated. $envir{'numOfAttempts'} = &getProblemNumOfCorrectAns($probNum,$psvn) + &getProblemNumOfIncorrectAns($probNum,$psvn)+1; # defining directorys and URLs $envir{'templateDirectory'} = &getCourseTemplateDirectory(); $envir{'classDirectory'} = $Global::classDirectory; $envir{'cgiDirectory'} = $Global::cgiDirectory; $envir{'cgiURL'} = getWebworkCgiURL(); $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{'externalGif2EpsPath'} = $scriptDirectory.'gif2eps'; #compatible with previous standard of storing this script in the scripts directory $envir{'externalPng2EpsPath'} = $scriptDirectory.'png2eps'; $envir{'externalLatexPath'} = $Global::externalLaTeX2HTMLPath; $envir{'inputs_ref'} = \%inputs; $envir{'problemSeed'} = $seed; $envir{'displaySolutionsQ'} = $displaySolutionsQ; $envir{'displayHintsQ'} = $displayHintsQ; # 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; } }; # end eval print "Content-type: text/plain\n\n Error in $Global::processProblem_CGI\n$@" if $@; #### for error checking and debugging purposes sub pretty_print_rh { my $rh = shift; foreach my $key (sort keys %{$rh}) { print " $key => ",$rh->{$key},"\n"; } } # Code for logging students's answers to allow inspection of answer history. sub logCourseData { return unless ($Global::logCourseAnswerData); my $user = shift; my $setNum = shift; my $probNum = shift; my $inputs = shift; my $pt = shift; my @answers = (defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER})) ? @{$pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}} : keys %{$pt->rh_evaluated_answers}; my ($id,$string); # This grabs the array labels that aren't recorded in the ANSWER_ENTRY_ORDER if (defined($pt->{PG_FLAGS_REF}->{KEPT_EXTRA_ANSWERS})){ my @extra_labels = @{$pt->{PG_FLAGS_REF}->{KEPT_EXTRA_ANSWERS}}; my $extra_label; foreach $extra_label (@extra_labels){ push @answers, $extra_label; } } my @ans = ("|$user|$setNum|$probNum|",time()); foreach $id (@answers) { $string = $inputs->{$id}; $string = "" unless defined($string); $string =~ s!\t! !g; # just in case push (@ans,$string); } my $answerLog = getCourseLogsDirectory()."answer_log"; unless (-e $answerLog) { &createFile($answerLog, $Global::log_file_permission, $Global::numericalGroupID); } open(LOG, ">>$answerLog") or warn "Can't open course access log $answerLog"; print LOG join("\t",@ans),"\n"; # data is tab-separated fields close(LOG); } # End code for logging students's answers END { if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) { alarm(0); # turn off the alarm my $problem_message = qq!Content-type: text/html\n\n

WeBWorK heavy useage time out.

\n

Your request for a WeBWorK problem was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.

If this occurs for only this problem, it is likely that there is a programing error in this problem, maybe an infinite loop. Please report this to your instructor.

\n If you get this error on several different problems, it is probably because the WeBWorK server is extraordinarily busy.

\n In this case 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.

\n Use the back button to return to the previous page and try again.

\n If the high useage problem continues you can report this to your instructor using the feedback button.

Script: $Global::processProblem_CGI

!; print $problem_message, "\n"; } # 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 --"; } &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'processProb8.pl '. "(mode: $main::display_mode, action: $main::Action)",$main::Course,$main::User); } # end Timing code }