Parent Directory
| 
Revision Log
Allow users to specify default values for max_attempts and value of a problem
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 my $value = $args{value} || $value_default; 533 my $maxAttempts = $args{maxAttempts} || $max_attempts_default; 534 my $problemID = $args{problemID}; 535 536 unless ($problemID) { 537 $problemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; 538 } 539 540 my $problemRecord = $db->newGlobalProblem; 541 $problemRecord->problem_id($problemID); 542 $problemRecord->set_id($setName); 543 $problemRecord->source_file($sourceFile); 544 $problemRecord->value($value); 545 $problemRecord->max_attempts($maxAttempts); 546 $db->addGlobalProblem($problemRecord); 547 548 return $problemRecord; 549 } 550 551 =back 552 553 =cut 554 555 ################################################################################ 556 # Utility methods 557 ################################################################################ 558 559 =head2 Utility methods 560 561 =over 562 563 =cut 564 565 sub hiddenEditForUserFields { 566 my ($self, @editForUser) = @_; 567 my $return = ""; 568 foreach my $editUser (@editForUser) { 569 $return .= CGI::input({type=>"hidden", name=>"editForUser", value=>$editUser}); 570 } 571 572 return $return; 573 } 574 575 sub userCountMessage { 576 my ($self, $count, $numUsers) = @_; 577 578 my $message; 579 if ($count == 0) { 580 $message = CGI::em("no students"); 581 } elsif ($count == $numUsers) { 582 $message = "all students"; 583 } elsif ($count == 1) { 584 $message = "1 student"; 585 } elsif ($count > $numUsers || $count < 0) { 586 $message = CGI::em("an impossible number of users: $count out of $numUsers"); 587 } else { 588 $message = "$count students out of $numUsers"; 589 } 590 591 return $message; 592 } 593 594 sub setCountMessage { 595 my ($self, $count, $numSets) = @_; 596 597 my $message; 598 if ($count == 0) { 599 $message = CGI::em("no sets"); 600 } elsif ($count == $numSets) { 601 $message = "all sets"; 602 } elsif ($count == 1) { 603 $message = "1 set"; 604 } elsif ($count > $numSets || $count < 0) { 605 $message = CGI::em("an impossible number of sets: $count out of $numSets"); 606 } else { 607 $message = "$count sets"; 608 } 609 610 return $message; 611 } 612 613 sub read_dir { # read a directory 614 my $self = shift; 615 my $directory = shift; 616 my $pattern = shift; 617 my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); 618 return sort @files; 619 } 620 621 =back 622 623 =cut 624 625 ################################################################################ 626 # Methods for listing various types of files 627 ################################################################################ 628 629 =head2 Methods for listing various types of files 630 631 =over 632 633 =cut 634 635 # list classlist files 636 sub getCSVList { 637 my ($self) = @_; 638 my $ce = $self->{ce}; 639 my $dir = $ce->{courseDirs}->{templates}; 640 return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir); 641 } 642 643 sub getDefList { 644 my ($self) = @_; 645 my $ce = $self->{ce}; 646 my $dir = $ce->{courseDirs}->{templates}; 647 return $self->read_dir($dir, qr/.*\.def/); 648 } 649 650 sub getScoringFileList { 651 my ($self) = @_; 652 my $ce = $self->{ce}; 653 my $dir = $ce->{courseDirs}->{scoring}; 654 return $self->read_dir($dir, qr/.*\.csv/); 655 } 656 657 sub getTemplateFileList { # find all .pg files under the template tree (time consuming) 658 my ($self) = shift; 659 my $subDir = shift; 660 my $ce = $self->{ce}; 661 $subDir = '' unless defined $subDir; 662 my $dir = $ce->{courseDirs}->{templates}."/$subDir"; 663 # FIXME currently allows one to see most files in the templates directory. 664 # a better facility for handling auxiliary files would be nice. 665 return $self->read_dir($dir, qr/\.pg$|.*\.html|\.png|\.gif|\.txt|\.pl/); 666 } 667 sub getTemplateDirList { # find all .pg files under the template tree (time consuming) 668 my ($self) = @_; 669 my $ce = $self->{ce}; 670 my $dir = $ce->{courseDirs}->{templates}; 671 my @list = (); 672 my $wanted = sub { if (-d $_ ) { 673 my $current = $_; 674 return if $current =~/CVS/; 675 return if -l $current; # don't list links 676 my $name = $File::Find::name; 677 $name = " Top" if $current =/^\./; # top directory 678 $name =~ s/^$dir\///; 679 push @list, $name 680 } 681 }; 682 File::Find::find($wanted, $dir); 683 return sort @list; 684 } 685 686 =back 687 688 =cut 689 690 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |