[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

View of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 809 - (download) (as text) (annotate)
Thu Apr 17 21:30:57 2003 UTC (10 years, 2 months ago) by sh002i
File size: 23329 byte(s)
changed the name of the "courseEnvironment" field in the
ContentGenerator object to "ce", to match the style and conciesness of
the existing "r" and new "db" fields.
-sam

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::ContentGenerator::Problem;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
   11 
   12 =cut
   13 
   14 use strict;
   15 use warnings;
   16 use base qw(WeBWorK::ContentGenerator);
   17 use CGI qw();
   18 use File::Temp qw(tempdir);
   19 use WeBWorK::Form;
   20 use WeBWorK::PG;
   21 use WeBWorK::PG::IO;
   22 use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
   23 
   24 ############################################################
   25 #
   26 # user
   27 # effectiveUser
   28 # key
   29 #
   30 # displayMode
   31 # showOldAnswers
   32 # showCorrectAnswers
   33 # showHints
   34 # showSolutions
   35 #
   36 # AnSwEr# - answer blanks in problem
   37 #
   38 # redisplay - name of the "Redisplay Problem" button
   39 # submitAnswers - name of "Submit Answers" button
   40 #
   41 ############################################################
   42 
   43 sub pre_header_initialize {
   44   my ($self, $setName, $problemNumber) = @_;
   45   my $courseEnv = $self->{ce};
   46   my $r = $self->{r};
   47   my $userName = $r->param('user');
   48   my $effectiveUserName = $r->param('effectiveUser');
   49 
   50   ##### database setup #####
   51 
   52   my $cldb   = WeBWorK::DB::Classlist->new($courseEnv);
   53   my $wwdb   = WeBWorK::DB::WW->new($courseEnv);
   54   my $authdb = WeBWorK::DB::Auth->new($courseEnv);
   55 
   56   my $user            = $cldb->getUser($userName);
   57   my $effectiveUser   = $cldb->getUser($effectiveUserName);
   58   my $set             = $wwdb->getSet($effectiveUserName, $setName);
   59   my $problem         = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber);
   60   my $psvn            = $wwdb->getPSVN($effectiveUserName, $setName);
   61   my $permissionLevel = $authdb->getPermissions($userName);
   62 
   63   $self->{cldb}            = $cldb;
   64   $self->{wwdb}            = $wwdb;
   65   $self->{authdb}          = $authdb;
   66 
   67   $self->{userName}        = $userName;
   68   $self->{user}            = $user;
   69   $self->{effectiveUser}   = $effectiveUser;
   70   $self->{set}             = $set;
   71   $self->{problem}         = $problem;
   72   $self->{permissionLevel} = $permissionLevel;
   73 
   74   ##### form processing #####
   75 
   76   # set options from form fields (see comment at top of file for names)
   77   my $displayMode        = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
   78   my $redisplay          = $r->param("redisplay");
   79   my $submitAnswers      = $r->param("submitAnswers");
   80   my $checkAnswers       = $r->param("checkAnswers");
   81   my $previewAnswers     = $r->param("previewAnswers");
   82 
   83   # coerce form fields into CGI::Vars format
   84   my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
   85 
   86   $self->{displayMode}    = $displayMode;
   87   $self->{redisplay}      = $redisplay;
   88   $self->{submitAnswers}  = $submitAnswers;
   89   $self->{checkAnswers}   = $checkAnswers;
   90   $self->{previewAnswers} = $previewAnswers;
   91   $self->{formFields}     = $formFields;
   92 
   93   ##### permissions #####
   94 
   95   # are we allowed to view this problem?
   96   $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
   97   return unless $self->{isOpen};
   98 
   99   # what does the user want to do?
  100   my %want = (
  101     showOldAnswers     => $r->param("showOldAnswers")     || $courseEnv->{pg}->{options}->{showOldAnswers},
  102     showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
  103     showHints          => $r->param("showHints")          || $courseEnv->{pg}->{options}->{showHints},
  104     showSolutions      => $r->param("showSolutions")      || $courseEnv->{pg}->{options}->{showSolutions},
  105     recordAnswers      => $submitAnswers,
  106     checkAnswers       => $checkAnswers,
  107   );
  108 
  109   # are certain options enforced?
  110   my %must = (
  111     showOldAnswers     => 0,
  112     showCorrectAnswers => 0,
  113     showHints          => 0,
  114     showSolutions      => 0,
  115     recordAnswers      => mustRecordAnswers($permissionLevel),
  116     checkAnswers       => 0,
  117   );
  118 
  119   # does the user have permission to use certain options?
  120   my %can = (
  121     showOldAnswers     => 1,
  122     showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
  123     showHints          => 1,
  124     showSolutions      => canShowSolutions($permissionLevel, $set->answer_date),
  125     recordAnswers      => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
  126       $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
  127       # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
  128     checkAnswers       => canCheckAnswers($permissionLevel, $set->answer_date),
  129   );
  130 
  131   # final values for options
  132   my %will;
  133   foreach (keys %must) {
  134     $will{$_} = $can{$_} && ($want{$_} || $must{$_});
  135   }
  136 
  137   ##### sticky answers #####
  138 
  139   if (not $submitAnswers and $will{showOldAnswers}) {
  140     # do this only if new answers are NOT being submitted
  141     my %oldAnswers = decodeAnswers($problem->last_answer);
  142     $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
  143   }
  144 
  145   ##### translation #####
  146 
  147   my $pg = WeBWorK::PG->new(
  148     $courseEnv,
  149     $effectiveUser,
  150     $r->param('key'),
  151     $set,
  152     $problem,
  153     $psvn,
  154     $formFields,
  155     { # translation options
  156       displayMode     => $displayMode,
  157       showHints       => $will{showHints},
  158       showSolutions   => $will{showSolutions},
  159       refreshMath2img => $will{showHints} || $will{showSolutions},
  160       processAnswers  => 1,
  161     },
  162   );
  163 
  164   ##### fix hint/solution options #####
  165 
  166   $can{showHints}     &&= $pg->{flags}->{hintExists};
  167   $can{showSolutions} &&= $pg->{flags}->{solutionExists};
  168 
  169   ##### store fields #####
  170 
  171   $self->{want} = \%want;
  172   $self->{must} = \%must;
  173   $self->{can}  = \%can;
  174   $self->{will} = \%will;
  175 
  176   $self->{pg} = $pg;
  177 }
  178 
  179 sub if_warnings($$) {
  180   my ($self, $arg) = @_;
  181   return 0 unless $self->{isOpen};
  182   return $self->{pg}->{warnings} ne "";
  183 }
  184 
  185 sub if_errors($$) {
  186   my ($self, $arg) = @_;
  187   return 0 unless $self->{isOpen};
  188   return $self->{pg}->{flags}->{error_flag};
  189 }
  190 
  191 sub head {
  192   my $self = shift;
  193   return "" unless $self->{isOpen};
  194   return $self->{pg}->{head_text} if $self->{pg}->{head_text};
  195 }
  196 
  197 sub path {
  198   my $self = shift;
  199   my $args = $_[-1];
  200   my $setName = $self->{set}->id;
  201   my $problemNumber = $self->{problem}->id;
  202 
  203   my $ce = $self->{ce};
  204   my $root = $ce->{webworkURLs}->{root};
  205   my $courseName = $ce->{courseName};
  206   return $self->pathMacro($args,
  207     "Home" => "$root",
  208     $courseName => "$root/$courseName",
  209     $setName => "$root/$courseName/$setName",
  210     "Problem $problemNumber" => "",
  211   );
  212 }
  213 
  214 sub siblings {
  215   my $self = shift;
  216   my $setName = $self->{set}->id;
  217   my $problemNumber = $self->{problem}->id;
  218 
  219   my $ce = $self->{ce};
  220   my $root = $ce->{webworkURLs}->{root};
  221   my $courseName = $ce->{courseName};
  222 
  223   print CGI::strong("Problems"), CGI::br();
  224 
  225   my $wwdb = $self->{wwdb};
  226   my $effectiveUser = $self->{r}->param("effectiveUser");
  227   my @problems;
  228   push @problems, $wwdb->getProblem($effectiveUser, $setName, $_)
  229     foreach ($wwdb->getProblems($effectiveUser, $setName));
  230   foreach my $problem (sort { $a->id <=> $b->id } @problems) {
  231     print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"
  232       . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
  233         "Problem ".$problem->id), CGI::br();
  234   }
  235 }
  236 
  237 sub nav {
  238   my $self = shift;
  239   my $args = $_[-1];
  240   my $setName = $self->{set}->id;
  241   my $problemNumber = $self->{problem}->id;
  242 
  243   my $ce = $self->{ce};
  244   my $root = $ce->{webworkURLs}->{root};
  245   my $courseName = $ce->{courseName};
  246 
  247   my $wwdb          = $self->{wwdb};
  248   my $effectiveUser = $self->{r}->param("effectiveUser");
  249   my $tail = "&displayMode=".$self->{displayMode};
  250 
  251   my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList");
  252 
  253   my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1);
  254   my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1);
  255   unshift @links, "Previous Problem" , ($prevProblem
  256     ? "$root/$courseName/$setName/".$prevProblem->id
  257     : "") , "navPrev";
  258   push @links, "Next Problem" , ($nextProblem
  259     ? "$root/$courseName/$setName/".$nextProblem->id
  260     : "") , "navNext";
  261 
  262   return $self->navMacro($args, $tail, @links);
  263 }
  264 
  265 sub title {
  266   my $self = shift;
  267   my $setName = $self->{set}->id;
  268   my $problemNumber = $self->{problem}->id;
  269 
  270   return "$setName : Problem $problemNumber";
  271 }
  272 
  273 sub body {
  274   my $self = shift;
  275 
  276   return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
  277     unless $self->{isOpen};
  278 
  279   # unpack some useful variables
  280   my $r               = $self->{r};
  281   my $wwdb            = $self->{wwdb};
  282   my $set             = $self->{set};
  283   my $problem         = $self->{problem};
  284   my $permissionLevel = $self->{permissionLevel};
  285   my $submitAnswers   = $self->{submitAnswers};
  286   my $checkAnswers    = $self->{checkAnswers};
  287   my $previewAnswers  = $self->{previewAnswers};
  288   my %want            = %{ $self->{want} };
  289   my %can             = %{ $self->{can} };
  290   my %must            = %{ $self->{must} };
  291   my %will            = %{ $self->{will} };
  292   my $pg              = $self->{pg};
  293 
  294   ##### translation errors? #####
  295 
  296   if ($pg->{flags}->{error_flag}) {
  297     return $self->errorOutput($pg->{errors}, $pg->{body_text});
  298   }
  299 
  300   ##### answer processing #####
  301 
  302   # if answers were submitted:
  303   if ($submitAnswers) {
  304     # store answers in DB for sticky answers
  305     my %answersToStore;
  306     my %answerHash = %{ $pg->{answers} };
  307     $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
  308       foreach (keys %answerHash);
  309     my $answerString = encodeAnswers(%answersToStore,
  310       @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
  311     $problem->last_answer($answerString);
  312     $wwdb->setProblem($problem);
  313 
  314     # store state in DB if it makes sense
  315     if ($will{recordAnswers}) {
  316       $problem->attempted(1);
  317       $problem->status($pg->{state}->{recorded_score});
  318       $problem->num_correct($pg->{state}->{num_of_correct_ans});
  319       $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
  320       $wwdb->setProblem($problem);
  321       # write to the transaction log, just to make sure
  322       writeLog($self->{ce}, "transaction",
  323         $problem->id."\t".
  324         $problem->set_id."\t".
  325         $problem->login_id."\t".
  326         $problem->source_file."\t".
  327         $problem->value."\t".
  328         $problem->max_attempts."\t".
  329         $problem->problem_seed."\t".
  330         $problem->status."\t".
  331         $problem->attempted."\t".
  332         $problem->last_answer."\t".
  333         $problem->num_correct."\t".
  334         $problem->num_incorrect
  335       );
  336     }
  337   }
  338   # logging student answers
  339   my $pastAnswerLog = undef;
  340   if (defined( $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'} )) {
  341 
  342     $pastAnswerLog  =   $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'};
  343 
  344     if ($submitAnswers and defined($pastAnswerLog) ) {
  345       my $answerString = "";
  346       my %answerHash = %{ $pg->{answers} };
  347       $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t"
  348         foreach (sort keys  %answerHash);
  349       writeLog($self->{ce}, "pastAnswerList",
  350           '|'.$problem->login_id.
  351           '|'.$problem->set_id.
  352           '|'.$problem->id.'|'."\t".
  353           time()."\t".
  354           $answerString,
  355 
  356         );
  357 
  358     }
  359 
  360    }
  361   # end logging student answers
  362 
  363   ##### output #####
  364   print CGI::start_div({class=>"problemHeader"});
  365   # attempt summary
  366   if ($submitAnswers or $will{showCorrectAnswers}) {
  367     # print this if user submitted answers OR requested correct answers
  368     print $self->attemptResults($pg, $submitAnswers,
  369       $will{showCorrectAnswers},
  370       $pg->{flags}->{showPartialCorrectAnswers}, 1, 0);
  371   } elsif ($checkAnswers) {
  372     # print this if user previewed answers
  373     print $self->attemptResults($pg, 1, 0, 1, 1, 0);
  374       # show attempt answers
  375       # don't show correct answers
  376       # show attempt results (correctness)
  377       # don't show attempt previews
  378   } elsif ($previewAnswers) {
  379     # print this if user previewed answers
  380     print $self->attemptResults($pg, 1, 0, 0, 0, 1);
  381       # show attempt answers
  382       # don't show correct answers
  383       # don't show attempt results (correctness)
  384       # show attempt previews
  385   }
  386 
  387   print CGI::end_div();
  388 
  389   print CGI::start_div({class=>"problem"});
  390   #print CGI::hr();
  391   # main form
  392   print
  393     CGI::startform("POST", $r->uri),
  394     $self->hidden_authen_fields,
  395     CGI::p($pg->{body_text}),
  396     CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
  397     CGI::p(
  398       ($can{recordAnswers}
  399         ? CGI::submit(-name=>"submitAnswers",
  400           -label=>"Submit Answers")
  401         : ""),
  402       ($can{checkAnswers}
  403         ? CGI::submit(-name=>"checkAnswers",
  404           -label=>"Check Answers")
  405         : ""),
  406       CGI::submit(-name=>"previewAnswers",
  407         -label=>"Preview Answers"),
  408     );
  409   print CGI::end_div();
  410 
  411   print CGI::start_div({class=>"scoreSummary"});
  412   # score summary
  413   my $attempts = $problem->num_correct + $problem->num_incorrect;
  414   my $attemptsNoun = $attempts != 1 ? "times" : "time";
  415   my $lastScore = int ($problem->status * 100) . "%";
  416   my ($attemptsLeft, $attemptsLeftNoun);
  417   if ($problem->max_attempts == -1) {
  418     # unlimited attempts
  419     $attemptsLeft = "unlimited";
  420     $attemptsLeftNoun = "attempts";
  421   } else {
  422     $attemptsLeft = $problem->max_attempts - $attempts;
  423     $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
  424   }
  425 
  426   my $setClosed = 0;
  427   my $setClosedMessage;
  428   if (time < $set->open_date or time > $set->due_date) {
  429     $setClosed = 1;
  430     $setClosedMessage = "This problem set is closed.";
  431     if ($permissionLevel > 0) {
  432       $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
  433     } else {
  434       $setClosedMessage .= " Additional attempts will not be recorded.";
  435     }
  436   }
  437   print CGI::p(
  438     "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
  439     $problem->attempted
  440       ? "Your recorded score is $lastScore." . CGI::br()
  441       : "",
  442     $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
  443   );
  444   print CGI::end_div();
  445   print CGI::hr(), CGI::start_div({class=>"viewOptions"});
  446   print
  447     $self->viewOptions(),CGI::end_div(),
  448     CGI::endform();
  449 
  450   print  CGI::start_div({class=>"problemFooter"});
  451   # feedback form
  452   my $ce = $self->{ce};
  453   my $root = $ce->{webworkURLs}->{root};
  454   my $courseName = $ce->{courseName};
  455   my $feedbackURL = "$root/$courseName/feedback/";
  456 
  457   # arguments for answer inspection button
  458   my $prof_url = $ce->{webworkURLs}->{oldProf};
  459   my $cgi_url = $prof_url;
  460   $cgi_url=~ s|/[^/]*$||;  # clip profLogin.pl
  461   my $authen_args = $self->url_authen_args();
  462   my $showPastAnswersURL = "$cgi_url/showPastAnswers.pl";
  463 
  464   #print feedback form
  465   print
  466     CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
  467     $self->hidden_authen_fields,"\n",
  468     CGI::hidden("module",             __PACKAGE__),"\n",
  469     CGI::hidden("set",                $set->id),"\n",
  470     CGI::hidden("problem",            $problem->id),"\n",
  471     CGI::hidden("displayMode",        $self->{displayMode}),"\n",
  472     CGI::hidden("showOldAnswers",     $will{showOldAnswers}),"\n",
  473     CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
  474     CGI::hidden("showHints",          $will{showHints}),"\n",
  475     CGI::hidden("showSolutions",      $will{showSolutions}),"\n",
  476     CGI::p({-align=>"right"},
  477       CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
  478     ),
  479     CGI::endform(),"\n";
  480   # print answer inspection button
  481   if ($self->{permissionLevel} >0)      {
  482 
  483 
  484     print "\n",
  485       CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
  486         $self->hidden_authen_fields,"\n",
  487         CGI::hidden(-name => 'course',  -value=>$courseName), "\n",
  488         CGI::hidden(-name => 'probNum', -value=>$problem->id), "\n",
  489         CGI::hidden(-name => 'setNum',  -value=>$problem->set_id), "\n",
  490         CGI::hidden(-name => 'User',    -value=>$problem->login_id), "\n",
  491         CGI::submit(-name => 'action',  -value=>'Show Past Answers'), "\n",
  492         CGI::endform();
  493 
  494 
  495 
  496   }
  497   print CGI::end_div();
  498   # end answer inspection button
  499   # warning output
  500   if ($pg->{warnings} ne "") {
  501     print CGI::hr(), $self->warningOutput($pg->{warnings});
  502   }
  503 
  504   # debugging stuff
  505   if (0) {
  506     print
  507       CGI::hr(),
  508       CGI::h2("debugging information"),
  509       CGI::h3("form fields"),
  510       ref2string($self->{formFields}),
  511       CGI::h3("user object"),
  512       ref2string($self->{user}),
  513       CGI::h3("set object"),
  514       ref2string($set),
  515       CGI::h3("problem object"),
  516       ref2string($problem),
  517       CGI::h3("PG object"),
  518       ref2string($pg, {'WeBWorK::PG::Translator' => 1});
  519   }
  520 
  521   return "";
  522 }
  523 
  524 ##### output utilities #####
  525 
  526 sub attemptResults($$$$$$) {
  527   my $self = shift;
  528   my $pg = shift;
  529   my $showAttemptAnswers = shift;
  530   my $showCorrectAnswers = shift;
  531   my $showAttemptResults = $showAttemptAnswers && shift;
  532   my $showSummary = shift;
  533   my $showAttemptPreview = shift || 0;
  534   my $problemResult = $pg->{result}; # the overall result of the problem
  535   my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
  536 
  537   my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
  538 
  539   my $header = CGI::th("Part");
  540   $header .= $showAttemptAnswers ? CGI::th("Entered")  : "";
  541   $header .= $showAttemptPreview ? CGI::th("Answer Preview")  : "";
  542   $header .= $showCorrectAnswers ? CGI::th("Correct")  : "";
  543   $header .= $showAttemptResults ? CGI::th("Result")   : "";
  544   $header .= $showMessages       ? CGI::th("messages") : "";
  545   my @tableRows = ( $header );
  546   my $numCorrect;
  547   foreach my $name (@answerNames) {
  548     my $answerResult  = $pg->{answers}->{$name};
  549     my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
  550     my $preview       = ($showAttemptPreview
  551                           ? $self->previewAnswer($answerResult)
  552           : "");
  553     my $correctAnswer = $answerResult->{correct_ans};
  554     my $answerScore   = $answerResult->{score};
  555     my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
  556 
  557     $numCorrect += $answerScore > 0;
  558     my $resultString = $answerScore ? "correct" : "incorrect";
  559 
  560     # get rid of the goofy prefix on the answer names (supposedly, the format
  561     # of the answer names is changeable. this only fixes it for "AnSwEr"
  562     $name =~ s/^AnSwEr//;
  563 
  564     my $row = CGI::td($name);
  565     $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
  566     $row .= $showAttemptPreview ? CGI::td($preview)       : "";
  567     $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
  568     $row .= $showAttemptResults ? CGI::td($resultString)  : "";
  569     $row .= $answerMessage      ? CGI::td($answerMessage) : "";
  570     push @tableRows, $row;
  571   }
  572 
  573   my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
  574   my $scorePercent = int ($problemResult->{score} * 100) . "\%";
  575   my $summary = "On this attempt, you answered $numCorrect out of "
  576     . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
  577   return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
  578 }
  579 
  580 sub viewOptions($) {
  581   my $self = shift;
  582   my $displayMode = $self->{displayMode};
  583   my %must = %{ $self->{must} };
  584   my %can  = %{ $self->{can}  };
  585   my %will = %{ $self->{will} };
  586 
  587   my $optionLine;
  588   $can{showOldAnswers} and $optionLine .= join "",
  589     "Show: &nbsp;",
  590     CGI::checkbox(
  591       -name    => "showOldAnswers",
  592       -checked => $will{showOldAnswers},
  593       -label   => "Saved answers",
  594     ), "&nbsp;&nbsp;";
  595   $can{showCorrectAnswers} and $optionLine .= join "",
  596     CGI::checkbox(
  597       -name    => "showCorrectAnswers",
  598       -checked => $will{showCorrectAnswers},
  599       -label   => "Correct answers",
  600     ), "&nbsp;&nbsp;";
  601   $can{showHints} and $optionLine .= join "",
  602     CGI::checkbox(
  603       -name    => "showHints",
  604       -checked => $will{showHints},
  605       -label   => "Hints",
  606     ), "&nbsp;&nbsp;";
  607   $can{showSolutions} and $optionLine .= join "",
  608     CGI::checkbox(
  609       -name    => "showSolutions",
  610       -checked => $will{showSolutions},
  611       -label   => "Solutions",
  612     ), "&nbsp;&nbsp;";
  613   $optionLine and $optionLine .= join "", CGI::br();
  614 
  615   return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
  616       "View equations as: &nbsp;",
  617     CGI::radio_group(
  618       -name    => "displayMode",
  619       -values  => ['plainText', 'formattedText', 'images'],
  620       -default => $displayMode,
  621       -labels  => {
  622         plainText     => "plain text",
  623         formattedText => "formatted text",
  624         images        => "images",
  625       }
  626     ), CGI::br(),
  627     $optionLine,
  628     CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
  629   );
  630 }
  631 
  632 sub previewAnswer($$) {
  633   my ($self, $answerResult) = @_;
  634   my $ce            = $self->{ce};
  635   my $effectiveUser = $self->{effectiveUser};
  636   my $set           = $self->{set};
  637   my $problem       = $self->{problem};
  638   my $displayMode   = $self->{displayMode};
  639 
  640   # note: right now, we have to do things completely differently when we are
  641   # rendering math from INSIDE the translator and from OUTSIDE the translator.
  642   # so we'll just deal with each case explicitly here. there's some code
  643   # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
  644 
  645   my $tex = $answerResult->{preview_latex_string};
  646 
  647   return "" unless $tex;
  648 
  649   if ($displayMode eq "plainText") {
  650     return $tex;
  651   } elsif ($displayMode eq "formattedText") {
  652     my $tthCommand = $ce->{externalPrograms}->{tth}
  653       . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
  654       . "\\(".$tex."\\)\n"
  655       . "END_OF_INPUT\n";
  656 
  657     # call tth
  658     my $result = `$tthCommand`;
  659     if ($?) {
  660       return "<b>[tth failed: $? $@]</b>";
  661     }
  662     return $result;
  663   } elsif ($displayMode eq "images") {
  664     # how are we going to name this?
  665     my $targetPathCommon = "/png/"
  666       . $effectiveUser->id . "."
  667       . $set->id . "."
  668       . $problem->id . "."
  669       . $answerResult->{ans_name} . ".png";
  670 
  671     # figure out where to put things
  672     my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
  673     my $latex = $ce->{externalPrograms}->{latex};
  674     my $dvipng = $ce->{externalPrograms}->{dvipng};
  675     my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
  676         # should use surePathToTmpFile, but we have to
  677         # isolate it from the problem enivronment first
  678     my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
  679 
  680     # call dvipng to generate a preview
  681     warn $tex;
  682     dvipng($wd, $latex, $dvipng, $tex, $targetPath);
  683     if (-e $targetPath) {
  684       return "<img src=\"$targetURL\" alt=\"$tex\" />";
  685     } else {
  686       return "<b>[math2img failed]</b>";
  687     }
  688   }
  689 }
  690 ##### logging subroutine ####
  691 
  692 
  693 
  694 ##### permission queries #####
  695 
  696 # this stuff should be abstracted out into the permissions system
  697 # however, the permission system only knows about things in the
  698 # course environment and the username. hmmm...
  699 
  700 # also, i should fix these so that they have a consistent calling
  701 # format -- perhaps:
  702 #   canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
  703 
  704 sub canShowCorrectAnswers($$) {
  705   my ($permissionLevel, $answerDate) = @_;
  706   return $permissionLevel > 0 || time > $answerDate;
  707 }
  708 
  709 sub canShowSolutions($$) {
  710   my ($permissionLevel, $answerDate) = @_;
  711   return canShowCorrectAnswers($permissionLevel, $answerDate);
  712 }
  713 
  714 sub canRecordAnswers($$$$$) {
  715   my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
  716   my $permHigh = $permissionLevel > 0;
  717   my $timeOK = time >= $openDate && time <= $dueDate;
  718   my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
  719   my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
  720   return $recordAnswers;
  721 }
  722 
  723 sub canCheckAnswers($$) {
  724   my ($permissionLevel, $answerDate) = @_;
  725   my $permHigh = $permissionLevel > 0;
  726   my $timeOK = time >= $answerDate;
  727   my $recordAnswers = $permHigh || $timeOK;
  728   return $recordAnswers;
  729 }
  730 
  731 sub mustRecordAnswers($) {
  732   my ($permissionLevel) = @_;
  733   return $permissionLevel == 0;
  734 }
  735 
  736 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9