[system] / branches / rel-2-2-dev / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

View of /branches/rel-2-2-dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9