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

    1 package WeBWorK::ContentGenerator::Instructor::ProblemSetList;
    2 use base qw(WeBWorK::ContentGenerator::Instructor);
    3 
    4 =head1 NAME
    5 
    6 WeBWorK::ContentGenerator::Instructor::ProblemSetList - Entry point for Problem and Set editing
    7 
    8 =cut
    9 
   10 use strict;
   11 use warnings;
   12 use CGI qw();
   13 use WeBWorK::Utils qw(formatDateTime);
   14 
   15 sub title {
   16   my $self = shift;
   17   return "Instructor Tools - Problem Set List for ".$self->{ce}->{courseName};
   18 }
   19 
   20 sub body {
   21   my $self = shift;
   22   my $r = $self->{r};
   23   my $db = $self->{db};
   24   my $ce = $self->{ce};
   25   my $root = $ce->{webworkURLs}->{root};
   26   my $courseName = $ce->{courseName};
   27   my $user = $r->param('user');
   28   my $key  = $r->param('key');
   29   my $effectiveUserName = $r->param('effectiveUser');
   30   my $URL = $r->uri;
   31   my $instructorBaseURL = "$root/$courseName/instructor";
   32   my $setEditorURL = "$instructorBaseURL/problemSetEditor/";
   33   my $importURL = "$instructorBaseURL/problemSetImport/";
   34   my $addURL = "$instructorBaseURL/problemSetAdd/";
   35   my $sort = $r->param('sort') ? $r->param('sort') : "due_date";
   36 
   37   # Slurp each set record for this course in @sets
   38   # FIXME: getGlobalUser* should be getGlobal* once the database
   39   #        supports it, and the $user field should go away.
   40   my @sets;
   41   push @sets, $db->getGlobalUserSet($user, $_)
   42     foreach ($db->listUserSets($user));
   43 
   44   # Count the number of users each set is assigned to
   45   my %counts;
   46   foreach my $set (@sets) {
   47     my @problems = $db->listUserProblems($user, $set->set_id);
   48     my @users = $db->listUsers();
   49     my $count = 0;
   50     foreach my $user (@users) {
   51       if ($db->getGlobalUserSet($user, $set->set_id)) {
   52         # if the user has the set assigned to her
   53         $count++;
   54       }
   55     }
   56     $counts{$set->set_id} = $count;
   57   }
   58 
   59   # Sort @sets based on the sort parameter
   60   # Invalid sort types will just cause an unpredictable ordering, which is no big deal.
   61   @sets = sort {
   62     if ($sort eq "set_id") {
   63       return $a->$sort cmp $b->$sort;
   64     }elsif ($sort =~ /_date$/) {
   65       return $a->$sort <=> $b->$sort;
   66     } elsif ($sort eq "num_probs") {
   67       return scalar($db->listUserProblems($user, $a->set_id)) <=> scalar($db->listUserProblems($user, $b->set_id));
   68     } elsif ($sort eq "num_students") {
   69       return $counts{$a->set_id} <=> $counts{$b->set_id};
   70     }
   71   } @sets;
   72 
   73   my $table = CGI::Tr({},
   74     CGI::th("Sel.")
   75     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=set_id"},       "ID"))
   76     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=open_date"},    "Open Date"))
   77     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=due_date"},     "Due Date"))
   78     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=answer_date"},  "Answer Date"))
   79     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=num_probs"},    "Num. Problems"))
   80     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=num_students"}, "Assigned to:"))
   81   ) . "\n";
   82 
   83   foreach my $set (@sets) {
   84     my @problems = $db->listUserProblems($user, $set->set_id);
   85     my $count = $counts{$set->set_id};
   86     my @users = $db->listUsers();
   87 
   88     my $userCountMessage;
   89     if ($count == 0) {
   90       $userCountMessage = "Not assigned";
   91     } elsif ($count == 1) {
   92       $userCountMessage = "1 user";
   93     } elsif ($count == scalar(@users)) {
   94       $userCountMessage = "All users";
   95     } elsif ($count > scalar(@users) || $count < 0) {
   96       $userCountMessage = CGI::em("Impossible number of users: $count");
   97     } else {
   98       $userCountMessage = "$count users";
   99     }
  100 
  101     $table .= CGI::Tr({},
  102       CGI::td({},
  103         CGI::checkbox({
  104           "name"=>"selectedSet",
  105           "value"=>$set->set_id,
  106           "label"=>"",
  107           "checked"=>"0"
  108         })
  109       )
  110       . CGI::td({}, CGI::a({href=>"$setEditorURL?setName=".$set->set_id."&".$self->url_authen_args}, $set->set_id))
  111       . CGI::td({}, formatDateTime($set->open_date))
  112       . CGI::td({}, formatDateTime($set->due_date))
  113       . CGI::td({}, formatDateTime($set->answer_date))
  114       . CGI::td({}, scalar(@problems))
  115       . CGI::td({}, $userCountMessage)
  116     ) . "\n"
  117   }
  118   $table = CGI::table({"border"=>"1"}, "\n".$table."\n");
  119 
  120   my $form = CGI::start_form({"method"=>"POST", "action"=>""})."\n" # This form is for deleting sets, and points to itself
  121     . $table."\n"
  122     . CGI::br()."\n"
  123     . $self->hidden_authen_fields."\n"
  124     . CGI::submit({"name"=>"deleteSelected", "label"=>"Delete Selected"})."\n"
  125     . CGI::end_form()."\n"
  126     . CGI::start_form({"method"=>"POST", "action"=>$addURL})."\n"
  127     . $self->hidden_authen_fields."\n"
  128     . CGI::submit({"name"=>"addSet", "label"=>"New"})."\n"
  129     . CGI::end_form()."\n"
  130     . CGI::start_form({"method"=>"POST", "action"=>$importURL})."\n"
  131     . $self->hidden_authen_fields."\n"
  132     . CGI::submit({"name"=>"importSet", "label"=>"Import"})."\n"
  133     . CGI::end_form()."\n";
  134   print $form;
  135   print CGI::br();
  136 
  137   return "";
  138 }
  139 1;