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 use WeBWorK::DB::Record::Set;
   15 
   16 sub initialize {
   17   my $self = shift;
   18   my $r = $self->{r};
   19   my $db = $self->{db};
   20   my $ce = $self->{ce};
   21   my $courseName = $ce->{courseName};
   22 
   23   if (defined($r->param('deleteSelected'))) {
   24     foreach my $wannaDelete ($r->param('selectedSet')) {
   25       $db->deleteGlobalSet($wannaDelete);
   26     }
   27   } elsif (defined($r->param('makeNewSet'))) {
   28     my $newSetRecord = WeBWorK::DB::Record::Set->new();
   29     my $newSetName = $r->param('newSetName');
   30     $newSetRecord->set_id($newSetName);
   31     $newSetRecord->set_header("");
   32     $newSetRecord->problem_header("");
   33     $newSetRecord->open_date("0");
   34     $newSetRecord->due_date("0");
   35     $newSetRecord->answer_date("0");
   36     $db->addGlobalSet($newSetRecord) unless $db->getGlobalSet($newSetName);
   37   }
   38 
   39 }
   40 
   41 sub title {
   42   my $self = shift;
   43   return "Instructor Tools - Problem Set List for ".$self->{ce}->{courseName};
   44 }
   45 
   46 sub body {
   47   my $self = shift;
   48   my $r = $self->{r};
   49   my $db = $self->{db};
   50   my $ce = $self->{ce};
   51   my $root = $ce->{webworkURLs}->{root};
   52   my $courseName = $ce->{courseName};
   53   my $user = $r->param('user');
   54   my $key  = $r->param('key');
   55   my $effectiveUserName = $r->param('effectiveUser');
   56   my $URL = $r->uri;
   57   my $instructorBaseURL = "$root/$courseName/instructor";
   58   my $importURL = "$instructorBaseURL/problemSetImport/";
   59   my $addURL = "$instructorBaseURL/problemSetAdd/";
   60   my $sort = $r->param('sort') ? $r->param('sort') : "due_date";
   61 
   62   # Slurp each set record for this course in @sets
   63   # Gather data from the database
   64   my @users = $db->listUsers;
   65   my @sets;
   66   my %counts;
   67   my %problemCounts;
   68   foreach my $set_id ($db->listGlobalSets) {
   69     my $set = $db->getGlobalSet($set_id);
   70     push @sets, $set;
   71     $problemCounts{$set_id} = scalar($db->listGlobalProblems($set_id));
   72     my $count = 0;
   73     $counts{$set_id} = $db->listSetUsers($set_id);
   74   }
   75 
   76   # Sort @sets based on the sort parameter
   77   # Invalid sort types will just cause an unpredictable ordering, which is no big deal.
   78   @sets = sort {
   79     if ($sort eq "set_id") {
   80       return $a->$sort cmp $b->$sort;
   81     }elsif ($sort =~ /_date$/) {
   82       return $a->$sort <=> $b->$sort;
   83     } elsif ($sort eq "num_probs") {
   84       return $problemCounts{$a->set_id} <=> $problemCounts{$b->set_id};
   85     } elsif ($sort eq "num_students") {
   86       return $counts{$a->set_id} <=> $counts{$b->set_id};
   87     }
   88   } @sets;
   89 
   90   my $table = CGI::Tr({},
   91     CGI::th("Sel.")
   92     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=set_id"},       "ID"))
   93     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=open_date"},    "Open Date"))
   94     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=due_date"},     "Due Date"))
   95     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=answer_date"},  "Answer Date"))
   96     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=num_probs"},    "Num. Problems"))
   97     . CGI::th(CGI::a({"href"=>$URL."?".$self->url_authen_args."&sort=num_students"}, "Assigned to:"))
   98   ) . "\n";
   99 
  100   foreach my $set (@sets) {
  101     my $count = $counts{$set->set_id};
  102 
  103     my $userCountMessage = $self->userCountMessage($count, scalar(@users));
  104 
  105     $table .= CGI::Tr({},
  106       CGI::td({},
  107         CGI::checkbox({
  108           "name"=>"selectedSet",
  109           "value"=>$set->set_id,
  110           "label"=>"",
  111           "checked"=>"0"
  112         })
  113       )
  114       . CGI::td({}, CGI::a({href=>$r->uri.$set->set_id."/?".$self->url_authen_args}, $set->set_id))
  115       . CGI::td({}, formatDateTime($set->open_date))
  116       . CGI::td({}, formatDateTime($set->due_date))
  117       . CGI::td({}, formatDateTime($set->answer_date))
  118       . CGI::td({}, CGI::a({href=>$r->uri.$set->set_id."/problems/?".$self->url_authen_args}, $problemCounts{$set->set_id}))
  119       . CGI::td({}, CGI::a({href=>$r->uri.$set->set_id."/users/?".$self->url_authen_args}, $userCountMessage))
  120     ) . "\n"
  121   }
  122   $table = CGI::table({"border"=>"1"}, "\n".$table."\n");
  123 
  124   my $form = CGI::start_form({"method"=>"POST", "action"=>$r->uri})."\n" # This form is for deleting sets, and points to itself
  125     . $table."\n"
  126     . CGI::br()."\n"
  127     . $self->hidden_authen_fields."\n"
  128     . CGI::submit({"name"=>"deleteSelected", "label"=>"Delete Selected"})."\n"
  129     . CGI::end_form()."\n"
  130     . CGI::start_form({"method"=>"POST", "action"=>$r->uri})."\n"
  131     . $self->hidden_authen_fields."\n"
  132     . "New Set Name: "
  133     . CGI::input({type=>"text", name=>"newSetName", value=>""})
  134     . CGI::submit({"name"=>"makeNewSet", "label"=>"Create"})."\n"
  135     . CGI::end_form()."\n"
  136     . CGI::start_form({"method"=>"POST", "action"=>$importURL})."\n"
  137     . $self->hidden_authen_fields."\n"
  138     . CGI::submit({"name"=>"importSet", "label"=>"Import"})."\n"
  139     . CGI::end_form()."\n";
  140   print $form;
  141 
  142   return "";
  143 }
  144 
  145 1;