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