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

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::ContentGenerator::ProblemSet;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::ContentGenerator::ProblemSet - display an index of the problems in a
   11 problem set.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 use base qw(WeBWorK::ContentGenerator);
   18 use Apache::Constants qw(:common);
   19 use CGI qw();
   20 use WeBWorK::ContentGenerator;
   21 use WeBWorK::ContentGenerator::Problem;
   22 use WeBWorK::DB::WW;
   23 use WeBWorK::DB::Classlist;
   24 
   25 sub initialize {
   26   my $self = shift;
   27   my $courseEnvironment = $self->{courseEnvironment};
   28 
   29   # Open a database connection that we can use for the rest of
   30   # the content generation.
   31 
   32   $self->{wwdb} = WeBWorK::DB::WW->new($courseEnvironment);
   33   $self->{cldb} = WeBWorK::DB::Classlist->new($courseEnvironment);
   34 }
   35 
   36 sub path {
   37   my ($self, $setName, $args) = @_;
   38 
   39   my $ce = $self->{courseEnvironment};
   40   my $root = $ce->{webworkURLs}->{root};
   41   my $courseName = $ce->{courseName};
   42   return $self->pathMacro($args,
   43     "Home" => "$root",
   44     $courseName => "$root/$courseName",
   45     $setName => "",
   46   );
   47 }
   48 
   49 sub siblings {
   50   my ($self, $setName) = @_;
   51 
   52   my $ce = $self->{courseEnvironment};
   53   my $root = $ce->{webworkURLs}->{root};
   54   my $courseName = $ce->{courseName};
   55 
   56   print CGI::strong("Problem Sets"), CGI::br();
   57 
   58   my $wwdb = $self->{wwdb};
   59   my $user = $self->{r}->param("user");
   60   my @sets;
   61   push @sets, $wwdb->getSet($user, $_) foreach ($wwdb->getSets($user));
   62   foreach my $set (sort { $a->open_date <=> $b->open_date } @sets) {
   63     if (time >= $set->open_date) {
   64       print CGI::a({-href=>"$root/$courseName/".$set->id."/?"
   65         . $self->url_authen_args}, $set->id), CGI::br();
   66     } else {
   67       print $set->id, CGI::br();
   68     }
   69   }
   70 }
   71 
   72 sub title {
   73   my ($self, $setName) = @_;
   74 
   75   return $setName;
   76 }
   77 
   78 sub info {
   79   my ($self, $setName) = @_;
   80 
   81   my $r = $self->{r};
   82   my $ce = $self->{courseEnvironment};
   83 
   84   my $wwdb = $self->{wwdb};
   85   my $cldb = $self->{cldb};
   86   my $user = $cldb->getUser($r->param("user"));
   87   my $set  = $wwdb->getSet($user->id, $setName);
   88   my $psvn = $wwdb->getPSVN($user->id, $setName);
   89 
   90   my $screenSetHeader = $set->problem_header || $ce->{webworkFiles}->{screenSnippets}->{setHeader};
   91   my $displayMode     = $ce->{pg}->{options}->{displayMode};
   92 
   93   return "" unless defined $screenSetHeader and $screenSetHeader;
   94 
   95   # decide what to do about problem number
   96   my $problem = WeBWorK::Problem->new(
   97     id => 0,
   98     set_id => $set->id,
   99     login_id => $user->id,
  100     source_file => $screenSetHeader,
  101     # the rest of Problem's fields are not needed, i think
  102   );
  103 
  104   my $pg = WeBWorK::PG->new(
  105     $ce,
  106     $user,
  107     $r->param('key'),
  108     $set,
  109     $problem,
  110     $psvn,
  111     {}, # no form fields!
  112     { # translation options
  113       displayMode     => $displayMode,
  114       showHints       => 0,
  115       showSolutions   => 0,
  116       processAnswers  => 0,
  117     },
  118   );
  119 
  120   # handle translation errors
  121   if ($pg->{flags}->{error_flag}) {
  122     return WeBWorK::ContentGenerator::Problem::translationError(
  123       $pg->{errors}, $pg->{body_text});
  124   } else {
  125     return $pg->{body_text};
  126   }
  127 }
  128 
  129 sub body {
  130   my ($self, $setName) = @_;
  131   my $r = $self->{r};
  132   my $courseEnvironment = $self->{courseEnvironment};
  133   my $user = $r->param('user');
  134   my $wwdb = $self->{wwdb};
  135 
  136   my $hardcopyURL =
  137     $courseEnvironment->{webworkURLs}->{root} . "/"
  138     . $courseEnvironment->{courseName} . "/"
  139     . "hardcopy/$setName/?" . $self->url_authen_args;
  140   print CGI::p(CGI::a({-href=>$hardcopyURL}, "Download a hardcopy"),
  141     "of this problem set.");
  142 
  143   print CGI::start_table();
  144   print CGI::Tr(
  145     CGI::th("Name"),
  146     CGI::th("Attempts"),
  147     CGI::th("Remaining"),
  148     CGI::th("Status"),
  149   );
  150 
  151   my $set = $wwdb->getSet($user, $setName);
  152   my @problemNumbers = $wwdb->getProblems($user, $setName);
  153   foreach my $problemNumber (sort { $a <=> $b } @problemNumbers) {
  154     my $problem = $wwdb->getProblem($user, $setName, $problemNumber);
  155     print $self->problemListRow($set, $problem);
  156   }
  157 
  158   print CGI::end_table();
  159 
  160   # feedback form
  161   my $ce = $self->{courseEnvironment};
  162   my $root = $ce->{webworkURLs}->{root};
  163   my $courseName = $ce->{courseName};
  164   my $feedbackURL = "$root/$courseName/feedback/";
  165   print
  166     CGI::startform("POST", $feedbackURL),
  167     $self->hidden_authen_fields,
  168     CGI::hidden("module", __PACKAGE__),
  169     CGI::hidden("set",    $set->id),
  170     CGI::p({-align=>"right"},
  171       CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
  172     ),
  173     CGI::endform();
  174 
  175   return "";
  176 }
  177 
  178 sub problemListRow($$$) {
  179   my $self = shift;
  180   my $set = shift;
  181   my $problem = shift;
  182 
  183   my $name = $problem->id;
  184   my $interactiveURL = "$name/?" . $self->url_authen_args;
  185   my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name");
  186   my $attempts = $problem->num_correct + $problem->num_incorrect;
  187   my $remaining = $problem->max_attempts < 0
  188     ? "unlimited"
  189     : $problem->max_attempts - $attempts;
  190   my $status = $problem->status * 100 . "%";
  191 
  192   return CGI::Tr(CGI::td({-nowrap=>1}, [
  193     $interactive,
  194     $attempts,
  195     $remaining,
  196     $status,
  197   ]));
  198 }
  199 
  200 1;