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