--- trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm 2002/07/12 22:28:26 429 +++ trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm 2002/07/18 20:12:02 431 @@ -31,11 +31,11 @@ # TODO: # :) enforce permissions for showCorrectAnswers and showSolutions # (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!) -# 2. if answers were not submitted and there are student answers in the DB, +# :) if answers were not submitted and there are student answers in the DB, # decode them and put them into $formFields for the translator # 3. Latex2HTML massaging code -# 4. store submitted answers hash in database for sticky answers -# 5. deal with the results of answer evaluation and grading :p +# :) store submitted answers hash in database for sticky answers +# :) deal with the results of answer evaluation and grading :p # :) introduce a recordAnswers option, which works on the same principle as # the other permission-based options # 7. make warnings work @@ -51,6 +51,7 @@ $problemNumber =~ s/^prob//; ##### database setup ##### + # this should probably go in initialize() or whatever it's called my $classlist = WeBWorK::DB::Classlist->new($courseEnv); my $wwdb = WeBWorK::DB::WW->new($courseEnv); @@ -59,7 +60,6 @@ my $user = $classlist->getUser($userName); my $set = $wwdb->getSet($userName, $setName); my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); - my $psvn = $wwdb->getPSVN($userName, $setName); my $permissionLevel = $authdb->getPermissions($userName); ##### form processing ##### @@ -69,44 +69,49 @@ my $redisplay = $r->param("redisplay"); my $submitAnswers = $r->param("submitAnswers"); - my $wantShowOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}; - my $wantShowCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}; - my $wantShowHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}; - my $wantShowSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}; - my $wantRecordAnswers = $r->param("recordAnswers") || 1; + my %want = ( + showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, + showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, + showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, + showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, + recordAnswers => $r->param("recordAnswers") || 1, + ); # coerce form fields into CGI::Vars format my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; ##### permissions ##### - # does the user have permission to use certain options? - my $canShowOldAnswers = 1; - my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date); - my $canShowHints = 1; - my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date); - my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date); - # are certain options enforced? - my $mustShowOldAnswers = 0; - my $mustShowCorrectAnswers = 0; - my $mustShowHints = 0; - my $mustShowSolutions = 0; - my $mustRecordAnswers = mustRecordAnswers($permissionLevel); + my %must = ( + showOldAnswers => 0, + showCorrectAnswers => 0, + showHints => 0, + showSolutions => 0, + recordAnswers => mustRecordAnswers($permissionLevel), + ); + + # does the user have permission to use certain options? + my %can = ( + showOldAnswers => 1, + showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), + showHints => 1, + showSolutions => canShowSolutions($permissionLevel, $set->answer_date), + recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, + $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), + # num_correct+num_incorrect+1 -- as this happens before updating $problem + ); # final values for options - my $showOldAnswers = $mustShowOldAnswers || ($canShowOldAnswers && $wantShowOldAnswers ); - my $showCorrectAnswers = $mustShowCorrectAnswers || ($canShowCorrectAnswers && $wantShowCorrectAnswers); - my $showHints = $mustShowHints || ($canShowHints && $wantShowHints ); - my $showSolutions = $mustShowSolutions || ($canShowSolutions && $wantShowSolutions ); - my $recordAnswers = $mustRecordAnswers || ($canRecordAnswers && $wantRecordAnswers ); + my %will; + foreach(keys %must) { + $will{$_} = $can{$_} && ($want{$_} || $must{$_}); + } ##### sticky answers ##### - # [TODO #2] - - if (not $submitAnswers and $showOldAnswers) { - # only do this if new answers are NOT being submitted + if (not $submitAnswers and $will{showOldAnswers}) { + # do this only if new answers are NOT being submitted my %oldAnswers = decodeAnswers($problem->last_answer); $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; } @@ -121,9 +126,9 @@ $problemNumber, { # translation options displayMode => $displayMode, - showHints => $showHints, - showSolutions => $showSolutions, - # try leaving processAnswers on all the time: + showHints => $will{showHints}, + showSolutions => $will{showSolutions}, + # try leaving processAnswers on all the time? processAnswers => 1, #$submitAnswers ? 1 : 0, }, $formFields @@ -145,7 +150,7 @@ # if answers were submitted: if ($submitAnswers) { - # store answers in DB for sticky answers [TODO #4] + # store answers in DB for sticky answers my %answersToStore; my %answerHash = %{ $pg->{answers} }; $answersToStore{$_} = $answerHash{$_}->{original_student_ans} @@ -155,32 +160,70 @@ $problem->last_answer($answerString); $wwdb->setProblem($problem); - # store score in DB if it makes sense [TODO #5] - - # print the answer summary table - print - h3("Results of your latest attempt"), - attemptResults($pg, $showCorrectAnswers, - $pg->{flags}->{showPartialCorrectAnswers}), - hr(); + # store score in DB if it makes sense + if ($will{recordAnswers}) { + # the grader makes a lot of decisions for us... + # all we have to do is update information from + # the 'state' hash in the $pg hash. + $problem->attempted(1); + $problem->status($pg->{state}->{recorded_score}); + $problem->num_correct($pg->{state}->{num_of_correct_ans}); + $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); + #warn "Would have stored the following:\n", + # $problem->toString, "\n"; + $wwdb->setProblem($problem); + } else { + print p("Your score was not recorded for some reason. ;)"); + } } ##### output ##### - # view options - # what i'd really like to do here is: - # - preserve the answers currently in the form fields - # - display the answer summary box - # - NOT record answers UNDER ANY CIRCUMSTANCES! + # attempt summary + if ($submitAnswers or $will{showCorrectAnswers}) { + # print this if user submitted answers OR requested correct answers + print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, + $pg->{flags}->{showPartialCorrectAnswers}); + } + + # score summary + my $attempts = $problem->num_correct + $problem->num_incorrect; + my $attemptsNoun = $attempts != 1 ? "times" : "time"; + my $lastScore = int ($problem->status * 100) . "%"; + my ($attemptsLeft, $attemptsLeftNoun); + if ($problem->max_attempts == -1) { + # unlimited attempts + $attemptsLeft = "unlimited"; + $attemptsLeftNoun = "attempts"; + } else { + $attemptsLeft = $problem->max_attempts - $attempts; + $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; + } + print p( + "You have attempted this problem $attempts $attemptsNoun.", br(), + $problem->attempted + ? "Your recorded score is $lastScore." . br() + : "", + "You have $attemptsLeft $attemptsLeftNoun remaining." + ); + + # BY THE WAY.......... + # we have to figure out some way to tell the student if their NEW answer, + # on THIS attempt, has been recorded. however, this is decided in part by + # the grader, so is there any way for us to know? we can rule out several + # cases where the answer is NOT being recorded, because of things decided + # in &canRecordAnswers... + + print hr(); # main form print startform("POST", $r->uri), $self->hidden_authen_fields, + p(i($pg->{result}->{msg})), p($pg->{body_text}), p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), - viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers, - $showHints, $showSolutions), + viewOptions($displayMode, \%must, \%can, \%will), endform(), hr(); @@ -201,7 +244,7 @@ return ""; } -# ----- +##### output utilities ##### sub translationError($$) { my ($error, $details) = @_; @@ -218,15 +261,17 @@ sub attemptResults($$$) { my $pg = shift; + my $showAttemptAnswers = shift; my $showCorrectAnswers = shift; - my $showAttemptResults = shift; + my $showAttemptResults = $showAttemptAnswers && shift; my $problemResult = $pg->{result}; # the overall result of the problem my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; - my $header = th("answer") . th("attempt"); - $header .= $showCorrectAnswers ? th("correct") : ""; - $header .= $showAttemptResults ? th("result") : ""; - $header .= th("messages"); + my $header = th("answer"); + $header .= $showAttemptAnswers ? th("attempt") : ""; + $header .= $showCorrectAnswers ? th("correct") : ""; + $header .= $showAttemptResults ? th("result") : ""; + $header .= $showAttemptAnswers ? th("messages") : ""; my @tableRows = ( $header ); my $numCorrect; foreach my $name (@answerNames) { @@ -234,71 +279,89 @@ my $studentAnswer = $answerResult->{student_ans}; # original_student_ans my $correctAnswer = $answerResult->{correct_ans}; my $answerScore = $answerResult->{score}; - my $answerMessage = $answerResult->{ans_message}; + my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; $numCorrect += $answerScore > 0; my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; - my $row = td($name) . td($studentAnswer); + my $row = td($name); + $row .= $showAttemptAnswers ? td($studentAnswer) : ""; $row .= $showCorrectAnswers ? td($correctAnswer) : ""; $row .= $showAttemptResults ? td($resultString) : ""; $row .= $answerMessage ? td($answerMessage) : ""; push @tableRows, $row; } + my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; my $scorePercent = int ($problemResult->{score} * 100) . "\%"; - my $message = i($problemResult->{msg}); - my $summary = "You answered $numCorrect questions out of " + #my $message = i($problemResult->{msg}); + my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " . scalar @answerNames . " correct, for a score of $scorePercent."; - return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); + #return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); + return table({-border=>1}, Tr(\@tableRows)) . p($summary); } -sub viewOptions($$$$$) { - my ($displayMode, $showOldAnswers, $showCorrectAnswers, - $showHints, $showSolutions) = @_; - return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, - "View equations as:  ", - radio_group( - -name => "displayMode", - -values => ['plainText', 'formattedText', 'images'], - -default => $displayMode, - -labels => { - plainText => "plain text", - formattedText => "formatted text", - images => "images", - } - ), br(), +sub viewOptions($\%\%\%) { + my $displayMode = shift; + my %must = %{ shift() }; + my %can = %{ shift() }; + my %will = %{ shift() }; + + my $optionLine; + $can{showOldAnswers} and $optionLine .= join "", "Show:  ", checkbox( -name => "showOldAnswers", - -checked => $showOldAnswers, - -label => "Old answers", - ), "  ", + -checked => $will{showOldAnswers}, + -label => "Saved answers", + ), "  "; + $can{showCorrectAnswers} and $optionLine .= join "", checkbox( -name => "showCorrectAnswers", - -checked => $showCorrectAnswers, + -checked => $will{showCorrectAnswers}, -label => "Correct answers", - ), "  ", + ), "  "; + $can{showHints} and $optionLine .= join "", checkbox( -name => "showHints", - -checked => $showHints, + -checked => $will{showHints}, -label => "Hints", - ), "  ", + ), "  "; + $can{showSolutions} and $optionLine .= join "", checkbox( -name => "showSolutions", - -checked => $showSolutions, + -checked => $will{showSolutions}, -label => "Solutions", + ), "  "; + $optionLine and $optionLine .= join "", br(); + + return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, + "View equations as:  ", + radio_group( + -name => "displayMode", + -values => ['plainText', 'formattedText', 'images'], + -default => $displayMode, + -labels => { + plainText => "plain text", + formattedText => "formatted text", + images => "images", + } ), br(), + $optionLine, submit(-name=>"redisplay", -label=>"Redisplay Problem"), ); } -# ----- +##### permission queries ##### # this stuff should be abstracted out into the permissions system # however, the permission system only knows about things in the # course environment and the username. hmmm... +# also, i should fix these so that they have a consistent calling +# format -- perhaps: +# canPERM($courseEnv, $user, $set, $problem, $permissionLevel) + sub canShowCorrectAnswers($$) { my ($permissionLevel, $answerDate) = @_; return $permissionLevel > 0 || time > $answerDate; @@ -309,9 +372,12 @@ return canShowCorrectAnswers($permissionLevel, $answerDate); } -sub canRecordAnswers($$$) { - my ($permissionLevel, $openDate, $dueDate) = @_; - return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate); +sub canRecordAnswers($$$$$) { + my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; + my $permHigh = $permissionLevel > 0; + my $timeOK = time >= $openDate && time <= $dueDate; + my $attemptsOK = $attempts <= $maxAttempts; + return $permHigh || ($timeOK && $attemptsOK); } sub mustRecordAnswers($) {