Parent Directory
| 
Revision Log
fixed incorrect error message parsing by Instructor/Index.pm
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.43 2004/01/25 19:56:09 gage 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; 18 19 =head1 NAME 20 21 WeBWorK - Dispatch requests to the appropriate content generator. 22 23 =head1 SYNOPSIS 24 25 my $r = Apache->request; 26 my $result = eval { WeBWorK::dispatch($r) }; 27 die "something bad happened: $@" if $@; 28 29 =head1 DESCRIPTION 30 31 C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request 32 object, it performs authentication and determines which subclass of 33 C<WeBWorK::ContentGenerator> to call. 34 35 =head1 REQUEST FORMAT 36 37 FIXME: write this part 38 summary: the URI controls 39 40 =cut 41 42 BEGIN { $main::VERSION = "2.0"; } 43 44 45 my $timingON = 1; 46 47 use strict; 48 use warnings; 49 use Apache::Constants qw(:common REDIRECT DONE); 50 use Apache::Request; 51 use WeBWorK::Authen; 52 use WeBWorK::Authz; 53 use WeBWorK::CourseEnvironment; 54 use WeBWorK::DB; 55 use WeBWorK::Timing; 56 use WeBWorK::Upload; 57 use WeBWorK::Utils qw(runtime_use); 58 59 =head1 THE C<&dispatch> FUNCTION 60 61 The C<&dispatch> function takes an Apache request object (REQUEST) and returns 62 an apache status code. Below is an overview of its operation: 63 64 =over 65 66 =cut 67 68 sub dispatch($) { 69 my ($apache) = @_; 70 my $r = Apache::Request->new($apache); 71 # have to deal with unpredictable GET or POST data, and sift 72 # through it for the key. So use Apache::Request 73 74 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 75 # It's for figuring out the basepath. I may change this up if I find a 76 # better way to do it. 77 my $path_info = $r->path_info || ""; 78 $path_info =~ s!/+!/!g; # strip multiple forward slashes 79 my $current_uri = $r->uri; 80 my $args = $r->args; 81 82 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; 83 84 =item Ensure that the URI ends with a "/" 85 86 Parts of WeBWorK assume that the current URI of a request ends with a "/". If 87 this is not the case, a redirection is issued to add the "/". This action will 88 discard any POST data associated with the request, so it is essential that all 89 POST requests include a "/" at the end of the URI. 90 91 =cut 92 93 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 94 # alllll over the place. 95 unless (substr($current_uri,-1) eq '/') { 96 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 97 return REDIRECT; 98 # *** any post data gets lost here -- fix that. 99 # (actually, it's not a problem, since all URLs generated 100 # from within the system have trailing slashes, and we don't 101 # need POST data from outside the system anyway!) 102 } 103 104 # Create the @components array, which contains the path specified in the URL 105 my($junk, @components) = split "/", $path_info; 106 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 107 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf 108 my $course = shift @components; 109 110 =item Read the course environment 111 112 C<WeBWorK::CourseEnvironment> is used to read the F<global.conf> configuration 113 file. If a course name was given in the request's URI, it is passed to 114 C<WeBWorK::CourseEnvironment>. In this case, the course-specific configuration 115 file (usually F<course.conf>) is also read by C<WeBWorK::CourseEnvironment> at 116 this point. 117 118 See also L<WeBWorK::CourseEnvironment>. 119 120 =cut 121 122 # Try to get the course environment. 123 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);}; 124 if ($@) { # If there was an error getting the requested course 125 die "Failed to read course environment for $course: $@"; 126 } 127 128 =item If no course was given, go to the site home page 129 130 If the URI did not include the name of a course, a redirection is issued to the 131 site home page, given but the course environemnt variable 132 C<$ce-E<gt>{webworkURLs}-E<gt>{home}>. 133 134 =cut 135 136 # If no course was specified, redirect to the home URL 137 unless (defined $course) { 138 $r->header_out(Location => $ce->{webworkURLs}->{home}); 139 return REDIRECT; 140 } 141 142 =item If the given course does not exist, fail 143 144 If the URI did include the name of a course, but the course directory was not 145 found, an exception is thrown. 146 147 =cut 148 149 # Freak out if the requested course doesn't exist. For now, this is just a 150 # check to see if the course directory exists. 151 my $courseDir = $ce->{webworkDirs}->{courses} . "/$course"; 152 unless (-e $courseDir) { 153 die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?"; 154 } 155 156 =item Initialize the database system 157 158 A C<WeBWorK::DB> object is created from the current course environment. 159 160 See also L<WeBWorK::DB>. 161 162 =cut 163 164 # Bring up a connection to the database (for Authen/Authz, and eventually 165 # to be passed to content generators, when we clean this file up). 166 my $db = WeBWorK::DB->new($ce->{dbLayout}); 167 168 =item Capture any uploads 169 170 Before checking authentication, we store any uploads sent by the client 171 and replace them with parameters referencing the stored uploads. 172 173 =cut 174 175 my @uploads = $r->upload; 176 foreach my $u (@uploads) { 177 # make sure it's a "real" upload 178 next unless $u->filename; 179 180 # store the upload 181 my $upload = WeBWorK::Upload->store($u, 182 dir => $ce->{webworkDirs}->{uploadCache} 183 ); 184 185 # store the upload ID and hash in the file upload field 186 my $id = $upload->id; 187 my $hash = $upload->hash; 188 $r->param($u->name => "$id $hash"); 189 } 190 191 =item Check authentication 192 193 Use C<WeBWorK::Authen> to verify that the remote user has authenticated. 194 195 See also L<WeBWorK::Authen>. 196 197 =cut 198 199 ### Begin dispatching ### 200 201 my $contentGenerator = ""; 202 my @arguments = (); 203 204 # WeBWorK::Authen::verify erases the passwd field and sets the key field 205 # if login is successful. 206 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { 207 $contentGenerator = "WeBWorK::ContentGenerator::Login"; 208 @arguments = (); 209 } 210 else { 211 212 =item Determine if the user is allowed to set C<effectiveUser> 213 214 Use C<WeBWorK::Authz> to determine if the user is allowed to set 215 C<effectiveUser>. If so, set it to the requested value (or set it to the real 216 user name if no value is supplied). If not, set it to the real user name. 217 218 See also L<WeBWorK::Authz>. 219 220 =cut 221 222 # After we are authenticated, there are some things that need to be 223 # sorted out, Authorization-wize, before we start dispatching to individual 224 # content generators. 225 my $user = $r->param("user"); 226 my $effectiveUser = $r->param("effectiveUser") || $user; 227 my $authz = WeBWorK::Authz->new($r, $ce, $db); 228 my $su_authorized = $authz->hasPermissions($user, "become_student", $effectiveUser); 229 $effectiveUser = $user unless $su_authorized; 230 $r->param("effectiveUser", $effectiveUser); 231 232 =item Determine the appropriate subclass of C<WeBWorK::ContentGenerator> to call based on the URI. 233 234 The dispatcher implements a virtual heirarchy that looks like this: 235 236 $courseID ($courseID) - list of sets 237 hardcopy (Hardcopy Generator) - generate hardcopy for user/set pairs 238 options (User Options) - change email address and password 239 feedback (Feedback) - send feedback to professor via email 240 logout (Logout) - expire session and erase authentication tokens 241 test (Test) - display request information 242 quiz_mode (Quiz) - "quiz" containing all problems from a set 243 instructor (Instructor Tools) - main menu for instructor tools 244 add_users (Add Users) - to be removed 245 scoring (Scoring Tools) - generate scoring files for problem sets 246 scoringDownload - send a scoring file to the client 247 scoring_totals - ??? 248 users (Users) - view/edit users 249 $userID ($userID) - user detail for given user 250 sets (Assigned Sets) - view/edit sets assigned to given user 251 sets (Sets) - list of sets, add new sets, delete existing sets 252 $setID - view/edit the given set 253 problems (Problems) - view/edit problems in the given set 254 $problemID - this is where the pg problem editor SHOULD be 255 users (Users Assigned) - view/edit users to whom the given set is assigned 256 pgProblemEditor (Problem Source) - edit the source of a problem 257 send_mail (Mail Merge) - send mail to users in course 258 show_answers (Answers Submitted) - show submitted answers 259 stats (Statistics) - show statistics 260 files (File Transfer) - transfer files to/from the client 261 $setID ($setID) - list of problems in the given set 262 $problemID ($problemID) - interactive display of problem 263 264 =cut 265 266 my $arg = shift @components; 267 if (not defined $arg) { # We want the list of problem sets 268 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSets"; 269 @arguments = (); 270 } 271 elsif ($arg eq "hardcopy") { 272 my $setID = shift @components; 273 $contentGenerator = "WeBWorK::ContentGenerator::Hardcopy"; 274 @arguments = ($setID); 275 } 276 elsif ($arg eq "options") { 277 $contentGenerator = "WeBWorK::ContentGenerator::Options"; 278 @arguments = (); 279 } 280 elsif ($arg eq "feedback") { 281 $contentGenerator = "WeBWorK::ContentGenerator::Feedback"; 282 @arguments = (); 283 } 284 elsif ($arg eq "logout") { 285 $contentGenerator = "WeBWorK::ContentGenerator::Logout"; 286 @arguments = (); 287 } 288 elsif ($arg eq "test") { 289 $contentGenerator = "WeBWorK::ContentGenerator::Test"; 290 @arguments = (); 291 } 292 elsif ($arg eq "quiz_mode" ) { 293 $contentGenerator = "WeBWorK::ContentGenerator::GatewayQuiz"; 294 @arguments = @components; 295 } 296 elsif ($arg eq "equation" ) { 297 $contentGenerator = "WeBWorK::ContentGenerator::EquationDisplay"; 298 @arguments = @components; 299 } 300 elsif ($arg eq "instructor") { 301 my $instructorArgument = shift @components; 302 303 if (not defined $instructorArgument) { 304 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Index"; 305 @arguments = (); 306 } 307 elsif ($instructorArgument eq "add_users") { 308 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::AddUsers"; 309 @arguments = (); 310 } 311 elsif ($instructorArgument eq "assigner") { 312 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Assigner"; 313 @arguments = (); 314 } 315 elsif ($instructorArgument eq "scoring") { 316 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Scoring"; 317 @arguments = (); 318 } 319 # elsif ($instructorArgument eq "scoring_totals") { 320 # $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringTotals"; 321 # @arguments = (); 322 # } 323 elsif ($instructorArgument eq "scoringDownload") { 324 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringDownload"; 325 @arguments = (); 326 } 327 elsif ($instructorArgument eq "users") { 328 my $userID = shift @components; 329 330 if (defined $userID) { 331 my $userArg = shift @components; 332 if (defined $userArg) { 333 if ($userArg eq "sets") { 334 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SetsAssignedToUser"; 335 @arguments = ($userID); 336 } 337 } 338 else { 339 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserDetail"; 340 @arguments = ($userID); 341 } 342 } 343 else { 344 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserList"; 345 @arguments = (); 346 } 347 } 348 elsif ($instructorArgument eq "sets") { 349 my $setID = shift @components; 350 351 if (defined $setID) { 352 my $setArg = shift @components; 353 354 if (defined $setArg) { 355 if ($setArg eq "problems") { 356 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemList"; 357 @arguments = ($setID); 358 } 359 elsif ($setArg eq "users") { 360 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet"; 361 @arguments = ($setID); 362 } 363 } 364 else { 365 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetEditor"; 366 @arguments = ($setID); 367 } 368 } 369 else { 370 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetList"; 371 @arguments = (); 372 373 } 374 } 375 elsif ($instructorArgument eq "pgProblemEditor") { 376 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::PGProblemEditor"; 377 @arguments = @components; 378 } 379 elsif ($instructorArgument eq "send_mail") { 380 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SendMail"; 381 @arguments = @components; 382 } 383 elsif ($instructorArgument eq "show_answers") { 384 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ShowAnswers"; 385 @arguments = @components; 386 } 387 elsif ($instructorArgument eq "stats") { 388 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Stats"; 389 @arguments = @components; 390 } 391 elsif ($instructorArgument eq "files") { 392 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::FileXfer"; 393 @arguments = @components; 394 } 395 } 396 else { 397 # $arg is a set ID 398 my $setID = $arg; 399 my $problemID = shift @components; 400 401 # check that the set is valid 402 if (grep /$setID/, $db->listUserSets($effectiveUser)) { 403 if (defined $problemID) { 404 # check that the problem is valid for this set 405 if (grep /$problemID/, $db->listUserProblems($effectiveUser, $setID)) { 406 $contentGenerator = "WeBWorK::ContentGenerator::Problem"; 407 @arguments = ($setID, $problemID); 408 } 409 else { 410 $contentGenerator = "WeBWorK::ContentGenerator::Error"; 411 @arguments = ($setID, "$problemID (error)", "Problem $problemID is not a valid problem in set $setID", "The problem number ($problemID) entered in the URL in your web browser does not seem to be a valid problem for the current set ($setID). Please check to make sure that the problem number was entered correctly. If you believe this error was generated mistakenly, please report it to your professor. You can view a list of sets by clicking on the link \"Problem Sets\" on the left."); 412 } 413 } 414 else { 415 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSet"; 416 @arguments = ($setID); 417 } 418 419 } 420 else { 421 $contentGenerator = "WeBWorK::ContentGenerator::Error"; 422 @arguments = ("$setID (error)", "$problemID (error)", "$setID is not a valid set for user $user", "The set ($setID) entered in the URL in your web browser does not seem to be a valid set for the current user. Please check to make sure that the set was entered correctly. If you believe this error was generated mistakenly, please report it to your professor."); 423 } 424 425 } 426 } 427 428 =item Call the selected content generator 429 430 Instantiate the selected subclass of content generator and call its C<&go> method. Store the result. 431 432 =cut 433 434 my $result; 435 if ($contentGenerator) { 436 runtime_use($contentGenerator); 437 my $cg = $contentGenerator->new($r, $ce, $db); 438 @arguments = () unless @arguments; 439 $WeBWorK::timer = WeBWorK::Timing->new("${contentGenerator}::go(@arguments)") if $timingON == 1; 440 $WeBWorK::timer->start if $timingON == 1; 441 442 $result = $cg->go(@arguments); 443 444 $WeBWorK::timer->stop if $timingON == 1; 445 $WeBWorK::timer->save if $timingON == 1; 446 } else { 447 $result = NOT_FOUND; 448 } 449 450 =item Return the result of calling the content generator 451 452 The return value of the content generator's C<&go> function is returned. 453 454 =cut 455 456 return $result; 457 } 458 459 =back 460 461 =head1 AUTHOR 462 463 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 464 Hathaway, sh002i at math.rochester.edu. 465 466 =cut 467 468 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |