[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / GatewayQuiz.pm Repository:
ViewVC logotype

View of /trunk/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1129 - (download) (as text) (annotate)
Wed Jun 11 19:30:51 2003 UTC (14 years, 6 months ago) by gage
File size: 12723 byte(s)
This presents an entire set as a quiz.  to be done:
(1) The answer presentation has to be filled in.
(2) Changes to PG.pl and the environment variables have to be made so that different
answers don't collide. The idea is to prefix all answers with something indicating the
problem number e.g.  pRoBlEm04-AnSwEr05  I think it better to pass in an explicit
variable rather than rely on problem numbers.
(3) should this work automatically for NAMED_ANS as well?  Pro: --it's done for you.
  Con: You can't refer to answers in other parts of the quiz. (Put perhaps you
shouldn't to promote atomic behavior.)
--Mike

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::ContentGenerator::GatewayQuiz;
    7 use base qw(WeBWorK::ContentGenerator);
    8 
    9 =head1 NAME
   10 
   11 WeBWorK::ContentGenerator::GatewayQuiz - display an index of the problems in a
   12 problem set. (modifying this from ProblemSet.pm)
   13 
   14 =cut
   15 
   16 use strict;
   17 use warnings;
   18 use CGI qw();
   19 
   20 sub initialize {
   21   my ($self, $setName) = @_;
   22   my $courseEnvironment = $self->{ce};
   23   my $r = $self->{r};
   24   my $db = $self->{db};
   25   my $userName = $r->param("user");
   26   my $effectiveUserName = $r->param("effectiveUser");
   27 
   28   my $user            = $db->getUser($userName);
   29   my $effectiveUser   = $db->getUser($effectiveUserName);
   30   my $set             = $db->getMergedSet($effectiveUserName, $setName);
   31   my $permissionLevel = $db->getPermissionLevel($userName)->permission();
   32 
   33   $self->{userName}        = $userName;
   34   $self->{user}            = $user;
   35   $self->{effectiveUser}   = $effectiveUser;
   36   $self->{set}             = $set;
   37   $self->{permissionLevel} = $permissionLevel;
   38 
   39   ##### permissions #####
   40 
   41   $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
   42 }
   43 
   44 sub path {
   45   my ($self, $setName, $args) = @_;
   46 
   47   my $ce = $self->{ce};
   48   my $root = $ce->{webworkURLs}->{root};
   49   my $courseName = $ce->{courseName};
   50   return $self->pathMacro($args,
   51     "Home" => "$root",
   52     $courseName => "$root/$courseName",
   53     $setName => "",
   54   );
   55 }
   56 
   57 sub nav {
   58   my ($self, $setName, $args) = @_;
   59 
   60   my $ce = $self->{ce};
   61   my $root = $ce->{webworkURLs}->{root};
   62   my $courseName = $ce->{courseName};
   63   my @links = ("Problem Sets" , "$root/$courseName", "navUp");
   64   my $tail = "";
   65 
   66   return $self->navMacro($args, $tail, @links);
   67 }
   68 
   69 
   70 sub siblings {
   71   my ($self, $setName) = @_;
   72 
   73 #   my $ce = $self->{ce};
   74 #   my $db = $self->{db};
   75 #   my $root = $ce->{webworkURLs}->{root};
   76 #   my $courseName = $ce->{courseName};
   77 #
   78 #   print CGI::strong("Problem Sets"), CGI::br();
   79 #
   80 #   my $effectiveUser = $self->{r}->param("effectiveUser");
   81 #   my @sets;
   82 #   push @sets, $db->getMergedSet($effectiveUser, $_)
   83 #     foreach ($db->listUserSets($effectiveUser));
   84 # # foreach my $set (sort { $a->open_date <=> $b->open_date } @sets) {
   85 # #   FIXME only experience will tell us the best sorting procedure
   86 # #   due_date seems right for students, but alphabetically is more useful for professors?;
   87 #
   88 #   # sort by set name
   89 #   #@sets = sort { $a->set_id cmp $b->set_id } @sets;
   90 #
   91 #   # sort by set due date
   92 #   my @sorted_sets = sort { $a->due_date <=> $b->due_date } @sets;
   93 #   # put closed sets last;
   94 #   my $now = time();
   95 #   my @open_sets = grep {$_->due_date>$now} @sets;
   96 #   my @closed_sets = grep {$_->due_date<=$now} @sets;
   97 #   @sorted_sets = (@open_sets,@closed_sets);
   98 #
   99 #   foreach my $set (@sorted_sets) {
  100 # #     print STDERR "set ".$set->set_id." due date ",$set->due_date,"\n";
  101 #     if (time >= $set->open_date) {
  102 #       print CGI::a({-href=>"$root/$courseName/".$set->set_id."/?"
  103 #         . $self->url_authen_args}, $set->set_id), CGI::br();
  104 #     } else {
  105 #       print $set->set_id, CGI::br();
  106 #     }
  107 #   }
  108   return "";
  109 }
  110 
  111 sub title {
  112   my ($self, $setName) = @_;
  113 
  114   return $setName;
  115 }
  116 
  117 # sub info {
  118 #   my ($self, $setName) = @_;
  119 #
  120 #   my $r = $self->{r};
  121 #   my $ce = $self->{ce};
  122 #   my $db = $self->{db};
  123 #
  124 #   return "" unless $self->{isOpen};
  125 #
  126 #   my $effectiveUser = $db->getUser($r->param("effectiveUser"));
  127 #   my $set  = $db->getMergedSet($effectiveUser->user_id, $setName);
  128 #   my $psvn = $set->psvn();
  129 #
  130 #   my $screenSetHeader = $set->problem_header || $ce->{webworkFiles}->{screenSnippets}->{setHeader};
  131 #   my $displayMode     = $ce->{pg}->{options}->{displayMode};
  132 #
  133 #   return "" unless defined $screenSetHeader and $screenSetHeader;
  134 #
  135 #   # decide what to do about problem number
  136 #   my $problem = WeBWorK::DB::Record::UserProblem->new(
  137 #     problem_id => 0,
  138 #     set_id => $set->set_id,
  139 #     login_id => $effectiveUser->user_id,
  140 #     source_file => $screenSetHeader,
  141 #     # the rest of Problem's fields are not needed, i think
  142 #   );
  143 #
  144 #   my $pg = WeBWorK::PG->new(
  145 #     $ce,
  146 #     $effectiveUser,
  147 #     $r->param('key'),
  148 #     $set,
  149 #     $problem,
  150 #     $psvn,
  151 #     {}, # no form fields!
  152 #     { # translation options
  153 #       displayMode     => $displayMode,
  154 #       showHints       => 0,
  155 #       showSolutions   => 0,
  156 #       processAnswers  => 0,
  157 #     },
  158 #   );
  159 #
  160 #   # handle translation errors
  161 #   if ($pg->{flags}->{error_flag}) {
  162 #     return $self->errorOutput($pg->{errors}, $pg->{body_text});
  163 #   } else {
  164 #     return $pg->{body_text};
  165 #   }
  166 # }
  167 
  168 sub body {
  169   my ($self, $setName) = @_;
  170   my $r = $self->{r};
  171   my $courseEnvironment = $self->{ce};
  172   my $db = $self->{db};
  173   my $effectiveUserName = $r->param('effectiveUser');
  174 
  175   return CGI::p(CGI::font({-color=>"red"}, "This problem set is not available because it is not yet open."))
  176     unless ($self->{isOpen});
  177 
  178   my $hardcopyURL =
  179     $courseEnvironment->{webworkURLs}->{root} . "/"
  180     . $courseEnvironment->{courseName} . "/"
  181     . "hardcopy/$setName/?" . $self->url_authen_args;
  182   print CGI::h3("This is an experimental gateway quiz format");
  183 
  184 #   print CGI::start_table();
  185 #   print CGI::Tr(
  186 #     CGI::th("Name"),
  187 #     CGI::th("Attempts"),
  188 #     CGI::th("Remaining"),
  189 #     CGI::th("Status"),
  190 #   );
  191   # main form
  192   print
  193     CGI::startform("POST", $r->uri),
  194     $self->hidden_authen_fields;
  195 
  196   my $set = $db->getMergedSet($effectiveUserName, $setName);
  197   my @problemNumbers = $db->listUserProblems($effectiveUserName, $setName);
  198 #   foreach my $problemNumber (sort { $a <=> $b } @problemNumbers) {
  199 #     my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber);
  200 #     print $self->problemListRow($set, $problem);
  201 #   }
  202   foreach my $problemNumber (sort {$a<=> $b } @problemNumbers) {
  203     my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber);
  204     print CGI::p("Problem $problemNumber");
  205     print CGI::p( $self->getProblemHTML($self->{effectiveUser}, $setName, $problemNumber) );
  206     print "\n\n", CGI::hr(),"\n\n";
  207 
  208 
  209 
  210   }
  211   print CGI::p( #FIXME
  212       #($can{recordAnswers}
  213         (1? CGI::submit(-name=>"submitAnswers",
  214           -label=>"Submit Quiz")
  215         : ""),
  216       #($can{checkAnswers}
  217         (1? CGI::submit(-name=>"checkAnswers",
  218           -label=>"Check Answers")
  219         : ""),
  220       CGI::submit(-name=>"previewAnswers",
  221         -label=>"Preview Answers"),
  222     );
  223 # print CGI::end_table();
  224 
  225   # feedback form
  226   my $ce = $self->{ce};
  227   my $root = $ce->{webworkURLs}->{root};
  228   my $courseName = $ce->{courseName};
  229   my $feedbackURL = "$root/$courseName/feedback/";
  230   print
  231     CGI::startform("POST", $feedbackURL),
  232     $self->hidden_authen_fields,
  233     CGI::hidden("module", __PACKAGE__),
  234     CGI::hidden("set",    $set->set_id),
  235     CGI::p({-align=>"right"},
  236       CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
  237     ),
  238     CGI::endform();
  239 
  240   return "";
  241 }
  242 
  243 sub problemListRow($$$) {
  244   my $self = shift;
  245   my $set = shift;
  246   my $problem = shift;
  247 
  248   my $name = $problem->problem_id;
  249   my $interactiveURL = "$name/?" . $self->url_authen_args;
  250   my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name");
  251   my $attempts = $problem->num_correct + $problem->num_incorrect;
  252   my $remaining = $problem->max_attempts < 0
  253     ? "unlimited"
  254     : $problem->max_attempts - $attempts;
  255   my $status = sprintf("%.0f%%", $problem->status * 100); # round to whole number
  256 
  257   return CGI::Tr(CGI::td({-nowrap=>1}, [
  258     $interactive,
  259     $attempts,
  260     $remaining,
  261     $status,
  262   ]));
  263 }
  264 ###########################################################################
  265 # Evaluation utilties
  266 ############################################################################
  267 sub getProblemHTML {
  268   my ($self, $effectiveUser, $setName, $problemNumber, $pgFile) = @_;
  269   my $r = $self->{r};
  270   my $ce = $self->{ce};
  271   my $db = $self->{db};
  272 
  273   # Should we provide a default user ? I think not FIXME
  274 
  275   # $effectiveUser = $self->{effectiveUser} unless defined($effectiveUser);
  276   my $permissionLevel = $self->{permissionLevel};
  277   my $set  = $db->getMergedSet($effectiveUser->user_id, $setName);
  278   my $psvn = $set->psvn();
  279 
  280   # decide what to do about problem number
  281   my $problem;
  282   if ($problemNumber) {
  283     $problem = $db->getMergedProblem($effectiveUser->user_id, $setName, $problemNumber);
  284   } elsif ($pgFile) {
  285     $problem = WeBWorK::DB::Record::UserProblem->new(
  286       set_id => $set->set_id,
  287       problem_id => 0,
  288       login_id => $effectiveUser->user_id,
  289       source_file => $pgFile,
  290       # the rest of Problem's fields are not needed, i think
  291     );
  292   }
  293 
  294   # figure out if we're allowed to get solutions and call PG->new accordingly.
  295   my $showCorrectAnswers = $r->param("showCorrectAnswers") || 0;
  296   my $showHints          = $r->param("showHints") || 0;
  297   my $showSolutions      = $r->param("showSolutions") || 0;
  298   unless ($permissionLevel > 0 or time > $set->answer_date) {
  299     $showCorrectAnswers = 0;
  300     $showSolutions      = 0;
  301   }
  302 
  303   my $pg = WeBWorK::PG->new(
  304     $ce,
  305     $effectiveUser,
  306     $r->param('key'),
  307     $set,
  308     $problem,
  309     $psvn,
  310     {}, # no form fields! FIXME add form fields
  311     { # translation options
  312       displayMode     => "images",
  313       showHints       => $showHints,
  314       showSolutions   => $showSolutions,
  315       processAnswers  => $showCorrectAnswers,
  316     },
  317   );
  318 
  319   if ($pg->{warnings} ne "") {
  320     push @{$self->{warnings}}, {
  321       set     => $setName,
  322       problem => $problemNumber,
  323       message => $pg->{warnings},
  324     };
  325   }
  326 
  327   if ($pg->{flags}->{error_flag}) {
  328     push @{$self->{errors}}, {
  329       set     => $setName,
  330       problem => $problemNumber,
  331       message => $pg->{errors},
  332       context => $pg->{body_text},
  333     };
  334     # if there was an error, body_text contains
  335     # the error context, not TeX code
  336     $pg->{body_text} = undef;
  337   } else {
  338     # append list of correct answers to body text
  339     if ($showCorrectAnswers && $problemNumber != 0) {
  340       my $correctTeX = "Correct Answers:\\par\\begin{itemize}\n";
  341       foreach my $ansName (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}) {
  342         my $correctAnswer = $pg->{answers}->{$ansName}->{correct_ans};
  343         $correctAnswer =~ s/\^/\\\^\{\}/g;
  344         $correctAnswer =~ s/\_/\\\_/g;
  345         $correctTeX .= "\\item $correctAnswer\n";
  346       }
  347       $correctTeX .= "\\end{itemize} \\par\n";
  348       $pg->{body_text} .= $correctTeX;
  349     }
  350   }
  351   #return '<br>hi FIXME'."effective User $effectiveUser, setName $setName, probNum $problemNumber, file: $pgFile".
  352   return    $pg->{body_text};
  353 }
  354 
  355 ##### output utilities #####
  356 
  357 sub attemptResults($$$$$$) {
  358   my $self = shift;
  359   my $pg = shift;
  360   my $showAttemptAnswers = shift;
  361   my $showCorrectAnswers = shift;
  362   my $showAttemptResults = $showAttemptAnswers && shift;
  363   my $showSummary = shift;
  364   my $showAttemptPreview = shift || 0;
  365   my $problemResult = $pg->{result}; # the overall result of the problem
  366   my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
  367 
  368   my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
  369 
  370   my $header = CGI::th("Part");
  371   $header .= $showAttemptAnswers ? CGI::th("Entered")  : "";
  372   $header .= $showAttemptPreview ? CGI::th("Answer Preview")  : "";
  373   $header .= $showCorrectAnswers ? CGI::th("Correct")  : "";
  374   $header .= $showAttemptResults ? CGI::th("Result")   : "";
  375   $header .= $showMessages       ? CGI::th("messages") : "";
  376   my @tableRows = ( $header );
  377   my $numCorrect;
  378   foreach my $name (@answerNames) {
  379     my $answerResult  = $pg->{answers}->{$name};
  380     my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
  381     my $preview       = ($showAttemptPreview
  382                           ? $self->previewAnswer($answerResult)
  383           : "");
  384     my $correctAnswer = $answerResult->{correct_ans};
  385     my $answerScore   = $answerResult->{score};
  386     my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
  387 
  388     $numCorrect += $answerScore > 0;
  389     my $resultString = $answerScore ? "correct" : "incorrect";
  390 
  391     # get rid of the goofy prefix on the answer names (supposedly, the format
  392     # of the answer names is changeable. this only fixes it for "AnSwEr"
  393     $name =~ s/^AnSwEr//;
  394 
  395     my $row = CGI::td($name);
  396     $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : "";
  397     $row .= $showAttemptPreview ? CGI::td(nbsp($preview))       : "";
  398     $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : "";
  399     $row .= $showAttemptResults ? CGI::td(nbsp($resultString))  : "";
  400     $row .= $answerMessage      ? CGI::td(nbsp($answerMessage)) : "";
  401     push @tableRows, $row;
  402   }
  403 
  404   my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
  405   my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
  406   my $summary = "On this attempt, you answered $numCorrect out of "
  407     . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
  408   return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
  409 }
  410 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9