Parent Directory
| 
Revision Log
Updated Instructor.pm to include assignVersionedSetToUser routine(s).
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor.pm,v 1.41 2004/06/11 14:38:58 toenail 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(); 30 use WeBWorK::DB::Utils qw(initializeUserProblem); 31 32 =head1 METHODS 33 34 =cut 35 36 ################################################################################ 37 # Primary assignment methods 38 ################################################################################ 39 40 =head2 Primary assignment methods 41 42 =over 43 44 =item assignSetToUser($userID, $GlobalSet) 45 46 Assigns the given set and all problems contained therein to the given user. If 47 the set (or any problems in the set) are already assigned to the user, a list of 48 failure messages is returned. 49 50 =cut 51 52 sub assignSetToUser { 53 my ($self, $userID, $GlobalSet) = @_; 54 my $setID = $GlobalSet->set_id; 55 my $db = $self->{db}; 56 57 my $UserSet = $db->newUserSet; 58 $UserSet->user_id($userID); 59 $UserSet->set_id($setID); 60 61 my @results; 62 my $set_assigned = 0; 63 64 eval { $db->addUserSet($UserSet) }; 65 if ($@) { 66 if ($@ =~ m/user set exists/) { 67 push @results, "set $setID is already assigned to user $userID."; 68 $set_assigned = 1; 69 } else { 70 die $@; 71 } 72 } 73 74 my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); 75 foreach my $GlobalProblem (@GlobalProblems) { 76 my @result = $self->assignProblemToUser($userID, $GlobalProblem); 77 push @results, @result if @result and not $set_assigned; 78 } 79 80 return @results; 81 } 82 83 sub assignSetVersionToUser { 84 my ( $self, $userID, $GlobalSet ) = @_; 85 # in: ($self,) $userID = the userID of the user to which to assign the set, 86 # $GlobalSet = the global set object. 87 # out: a new set version is assigned to the user. 88 # note: we assume that the global set and user are well defined. I think this 89 # is a safe assumption. it would be nice to just call assignSetToUser, 90 # but we run into trouble doing that because of the distinction between 91 # the setID and the setVersionID 92 93 my $setID = $GlobalSet->set_id; 94 my $db = $self->{db}; 95 96 # figure out what version we're on, reset setID, get a new user set 97 my $setVersionNum = $db->getUserSetVersionNumber( $userID, $setID ); 98 $setVersionNum++; 99 my $setVersionID = "$setID,v$setVersionNum"; 100 my $userSet = $db->newUserSet; 101 $userSet->user_id( $userID ); 102 $userSet->set_id( $setVersionID ); 103 104 my @results = (); 105 my $set_assigned = 0; 106 107 # add the set to the database 108 eval( $db->addVersionedUserSet( $userSet ) ); 109 if ( $@ ) { 110 if ( $@ =~ m/user set exists/ ) { 111 push( @results, "set $setVersionID is already assigned to user " . 112 "$userID" ); 113 $set_assigned = 1; 114 } else { 115 die $@; 116 } 117 } 118 119 # populate set with problems 120 my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); 121 122 foreach my $GlobalProblem ( @GlobalProblems ) { 123 $GlobalProblem->set_id( $setVersionID ); 124 # this is getting called from within ContentGenerator, so that $self 125 # isn't an Instructor object---therefore, calling $self->assign... 126 # doesn't work. the following is an ugly workaround that works b/c 127 # both Instructor and ContentGenerator objects have $self->{db} 128 # FIXME it would be nice to have a better solution to this 129 # my @result = 130 # $self->assignProblemToUser( $userID, $GlobalProblem ); 131 my @result = 132 assignProblemToUserSetVersion( $self, $userID, $userSet, 133 $GlobalProblem ); 134 push( @results, @result ) if ( @result && not $set_assigned ); 135 } 136 137 return @results; 138 } 139 140 =item unassignSetFromUser($userID, $setID, $problemID) 141 142 Unassigns the given set and all problems therein from the given user. 143 144 =cut 145 146 sub unassignSetFromUser { 147 my ($self, $userID, $setID) = @_; 148 my $db = $self->{db}; 149 150 $db->deleteUserSet($userID, $setID); 151 } 152 153 =item assignProblemToUser($userID, $GlobalProblem) 154 155 Assigns the given problem to the given user. If the problem is already assigned 156 to the user, an error string is returned. 157 158 =cut 159 160 sub assignProblemToUser { 161 my ($self, $userID, $GlobalProblem) = @_; 162 my $db = $self->{db}; 163 164 my $UserProblem = $db->newUserProblem; 165 $UserProblem->user_id($userID); 166 $UserProblem->set_id($GlobalProblem->set_id); 167 $UserProblem->problem_id($GlobalProblem->problem_id); 168 initializeUserProblem($UserProblem); 169 170 eval { $db->addUserProblem($UserProblem) }; 171 if ($@) { 172 if ($@ =~ m/user problem exists/) { 173 return "problem " . $GlobalProblem->problem_id 174 . " in set " . $GlobalProblem->set_id 175 . " is already assigned to user $userID."; 176 } else { 177 die $@; 178 } 179 } 180 181 return (); 182 } 183 184 sub assignProblemToUserSetVersion { 185 my ($self, $userID, $userSet, $GlobalProblem) = @_; 186 my $db = $self->{db}; 187 188 my $UserProblem = $db->newUserProblem; 189 $UserProblem->user_id($userID); 190 $UserProblem->set_id($userSet->set_id); 191 $UserProblem->problem_id($GlobalProblem->problem_id); 192 initializeUserProblem($UserProblem); 193 194 eval { $db->addUserProblem($UserProblem) }; 195 if ($@) { 196 if ($@ =~ m/user problem exists/) { 197 return "problem " . $GlobalProblem->problem_id 198 . " in set " . $GlobalProblem->set_id 199 . " is already assigned to user $userID."; 200 } else { 201 die $@; 202 } 203 } 204 205 return(); 206 } 207 208 =item unassignProblemFromUser($userID, $setID, $problemID) 209 210 Unassigns the given problem from the given user. 211 212 =cut 213 214 sub unassignProblemFromUser { 215 my ($self, $userID, $setID, $problemID) = @_; 216 my $db = $self->{db}; 217 218 $db->deleteUserProblem($userID, $setID, $problemID); 219 } 220 221 =back 222 223 =cut 224 225 ################################################################################ 226 # Secondary set assignment methods 227 ################################################################################ 228 229 =head2 Secondary assignment methods 230 231 =over 232 233 =item assignSetToAllUsers($setID) 234 235 Assigns the set specified and all problems contained therein to all users in 236 the course. This is more efficient than repeatedly calling assignSetToUser(). 237 If any assignments fail, a list of failure messages is returned. 238 239 =cut 240 241 sub assignSetToAllUsers { 242 my ($self, $setID) = @_; 243 my $db = $self->{db}; 244 my @userIDs = $db->listUsers; 245 246 $WeBWorK::timer->continue("$setID: getting user list") if defined $WeBWorK::timer; 247 my @userRecords = $db->getUsers(@userIDs); 248 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 249 250 $WeBWorK::timer->continue("$setID: getting problem list") if defined $WeBWorK::timer; 251 my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); 252 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 253 254 my @results; 255 256 foreach my $User (@userRecords) { 257 next if grep /$User->{status}/, @{$self->{r}->{ce}->{siteDefaults}->{statusDrop}}; 258 my $UserSet = $db->newUserSet; 259 my $userID = $User->user_id; 260 $UserSet->user_id($userID); 261 $UserSet->set_id($setID); 262 $WeBWorK::timer->continue("$setID: adding UserSet for $userID") if defined $WeBWorK::timer; 263 eval { $db->addUserSet($UserSet) }; 264 if ($@) { 265 next if $@ =~ m/user set exists/; 266 die $@; 267 } 268 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 269 270 $WeBWorK::timer->continue("$setID: adding UserProblems for $userID") if defined $WeBWorK::timer; 271 foreach my $GlobalProblem (@GlobalProblems) { 272 my @result = $self->assignProblemToUser($userID, $GlobalProblem); 273 push @results, @result if @result; 274 } 275 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 276 } 277 278 return @results; 279 } 280 281 =item unassignSetFromAllUsers($setID) 282 283 Unassigns the specified sets and all problems contained therein from all users. 284 285 =cut 286 287 sub unassignSetFromAllUsers { 288 my ($self, $setID) = @_; 289 my $db = $self->{db}; 290 291 my @userIDs = $db->listSetUsers($setID); 292 293 foreach my $userID (@userIDs) { 294 $self->unassignSetFromUser($userID, $setID); 295 } 296 } 297 298 =item assignAllSetsToUser($userID) 299 300 Assigns all sets in the course and all problems contained therein to the 301 specified user. This is more efficient than repeatedly calling 302 assignSetToUser(). If any assignments fail, a list of failure messages is 303 returned. 304 305 =cut 306 307 sub assignAllSetsToUser { 308 my ($self, $userID) = @_; 309 my $db = $self->{db}; 310 311 # assign only sets that are not already assigned 312 #my %userSetIDs = map { $_ => 1 } $db->listUserSets($userID); 313 #my @globalSetIDs = grep { not exists $userSetIDs{$_} } $db->listGlobalSets; 314 #my @GlobalSets = $db->getGlobalSets(@globalSetIDs); 315 # FIXME: i don't think we need to do the above, since asignSetToUser fails 316 # silently if a UserSet already exists. instead we do this: 317 my @globalSetIDs = $db->listGlobalSets; 318 my @GlobalSets = $db->getGlobalSets(@globalSetIDs); 319 320 my @results; 321 322 my $i = 0; 323 foreach my $GlobalSet (@GlobalSets) { 324 if (not defined $GlobalSet) { 325 warn "record not found for global set $globalSetIDs[$i]"; 326 } else { 327 my @result = $self->assignSetToUser($userID, $GlobalSet); 328 push @results, @result if @result; 329 } 330 $i++; 331 } 332 333 return @results; 334 } 335 336 =item unassignAllSetsFromUser($userID) 337 338 Unassigns all sets and all problems contained therein from the specified user. 339 340 =cut 341 342 sub unassignAllSetsFromUser { 343 my ($self, $userID) = @_; 344 my $db = $self->{db}; 345 346 my @setIDs = $db->listUserSets($userID); 347 348 foreach my $setID (@setIDs) { 349 $self->unassignSetFromUser($userID, $setID); 350 } 351 } 352 353 =back 354 355 =cut 356 357 ################################################################################ 358 # Utility assignment methods 359 ################################################################################ 360 361 =head2 Utility assignment methods 362 363 =over 364 365 =item assignSetsToUsers($setIDsRef, $userIDsRef) 366 367 Assign each of the given sets to each of the given users. If any assignments 368 fail, a list of failure messages is returned. 369 370 =cut 371 372 sub assignSetsToUsers { 373 my ($self, $setIDsRef, $userIDsRef) = @_; 374 my $db = $self->{db}; 375 376 my @setIDs = @$setIDsRef; 377 my @userIDs = @$userIDsRef; 378 my @GlobalSets = $db->getGlobalSets(@setIDs); 379 380 my @results; 381 382 foreach my $GlobalSet (@GlobalSets) { 383 foreach my $userID (@userIDs) { 384 my @result = $self->assignSetToUser($userID, $GlobalSet); 385 push @results, @result if @result; 386 } 387 } 388 389 return @results; 390 } 391 392 =item unassignSetsFromUsers($setIDsRef, $userIDsRef) 393 394 Unassign each of the given sets from each of the given users. 395 396 =cut 397 398 sub unassignSetsFromUsers { 399 my ($self, $setIDsRef, $userIDsRef) = @_; 400 my @setIDs = $setIDsRef; 401 my @userIDs = $userIDsRef; 402 403 foreach my $setID (@setIDs) { 404 foreach my $userID (@userIDs) { 405 $self->unassignSetFromUser($userID, $setID); 406 } 407 } 408 } 409 410 =item assignProblemToAllSetUsers($GlobalProblem) 411 412 Assigns the problem specified to all users to whom the problem's set is 413 assigned. If any assignments fail, a list of failure messages is returned. 414 415 =cut 416 417 sub assignProblemToAllSetUsers { 418 my ($self, $GlobalProblem) = @_; 419 my $db = $self->{db}; 420 my $setID = $GlobalProblem->set_id; 421 my @userIDs = $db->listSetUsers($setID); 422 423 my @results; 424 425 foreach my $userID (@userIDs) { 426 my @result = $self->assignProblemToUser($userID, $GlobalProblem); 427 push @results, @result if @result; 428 } 429 430 return @results; 431 } 432 433 =back 434 435 =cut 436 437 ################################################################################ 438 # Utility method for adding problems to a set 439 ################################################################################ 440 441 =head2 Utility method for adding problems to a set 442 443 =over 444 445 =cut 446 447 sub addProblemToSet { 448 my ($self, %args) = @_; 449 my $db = $self->r->db; 450 451 die "addProblemToSet called without specifying the set name." if $args{setName} eq ""; 452 my $setName = $args{setName}; 453 454 my $sourceFile = $args{sourceFile} or 455 die "addProblemToSet called without specifying the sourceFile."; 456 457 # The rest of the arguments are optional 458 my $value = $args{value} || 1; 459 my $maxAttempts = $args{maxAttempts} || -1; 460 my $problemID = $args{problemID}; 461 462 unless ($problemID) { 463 $problemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; 464 } 465 466 my $problemRecord = $db->newGlobalProblem; 467 $problemRecord->problem_id($problemID); 468 $problemRecord->set_id($setName); 469 $problemRecord->source_file($sourceFile); 470 $problemRecord->value($value); 471 $problemRecord->max_attempts($maxAttempts); 472 $db->addGlobalProblem($problemRecord); 473 474 return $problemRecord; 475 } 476 477 ################################################################################ 478 # Utility methods 479 ################################################################################ 480 481 =head2 Utility methods 482 483 =over 484 485 =cut 486 487 sub hiddenEditForUserFields { 488 my ($self, @editForUser) = @_; 489 my $return = ""; 490 foreach my $editUser (@editForUser) { 491 $return .= CGI::input({type=>"hidden", name=>"editForUser", value=>$editUser}); 492 } 493 494 return $return; 495 } 496 497 sub userCountMessage { 498 my ($self, $count, $numUsers) = @_; 499 500 my $message; 501 if ($count == 0) { 502 $message = CGI::em("no users"); 503 } elsif ($count == $numUsers) { 504 $message = "all users"; 505 } elsif ($count == 1) { 506 $message = "1 user"; 507 } elsif ($count > $numUsers || $count < 0) { 508 $message = CGI::em("an impossible number of users: $count out of $numUsers"); 509 } else { 510 $message = "$count users"; 511 } 512 513 return $message; 514 } 515 516 sub read_dir { # read a directory 517 my $self = shift; 518 my $directory = shift; 519 my $pattern = shift; 520 my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); 521 return sort @files; 522 } 523 524 sub read_scoring_file { # used in SendMail and ....? 525 my $self = shift; 526 my $fileName = shift; 527 my $delimiter = shift; 528 $delimiter = ',' unless defined($delimiter); 529 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; 530 my $filePath = "$scoringDirectory/$fileName"; 531 # Takes a delimited file as a parameter and returns an 532 # associative array with the first field as the key. 533 # Blank lines are skipped. White space is removed 534 my(@dbArray,$key,$dbString); 535 my %assocArray = (); 536 local(*FILE); 537 if ($fileName eq 'None') { 538 # do nothing 539 } elsif ( open(FILE, "$filePath") ) { 540 my $index=0; 541 while (<FILE>){ 542 unless ($_ =~ /\S/) {next;} ## skip blank lines 543 chomp; 544 @{$dbArray[$index]} =$self->getRecord($_,$delimiter); 545 $key =$dbArray[$index][0]; 546 $assocArray{$key}=$dbArray[$index]; 547 $index++; 548 } 549 close(FILE); 550 } else { 551 warn "Couldn't read file $filePath"; 552 } 553 return \%assocArray; 554 } 555 556 =back 557 558 =cut 559 560 ################################################################################ 561 # Methods for listing various types of files 562 ################################################################################ 563 564 =head2 Methods for listing various types of files 565 566 =over 567 568 =cut 569 570 # list classlist files 571 sub getCSVList { 572 my ($self) = @_; 573 my $ce = $self->{ce}; 574 my $dir = $ce->{courseDirs}->{templates}; 575 return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir); 576 } 577 578 sub getDefList { 579 my ($self) = @_; 580 my $ce = $self->{ce}; 581 my $dir = $ce->{courseDirs}->{templates}; 582 return $self->read_dir($dir, qr/.*\.def/); 583 } 584 585 sub getScoringFileList { 586 my ($self) = @_; 587 my $ce = $self->{ce}; 588 my $dir = $ce->{courseDirs}->{scoring}; 589 return $self->read_dir($dir, qr/.*\.csv/); 590 } 591 592 =back 593 594 =cut 595 596 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |