View of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Instructor.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor.pm,v 1.64 2007/08/13 22:59:55 sh002i Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::ContentGenerator::Instructor;
   18 use base qw(WeBWorK::ContentGenerator);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::ContentGenerator::Instructor - Abstract superclass for the Instructor
   23 tools, providing useful utility functions.
   24 
   25 =cut
   26 
   27 use strict;
   28 use warnings;
   29 #use CGI qw(-nosticky );
   30 use WeBWorK::CGI;
   31 use File::Find;
   32 use WeBWorK::DB::Utils qw(initializeUserProblem);
   33 use WeBWorK::Debug;
   34 use WeBWorK::Utils;
   35 
   36 =head1 METHODS
   37 
   38 =cut
   39 
   40 ################################################################################
   41 # Primary assignment methods
   42 ################################################################################
   43 
   44 =head2 Primary assignment methods
   45 
   46 =over
   47 
   48 =item assignSetToUser($userID, $GlobalSet)
   49 
   50 Assigns the given set and all problems contained therein to the given user. If
   51 the set (or any problems in the set) are already assigned to the user, a list of
   52 failure messages is returned.
   53 
   54 =cut
   55 
   56 sub assignSetToUser {
   57   my ($self, $userID, $GlobalSet) = @_;
   58   my $setID = $GlobalSet->set_id;
   59   my $db = $self->{db};
   60 
   61   my $UserSet = $db->newUserSet;
   62   $UserSet->user_id($userID);
   63   $UserSet->set_id($setID);
   64 
   65   my @results;
   66   my $set_assigned = 0;
   67 
   68   eval { $db->addUserSet($UserSet) };
   69   if ($@) {
   70     if ($@ =~ m/user set exists/) {
   71       push @results, "set $setID is already assigned to user $userID.";
   72       $set_assigned = 1;
   73     } else {
   74       die $@;
   75     }
   76   }
   77 
   78   my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID);
   79   foreach my $GlobalProblem (@GlobalProblems) {
   80     my @result = $self->assignProblemToUser($userID, $GlobalProblem);
   81     push @results, @result if @result and not $set_assigned;
   82   }
   83 
   84   return @results;
   85 }
   86 
   87 sub assignSetVersionToUser {
   88     my ( $self, $userID, $GlobalSet ) = @_;
   89 # in:  ($self,) $userID = the userID of the user to which to assign the set,
   90 #      $GlobalSet = the global set object.
   91 # out: a new set version is assigned to the user.
   92 # note: we assume that the global set and user are well defined.  I think this
   93 #    is a safe assumption.  it would be nice to just call assignSetToUser,
   94 #    but we run into trouble doing that because of the distinction between
   95 #    the setID and the setVersionID
   96 
   97     my $setID = $GlobalSet->set_id;
   98     my $db = $self->{db};
   99 
  100 # figure out what version we're on, reset setID, get a new user set
  101 # FIXME: old version; new call follows
  102 #    my $setVersionNum = $db->getUserSetVersionNumber( $userID, $setID );
  103     my @allVersionIDs = $db->listSetVersions( $userID, $setID );
  104     my $setVersionNum = ( @allVersionIDs ) ? $allVersionIDs[-1] : 0;
  105     $setVersionNum++;
  106     my $userSet = $db->newSetVersion;
  107     $userSet->user_id( $userID );
  108     $userSet->set_id( $setID );
  109     $userSet->version_id( $setVersionNum );
  110 
  111     my @results = ();
  112     my $set_assigned = 0;
  113 
  114 # add the set to the database
  115     eval { $db->addSetVersion( $userSet ) };
  116     if ( $@ ) {
  117   if ( $@ =~ m/user set exists/ ) {
  118       push( @results, "set $setID,v$setVersionNum is already assigned" .
  119       "to user $userID" );
  120       $set_assigned = 1;
  121   } else {
  122       die $@;
  123   }
  124     }
  125 
  126 # populate set with problems
  127     my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID);
  128 
  129 # keep track of problems assigned from groups so that we can have multiple
  130 #    problems from a given group, without duplicates
  131     my %groupProblems = ();
  132 
  133     foreach my $GlobalProblem ( @GlobalProblems ) {
  134   $GlobalProblem->set_id( $setID );
  135 # this is getting called from within ContentGenerator, so that $self
  136 #    isn't an Instructor object---therefore, calling $self->assign...
  137 #    doesn't work.  the following is an ugly workaround that works b/c
  138 #    both Instructor and ContentGenerator objects have $self->{db}
  139 # FIXME  it would be nice to have a better solution to this
  140   my @result =
  141       assignProblemToUserSetVersion( $self, $userID, $userSet,
  142                        $GlobalProblem, \%groupProblems );
  143   push( @results, @result ) if ( @result && not $set_assigned );
  144     }
  145 
  146     return @results;
  147 }
  148 
  149 
  150 =item unassignSetFromUser($userID, $setID, $problemID)
  151 
  152 Unassigns the given set and all problems therein from the given user.
  153 
  154 =cut
  155 
  156 sub unassignSetFromUser {
  157   my ($self, $userID, $setID) = @_;
  158   my $db = $self->{db};
  159 
  160   $db->deleteUserSet($userID, $setID);
  161 }
  162 
  163 =item assignProblemToUser($userID, $GlobalProblem, $seed)
  164 
  165 Assigns the given problem to the given user. If the problem is already assigned
  166 to the user, an error string is returned. If $seed is defined, the UserProblem
  167 will be given that seed.
  168 
  169 =cut
  170 
  171 sub assignProblemToUser {
  172   my ($self, $userID, $GlobalProblem, $seed) = @_;
  173   my $db = $self->{db};
  174 
  175   my $UserProblem = $db->newUserProblem;
  176   $UserProblem->user_id($userID);
  177   $UserProblem->set_id($GlobalProblem->set_id);
  178   $UserProblem->problem_id($GlobalProblem->problem_id);
  179   initializeUserProblem($UserProblem, $seed);
  180 
  181   eval { $db->addUserProblem($UserProblem) };
  182   if ($@) {
  183     if ($@ =~ m/user problem exists/) {
  184       return "problem " . $GlobalProblem->problem_id
  185         . " in set " . $GlobalProblem->set_id
  186         . " is already assigned to user $userID.";
  187     } else {
  188       die $@;
  189     }
  190   }
  191 
  192   return ();
  193 }
  194 
  195 # $seed is optional -- if set, the UserProblem will be given that seed
  196 sub assignProblemToUserSetVersion {
  197   my ($self, $userID, $userSet, $GlobalProblem, $groupProbRef, $seed) = @_;
  198   my $db = $self->{db};
  199 
  200 # conditional to allow selection of problems from a group of problems,
  201 # defined in a set.
  202 
  203     # problem groups are indicated by source files "group:problemGroupName"
  204   if ( $GlobalProblem->source_file() =~ /^group:(.+)$/ ) {
  205       my $problemGroupName = $1;
  206 
  207     # get list of problems in group
  208       my @problemList = $db->listGlobalProblems($problemGroupName);
  209         # sanity check: if the group set hasn't been defined or doesn't
  210         # actually contain problems (oops), then we can't very well assign
  211         # this problem to the user.  we could go on and assign all other
  212         # problems, but that results in a partial set.  so we die here if
  213         # this happens.  philosophically we're requiring that the instructor
  214         # set up the sets correctly or have to deal with the carnage after-
  215         # wards.  I'm not sure that this is the best long-term solution.
  216         # FIXME: this means that we may have created a set version that
  217         # doesn't have any problems.  this is bad.  but it's hard to see
  218         # where else to deal with it---fixing the problem requires checking
  219         # at the set version-creation level that all the problems in the
  220         # set are well defined.  FIXME
  221       die("Error in set version creation: no problems are available " .
  222     "in problem group $problemGroupName.  Set " .
  223     $userSet->set_id . " has been created for $userID, but " .
  224     "does not contain the right problems.\n") if (! @problemList);
  225 
  226       my $nProb = @problemList;
  227       my $whichProblem = int(rand($nProb));
  228 
  229     # we allow selection of multiple problems from a group, but want them to
  230     #   be different.  there's probably a better way to do this
  231       if ( defined( $groupProbRef->{$problemGroupName} ) &&
  232      $groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/ ) {
  233     my $nAvail = $nProb -
  234         ( $groupProbRef->{$problemGroupName} =~ tr/,// ) - 1;
  235 
  236     die("Too many problems selected from group.") if ( ! $nAvail );
  237 
  238     $whichProblem = int(rand($nProb));
  239     while ( $groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/ ) {
  240         $whichProblem = ( $whichProblem + 1 )%$nProb;
  241     }
  242       }
  243       if ( defined( $groupProbRef->{$problemGroupName} ) ) {
  244     $groupProbRef->{$problemGroupName} .= ",$whichProblem";
  245       } else {
  246     $groupProbRef->{$problemGroupName} = "$whichProblem";
  247       }
  248 
  249       my $prob = $db->getGlobalProblem($problemGroupName,
  250                $problemList[$whichProblem]);
  251       $GlobalProblem->source_file($prob->source_file());
  252   }
  253 
  254 # all set; do problem assignment
  255   my $UserProblem = $db->newProblemVersion;
  256   $UserProblem->user_id($userID);
  257   $UserProblem->set_id($userSet->set_id);
  258   $UserProblem->version_id($userSet->version_id);
  259   $UserProblem->problem_id($GlobalProblem->problem_id);
  260   $UserProblem->source_file($GlobalProblem->source_file);
  261   initializeUserProblem($UserProblem, $seed);
  262 
  263   eval { $db->addProblemVersion($UserProblem) };
  264   if ($@) {
  265     if ($@ =~ m/user problem exists/) {
  266       return "problem " . $GlobalProblem->problem_id
  267         . " in set " . $GlobalProblem->set_id
  268         . " is already assigned to user $userID.";
  269     } else {
  270       die $@;
  271     }
  272   }
  273 
  274   return();
  275 }
  276 
  277 =item unassignProblemFromUser($userID, $setID, $problemID)
  278 
  279 Unassigns the given problem from the given user.
  280 
  281 =cut
  282 
  283 sub unassignProblemFromUser {
  284   my ($self, $userID, $setID, $problemID) = @_;
  285   my $db = $self->{db};
  286 
  287   $db->deleteUserProblem($userID, $setID, $problemID);
  288 }
  289 
  290 =back
  291 
  292 =cut
  293 
  294 ################################################################################
  295 # Secondary set assignment methods
  296 ################################################################################
  297 
  298 =head2 Secondary assignment methods
  299 
  300 =over
  301 
  302 =item assignSetToAllUsers($setID)
  303 
  304 Assigns the set specified and all problems contained therein to all users in
  305 the course. This is more efficient than repeatedly calling assignSetToUser().
  306 If any assignments fail, a list of failure messages is returned.
  307 
  308 =cut
  309 
  310 sub assignSetToAllUsers {
  311   my ($self, $setID) = @_;
  312   my $db = $self->{db};
  313   my @userIDs = $db->listUsers;
  314 
  315   debug("$setID: getting user list");
  316   # DBFIXME pre-filter with WHERE clause for status abbrevs. that allow assignment (tricky...)
  317   my @userRecords = $db->getUsers(@userIDs);
  318   debug("$setID: (done with that)");
  319 
  320   debug("$setID: getting problem list");
  321   my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID);
  322   debug("$setID: (done with that)");
  323 
  324   my @results;
  325 
  326   foreach my $User (@userRecords) {
  327     next unless $self->r->ce->status_abbrev_has_behavior($User->status, "include_in_assignment");
  328     my $UserSet = $db->newUserSet;
  329     my $userID = $User->user_id;
  330     $UserSet->user_id($userID);
  331     $UserSet->set_id($setID);
  332     debug("$setID: adding UserSet for $userID");
  333     eval { $db->addUserSet($UserSet) };
  334     if ($@) {
  335       next if $@ =~ m/user set exists/;
  336       die $@;
  337     }
  338     debug("$setID: (done with that)");
  339 
  340     debug("$setID: adding UserProblems for $userID");
  341     foreach my $GlobalProblem (@GlobalProblems) {
  342       my @result = $self->assignProblemToUser($userID, $GlobalProblem);
  343       push @results, @result if @result;
  344     }
  345     debug("$setID: (done with that)");
  346   }
  347 
  348   return @results;
  349 }
  350 
  351 =item unassignSetFromAllUsers($setID)
  352 
  353 Unassigns the specified sets and all problems contained therein from all users.
  354 
  355 =cut
  356 
  357 sub unassignSetFromAllUsers {
  358   my ($self, $setID) = @_;
  359   my $db = $self->{db};
  360 
  361   my @userIDs = $db->listSetUsers($setID);
  362 
  363   foreach my $userID (@userIDs) {
  364     $self->unassignSetFromUser($userID, $setID);
  365   }
  366 }
  367 
  368 =item assignAllSetsToUser($userID)
  369 
  370 Assigns all sets in the course and all problems contained therein to the
  371 specified user. This is more efficient than repeatedly calling
  372 assignSetToUser(). If any assignments fail, a list of failure messages is
  373 returned.
  374 
  375 =cut
  376 
  377 sub assignAllSetsToUser {
  378   my ($self, $userID) = @_;
  379   my $db = $self->{db};
  380 
  381   # assign only sets that are not already assigned
  382   #my %userSetIDs = map { $_ => 1 } $db->listUserSets($userID);
  383   #my @globalSetIDs = grep { not exists $userSetIDs{$_} } $db->listGlobalSets;
  384   #my @GlobalSets = $db->getGlobalSets(@globalSetIDs);
  385   # FIXME: i don't think we need to do the above, since asignSetToUser fails
  386   # silently if a UserSet already exists. instead we do this:
  387   # DBFIXME shouldn't need to get list of set IDs
  388   my @globalSetIDs = $db->listGlobalSets;
  389   my @GlobalSets = $db->getGlobalSets(@globalSetIDs);
  390 
  391   my @results;
  392 
  393   my $i = 0;
  394   foreach my $GlobalSet (@GlobalSets) {
  395     if (not defined $GlobalSet) {
  396       warn "record not found for global set $globalSetIDs[$i]";
  397     } else {
  398       my @result = $self->assignSetToUser($userID, $GlobalSet);
  399       push @results, @result if @result;
  400     }
  401     $i++;
  402   }
  403 
  404   return @results;
  405 }
  406 
  407 =item unassignAllSetsFromUser($userID)
  408 
  409 Unassigns all sets and all problems contained therein from the specified user.
  410 
  411 =cut
  412 
  413 sub unassignAllSetsFromUser {
  414   my ($self, $userID) = @_;
  415   my $db = $self->{db};
  416 
  417   my @setIDs = $db->listUserSets($userID);
  418 
  419   foreach my $setID (@setIDs) {
  420     $self->unassignSetFromUser($userID, $setID);
  421   }
  422 }
  423 
  424 =back
  425 
  426 =cut
  427 
  428 ################################################################################
  429 # Utility assignment methods
  430 ################################################################################
  431 
  432 =head2 Utility assignment methods
  433 
  434 =over
  435 
  436 =item assignSetsToUsers($setIDsRef, $userIDsRef)
  437 
  438 Assign each of the given sets to each of the given users. If any assignments
  439 fail, a list of failure messages is returned.
  440 
  441 =cut
  442 
  443 sub assignSetsToUsers {
  444   my ($self, $setIDsRef, $userIDsRef) = @_;
  445   my $db = $self->{db};
  446 
  447   my @setIDs = @$setIDsRef;
  448   my @userIDs = @$userIDsRef;
  449   my @GlobalSets = $db->getGlobalSets(@setIDs);
  450 
  451   my @results;
  452 
  453   foreach my $GlobalSet (@GlobalSets) {
  454     foreach my $userID (@userIDs) {
  455       my @result = $self->assignSetToUser($userID, $GlobalSet);
  456       push @results, @result if @result;
  457     }
  458   }
  459 
  460   return @results;
  461 }
  462 
  463 =item unassignSetsFromUsers($setIDsRef, $userIDsRef)
  464 
  465 Unassign each of the given sets from each of the given users.
  466 
  467 =cut
  468 
  469 sub unassignSetsFromUsers {
  470   my ($self, $setIDsRef, $userIDsRef) = @_;
  471   my @setIDs = @$setIDsRef;
  472   my @userIDs = @$userIDsRef;
  473 
  474   foreach my $setID (@setIDs) {
  475     foreach my $userID (@userIDs) {
  476       $self->unassignSetFromUser($userID, $setID);
  477     }
  478   }
  479 }
  480 
  481 =item assignProblemToAllSetUsers($GlobalProblem)
  482 
  483 Assigns the problem specified to all users to whom the problem's set is
  484 assigned. If any assignments fail, a list of failure messages is returned.
  485 
  486 =cut
  487 
  488 sub assignProblemToAllSetUsers {
  489   my ($self, $GlobalProblem) = @_;
  490   my $db = $self->{db};
  491   my $setID = $GlobalProblem->set_id;
  492   my @userIDs = $db->listSetUsers($setID);
  493 
  494   my @results;
  495 
  496   foreach my $userID (@userIDs) {
  497     my @result = $self->assignProblemToUser($userID, $GlobalProblem);
  498     push @results, @result if @result;
  499   }
  500 
  501   return @results;
  502 }
  503 
  504 =back
  505 
  506 =cut
  507 
  508 ################################################################################
  509 # Utility method for adding problems to a set
  510 ################################################################################
  511 
  512 =head2 Utility method for adding problems to a set
  513 
  514 =over
  515 
  516 =cut
  517 
  518 sub addProblemToSet {
  519   my ($self, %args) = @_;
  520   my $db = $self->r->db;
  521   my $value_default = $self->{ce}->{problemDefaults}->{value};
  522   my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts};
  523 
  524 
  525   die "addProblemToSet called without specifying the set name." if $args{setName} eq "";
  526   my $setName = $args{setName};
  527 
  528   my $sourceFile = $args{sourceFile} or
  529     die "addProblemToSet called without specifying the sourceFile.";
  530 
  531   # The rest of the arguments are optional
  532 
  533 # my $value = $args{value} || $value_default;
  534   my $value = $value_default;
  535   if (defined($args{value})){$value = $args{value};}  # 0 is a valid value for $args{value}
  536 
  537   my $maxAttempts = $args{maxAttempts} || $max_attempts_default;
  538   my $problemID = $args{problemID};
  539 
  540   unless ($problemID) {
  541     $problemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1;
  542   }
  543 
  544   my $problemRecord = $db->newGlobalProblem;
  545   $problemRecord->problem_id($problemID);
  546   $problemRecord->set_id($setName);
  547   $problemRecord->source_file($sourceFile);
  548   $problemRecord->value($value);
  549   $problemRecord->max_attempts($maxAttempts);
  550   $db->addGlobalProblem($problemRecord);
  551 
  552   return $problemRecord;
  553 }
  554 
  555 =back
  556 
  557 =cut
  558 
  559 ################################################################################
  560 # Utility methods
  561 ################################################################################
  562 
  563 =head2 Utility methods
  564 
  565 =over
  566 
  567 =cut
  568 
  569 sub hiddenEditForUserFields {
  570   my ($self, @editForUser) = @_;
  571   my $return = "";
  572   foreach my $editUser (@editForUser) {
  573     $return .= CGI::input({type=>"hidden", name=>"editForUser", value=>$editUser});
  574   }
  575 
  576   return $return;
  577 }
  578 
  579 sub userCountMessage {
  580   my ($self, $count, $numUsers) = @_;
  581 
  582   my $message;
  583   if ($count == 0) {
  584     $message = CGI::em("no students");
  585   } elsif ($count == $numUsers) {
  586     $message = "all students";
  587   } elsif ($count == 1) {
  588     $message = "1 student";
  589   } elsif ($count > $numUsers || $count < 0) {
  590     $message = CGI::em("an impossible number of users: $count out of $numUsers");
  591   } else {
  592     $message = "$count students out of $numUsers";
  593   }
  594 
  595   return $message;
  596 }
  597 
  598 sub setCountMessage {
  599   my ($self, $count, $numSets) = @_;
  600 
  601   my $message;
  602   if ($count == 0) {
  603     $message = CGI::em("no sets");
  604   } elsif ($count == $numSets) {
  605     $message = "all sets";
  606   } elsif ($count == 1) {
  607     $message = "1 set";
  608   } elsif ($count > $numSets || $count < 0) {
  609     $message = CGI::em("an impossible number of sets: $count out of $numSets");
  610   } else {
  611     $message = "$count sets";
  612   }
  613 
  614   return $message;
  615 }
  616 
  617 sub read_dir {  # read a directory
  618   my $self      = shift;
  619   my $directory = shift;
  620   my $pattern   = shift;
  621   my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory);
  622   return sort @files;
  623 }
  624 
  625 =back
  626 
  627 =cut
  628 
  629 ################################################################################
  630 # Methods for listing various types of files
  631 ################################################################################
  632 
  633 =head2 Methods for listing various types of files
  634 
  635 =over
  636 
  637 =cut
  638 
  639 # list classlist files
  640 sub getCSVList {
  641   my ($self) = @_;
  642   my $ce = $self->{ce};
  643   my $dir = $ce->{courseDirs}->{templates};
  644   return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir);
  645 }
  646 
  647 sub getDefList {
  648   my ($self) = @_;
  649   my $ce = $self->{ce};
  650   my $dir = $ce->{courseDirs}->{templates};
  651   return $self->read_dir($dir, qr/.*\.def/);
  652 }
  653 
  654 sub getScoringFileList {
  655   my ($self) = @_;
  656   my $ce = $self->{ce};
  657   my $dir = $ce->{courseDirs}->{scoring};
  658   return $self->read_dir($dir, qr/.*\.csv/);
  659 }
  660 
  661 sub getTemplateFileList {  # find all .pg files under the template tree (time consuming)
  662   my ($self) = shift;
  663   my $subDir = shift;
  664   my $ce = $self->{ce};
  665   $subDir = '' unless defined $subDir;
  666   my $dir = $ce->{courseDirs}->{templates}."/$subDir";
  667   # FIXME  currently allows one to see most files in the templates directory.
  668   # a better facility for handling auxiliary files would be nice.
  669   return $self->read_dir($dir, qr/\.pg$|.*\.html|\.png|\.gif|\.txt|\.pl/);
  670 }
  671 sub getTemplateDirList {  # find all .pg files under the template tree (time consuming)
  672   my ($self) = @_;
  673   my $ce = $self->{ce};
  674   my $dir = $ce->{courseDirs}->{templates};
  675   my @list = ();
  676   my $wanted = sub { if (-d $_ ) {
  677                           my $current = $_;
  678                           return if $current =~/CVS/;
  679                           return if -l $current;   # don't list links
  680                           my $name = $File::Find::name;
  681                           $name = " Top" if $current =/^\./; #  top directory
  682               $name =~ s/^$dir\///;
  683               push @list, $name
  684              }
  685   };
  686   File::Find::find($wanted, $dir);
  687   return sort @list;
  688 }
  689 
  690 =back
  691 
  692 =cut
  693 
  694 1;