Parent Directory
| 
Revision Log
added support for upload/download/delete of scoring files
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.37 2004/03/23 01:10:14 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(); 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 =item unassignSetFromUser($userID, $setID, $problemID) 84 85 Unassigns the given set and all problems therein from the given user. 86 87 =cut 88 89 sub unassignSetFromUser { 90 my ($self, $userID, $setID) = @_; 91 my $db = $self->{db}; 92 93 $db->deleteUserSet($userID, $setID); 94 } 95 96 =item assignProblemToUser($userID, $GlobalProblem) 97 98 Assigns the given problem to the given user. If the problem is already assigned 99 to the user, an error string is returned. 100 101 =cut 102 103 sub assignProblemToUser { 104 my ($self, $userID, $GlobalProblem) = @_; 105 my $db = $self->{db}; 106 107 my $UserProblem = $db->newUserProblem; 108 $UserProblem->user_id($userID); 109 $UserProblem->set_id($GlobalProblem->set_id); 110 $UserProblem->problem_id($GlobalProblem->problem_id); 111 initializeUserProblem($UserProblem); 112 113 eval { $db->addUserProblem($UserProblem) }; 114 if ($@) { 115 if ($@ =~ m/user problem exists/) { 116 return "problem " . $GlobalProblem->problem_id 117 . " in set " . $GlobalProblem->set_id 118 . " is already assigned to user $userID."; 119 } else { 120 die $@; 121 } 122 } 123 124 return (); 125 } 126 127 =item unassignProblemFromUser($userID, $setID, $problemID) 128 129 Unassigns the given problem from the given user. 130 131 =cut 132 133 sub unassignProblemFromUser { 134 my ($self, $userID, $setID, $problemID) = @_; 135 my $db = $self->{db}; 136 137 $db->deleteUserProblem($userID, $setID, $problemID); 138 } 139 140 =back 141 142 =cut 143 144 ################################################################################ 145 # Secondary set assignment methods 146 ################################################################################ 147 148 =head2 Secondary assignment methods 149 150 =over 151 152 =item assignSetToAllUsers($setID) 153 154 Assigns the set specified and all problems contained therein to all users in 155 the course. This is more efficient than repeatedly calling assignSetToUser(). 156 If any assignments fail, a list of failure messages is returned. 157 158 =cut 159 160 sub assignSetToAllUsers { 161 my ($self, $setID) = @_; 162 my $db = $self->{db}; 163 164 my @userIDs = $db->listUsers; 165 $WeBWorK::timer->continue("$setID: getting problem list") if defined $WeBWorK::timer; 166 my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); 167 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 168 169 my @results; 170 171 foreach my $userID (@userIDs) { 172 my $UserSet = $db->newUserSet; 173 $UserSet->user_id($userID); 174 $UserSet->set_id($setID); 175 $WeBWorK::timer->continue("$setID: adding UserSet for $userID") if defined $WeBWorK::timer; 176 eval { $db->addUserSet($UserSet) }; 177 if ($@) { 178 next if $@ =~ m/user set exists/; 179 die $@; 180 } 181 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 182 183 $WeBWorK::timer->continue("$setID: adding UserProblems for $userID") if defined $WeBWorK::timer; 184 foreach my $GlobalProblem (@GlobalProblems) { 185 my @result = $self->assignProblemToUser($userID, $GlobalProblem); 186 push @results, @result if @result; 187 } 188 $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWorK::timer; 189 } 190 191 return @results; 192 } 193 194 =item unassignSetFromAllUsers($setID) 195 196 Unassigns the specified sets and all problems contained therein from all users. 197 198 =cut 199 200 sub unassignSetFromAllUsers { 201 my ($self, $setID) = @_; 202 my $db = $self->{db}; 203 204 my @userIDs = $db->listSetUsers($setID); 205 206 foreach my $userID (@userIDs) { 207 $self->unassignSetFromUser($userID, $setID); 208 } 209 } 210 211 =item assignAllSetsToUser($userID) 212 213 Assigns all sets in the course and all problems contained therein to the 214 specified user. This is more efficient than repeatedly calling 215 assignSetToUser(). If any assignments fail, a list of failure messages is 216 returned. 217 218 =cut 219 220 sub assignAllSetsToUser { 221 my ($self, $userID) = @_; 222 my $db = $self->{db}; 223 224 # assign only sets that are not already assigned 225 #my %userSetIDs = map { $_ => 1 } $db->listUserSets($userID); 226 #my @globalSetIDs = grep { not exists $userSetIDs{$_} } $db->listGlobalSets; 227 #my @GlobalSets = $db->getGlobalSets(@globalSetIDs); 228 # FIXME: i don't think we need to do the above, since asignSetToUser fails 229 # silently if a UserSet already exists. instead we do this: 230 my @globalSetIDs = $db->listGlobalSets; 231 my @GlobalSets = $db->getGlobalSets(@globalSetIDs); 232 233 my @results; 234 235 my $i = 0; 236 foreach my $GlobalSet (@GlobalSets) { 237 if (not defined $GlobalSet) { 238 warn "record not found for global set $globalSetIDs[$i]"; 239 } else { 240 my @result = $self->assignSetToUser($userID, $GlobalSet); 241 push @results, @result if @result; 242 } 243 $i++; 244 } 245 246 return @results; 247 } 248 249 =item unassignAllSetsFromUser($userID) 250 251 Unassigns all sets and all problems contained therein from the specified user. 252 253 =cut 254 255 sub unassignAllSetsFromUser { 256 my ($self, $userID) = @_; 257 my $db = $self->{db}; 258 259 my @setIDs = $db->listUserSets($userID); 260 261 foreach my $setID (@setIDs) { 262 $self->unassignSetFromUser($userID, $setID); 263 } 264 } 265 266 =back 267 268 =cut 269 270 ################################################################################ 271 # Utility assignment methods 272 ################################################################################ 273 274 =head2 Utility assignment methods 275 276 =over 277 278 =item assignSetsToUsers($setIDsRef, $userIDsRef) 279 280 Assign each of the given sets to each of the given users. If any assignments 281 fail, a list of failure messages is returned. 282 283 =cut 284 285 sub assignSetsToUsers { 286 my ($self, $setIDsRef, $userIDsRef) = @_; 287 my $db = $self->{db}; 288 289 my @setIDs = @$setIDsRef; 290 my @userIDs = @$userIDsRef; 291 my @GlobalSets = $db->getGlobalSets(@setIDs); 292 293 my @results; 294 295 foreach my $GlobalSet (@GlobalSets) { 296 foreach my $userID (@userIDs) { 297 my @result = $self->assignSetToUser($userID, $GlobalSet); 298 push @results, @result if @result; 299 } 300 } 301 302 return @results; 303 } 304 305 =item unassignSetsFromUsers($setIDsRef, $userIDsRef) 306 307 Unassign each of the given sets from each of the given users. 308 309 =cut 310 311 sub unassignSetsFromUsers { 312 my ($self, $setIDsRef, $userIDsRef) = @_; 313 my @setIDs = $setIDsRef; 314 my @userIDs = $userIDsRef; 315 316 foreach my $setID (@setIDs) { 317 foreach my $userID (@userIDs) { 318 $self->unassignSetFromUser($userID, $setID); 319 } 320 } 321 } 322 323 =item assignProblemToAllSetUsers($GlobalProblem) 324 325 Assigns the problem specified to all users to whom the problem's set is 326 assigned. If any assignments fail, a list of failure messages is returned. 327 328 =cut 329 330 sub assignProblemToAllSetUsers { 331 my ($self, $GlobalProblem) = @_; 332 my $db = $self->{db}; 333 my $setID = $GlobalProblem->set_id; 334 my @userIDs = $db->listSetUsers($setID); 335 336 my @results; 337 338 foreach my $userID (@userIDs) { 339 my @result = $self->assignProblemToUser($userID, $GlobalProblem); 340 push @results, @result if @result; 341 } 342 343 return @results; 344 } 345 346 =back 347 348 =cut 349 350 ################################################################################ 351 # Utility methods 352 ################################################################################ 353 354 =head2 Utility methods 355 356 =over 357 358 =cut 359 360 sub hiddenEditForUserFields { 361 my ($self, @editForUser) = @_; 362 my $return = ""; 363 foreach my $editUser (@editForUser) { 364 $return .= CGI::input({type=>"hidden", name=>"editForUser", value=>$editUser}); 365 } 366 367 return $return; 368 } 369 370 sub userCountMessage { 371 my ($self, $count, $numUsers) = @_; 372 373 my $message; 374 if ($count == 0) { 375 $message = CGI::em("no users"); 376 } elsif ($count == $numUsers) { 377 $message = "all users"; 378 } elsif ($count == 1) { 379 $message = "1 user"; 380 } elsif ($count > $numUsers || $count < 0) { 381 $message = CGI::em("an impossible number of users: $count out of $numUsers"); 382 } else { 383 $message = "$count users"; 384 } 385 386 return $message; 387 } 388 389 sub read_dir { # read a directory 390 my $self = shift; 391 my $directory = shift; 392 my $pattern = shift; 393 my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); 394 return sort @files; 395 } 396 397 sub read_scoring_file { # used in SendMail and ....? 398 my $self = shift; 399 my $fileName = shift; 400 my $delimiter = shift; 401 $delimiter = ',' unless defined($delimiter); 402 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; 403 my $filePath = "$scoringDirectory/$fileName"; 404 # Takes a delimited file as a parameter and returns an 405 # associative array with the first field as the key. 406 # Blank lines are skipped. White space is removed 407 my(@dbArray,$key,$dbString); 408 my %assocArray = (); 409 local(*FILE); 410 if ($fileName eq 'None') { 411 # do nothing 412 } elsif ( open(FILE, "$filePath") ) { 413 my $index=0; 414 while (<FILE>){ 415 unless ($_ =~ /\S/) {next;} ## skip blank lines 416 chomp; 417 @{$dbArray[$index]} =$self->getRecord($_,$delimiter); 418 $key =$dbArray[$index][0]; 419 $assocArray{$key}=$dbArray[$index]; 420 $index++; 421 } 422 close(FILE); 423 } else { 424 warn "Couldn't read file $filePath"; 425 } 426 return \%assocArray; 427 } 428 429 =back 430 431 =cut 432 433 ################################################################################ 434 # Methods for listing various types of files 435 ################################################################################ 436 437 =head2 Methods for listing various types of files 438 439 =over 440 441 =cut 442 443 # list classlist files 444 sub getCSVList { 445 my ($self) = @_; 446 my $ce = $self->{ce}; 447 my $dir = $ce->{courseDirs}->{templates}; 448 return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir); 449 } 450 451 sub getDefList { 452 my ($self) = @_; 453 my $ce = $self->{ce}; 454 my $dir = $ce->{courseDirs}->{templates}; 455 return $self->read_dir($dir, qr/.*\.def/); 456 } 457 458 sub getScoringFileList { 459 my ($self) = @_; 460 my $ce = $self->{ce}; 461 my $dir = $ce->{courseDirs}->{scoring}; 462 return $self->read_dir($dir, qr/.*\.csv/); 463 } 464 465 =back 466 467 =cut 468 469 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |