Parent Directory
| 
Revision Log
Changed parameter calls to Error.pm, now sent using $r
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.48 2004/02/14 00:54:56 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; 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, load the Home ContentGenerator 129 130 If the URI did not include the name of a course, we load the Home 131 ContentGenerator. 132 133 =cut 134 135 # If no course was specified, we 136 unless (defined $course) { 137 my $contentGenerator = "WeBWorK::ContentGenerator::Home"; 138 139 runtime_use($contentGenerator); 140 my $cg = $contentGenerator->new($r, $ce, undef); 141 my $result = $cg->go(); 142 return $result; 143 } 144 145 =item If the given course does not exist, fail 146 147 If the URI did include the name of a course, but the course directory was not 148 found, an exception is thrown. 149 150 =cut 151 152 # Freak out if the requested course doesn't exist. For now, this is just a 153 # check to see if the course directory exists. 154 my $courseDir = $ce->{webworkDirs}->{courses} . "/$course"; 155 unless (-e $courseDir) { 156 die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?"; 157 } 158 159 =item Initialize the database system 160 161 A C<WeBWorK::DB> object is created from the current course environment. 162 163 See also L<WeBWorK::DB>. 164 165 =cut 166 167 # Bring up a connection to the database (for Authen/Authz, and eventually 168 # to be passed to content generators, when we clean this file up). 169 my $db = WeBWorK::DB->new($ce->{dbLayout}); 170 171 =item Capture any uploads 172 173 Before checking authentication, we store any uploads sent by the client 174 and replace them with parameters referencing the stored uploads. 175 176 =cut 177 178 my @uploads = $r->upload; 179 foreach my $u (@uploads) { 180 # make sure it's a "real" upload 181 next unless $u->filename; 182 183 # store the upload 184 my $upload = WeBWorK::Upload->store($u, 185 dir => $ce->{webworkDirs}->{uploadCache} 186 ); 187 188 # store the upload ID and hash in the file upload field 189 my $id = $upload->id; 190 my $hash = $upload->hash; 191 $r->param($u->name => "$id $hash"); 192 } 193 194 =item Check authentication 195 196 Use C<WeBWorK::Authen> to verify that the remote user has authenticated. 197 198 See also L<WeBWorK::Authen>. 199 200 =cut 201 202 ### Begin dispatching ### 203 204 my $contentGenerator = ""; 205 my @arguments = (); 206 207 # WeBWorK::Authen::verify erases the passwd field and sets the key field 208 # if login is successful. 209 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { 210 $contentGenerator = "WeBWorK::ContentGenerator::Login"; 211 @arguments = (); 212 } 213 else { 214 215 =item Determine if the user is allowed to set C<effectiveUser> 216 217 Use C<WeBWorK::Authz> to determine if the user is allowed to set 218 C<effectiveUser>. If so, set it to the requested value (or set it to the real 219 user name if no value is supplied). If not, set it to the real user name. 220 221 See also L<WeBWorK::Authz>. 222 223 =cut 224 225 # After we are authenticated, there are some things that need to be 226 # sorted out, Authorization-wize, before we start dispatching to individual 227 # content generators. 228 my $user = $r->param("user"); 229 my $effectiveUser = $r->param("effectiveUser") || $user; 230 my $authz = WeBWorK::Authz->new($r, $ce, $db); 231 my $su_authorized = $authz->hasPermissions($user, "become_student", $effectiveUser); 232 $effectiveUser = $user unless $su_authorized; 233 $r->param("effectiveUser", $effectiveUser); 234 235 =item Determine the appropriate subclass of C<WeBWorK::ContentGenerator> to call based on the URI. 236 237 The dispatcher implements a virtual heirarchy that looks like this: 238 239 $courseID ($courseID) - list of sets 240 hardcopy (Hardcopy Generator) - generate hardcopy for user/set pairs 241 options (User Options) - change email address and password 242 feedback (Feedback) - send feedback to professor via email 243 logout (Logout) - expire session and erase authentication tokens 244 test (Test) - display request information 245 quiz_mode (Quiz) - "quiz" containing all problems from a set 246 instructor (Instructor Tools) - main menu for instructor tools 247 add_users (Add Users) - to be removed 248 scoring (Scoring Tools) - generate scoring files for problem sets 249 scoringDownload - send a scoring file to the client 250 scoring_totals - ??? 251 users (Users) - view/edit users 252 $userID ($userID) - user detail for given user 253 sets (Assigned Sets) - view/edit sets assigned to given user 254 sets (Sets) - list of sets, add new sets, delete existing sets 255 $setID - view/edit the given set 256 problems (Problems) - view/edit problems in the given set 257 $problemID - this is where the pg problem editor SHOULD be 258 users (Users Assigned) - view/edit users to whom the given set is assigned 259 pgProblemEditor (Problem Source) - edit the source of a problem 260 send_mail (Mail Merge) - send mail to users in course 261 show_answers (Answers Submitted) - show submitted answers 262 stats (Statistics) - show statistics 263 files (File Transfer) - transfer files to/from the client 264 $setID ($setID) - list of problems in the given set 265 $problemID ($problemID) - interactive display of problem 266 267 =cut 268 269 my $arg = shift @components; 270 if (not defined $arg) { # We want the list of problem sets 271 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSets"; 272 @arguments = (); 273 } 274 elsif ($arg eq "hardcopy") { 275 my $setID = shift @components; 276 $contentGenerator = "WeBWorK::ContentGenerator::Hardcopy"; 277 @arguments = ($setID); 278 } 279 elsif ($arg eq "options") { 280 $contentGenerator = "WeBWorK::ContentGenerator::Options"; 281 @arguments = (); 282 } 283 elsif ($arg eq "feedback") { 284 $contentGenerator = "WeBWorK::ContentGenerator::Feedback"; 285 @arguments = (); 286 } 287 elsif ($arg eq "logout") { 288 $contentGenerator = "WeBWorK::ContentGenerator::Logout"; 289 @arguments = (); 290 } 291 elsif ($arg eq "test") { 292 $contentGenerator = "WeBWorK::ContentGenerator::Test"; 293 @arguments = (); 294 } 295 elsif ($arg eq "quiz_mode" ) { 296 $contentGenerator = "WeBWorK::ContentGenerator::GatewayQuiz"; 297 @arguments = @components; 298 } 299 elsif ($arg eq "equation" ) { 300 $contentGenerator = "WeBWorK::ContentGenerator::EquationDisplay"; 301 @arguments = @components; 302 } 303 elsif ($arg eq "instructor") { 304 my $instructorArgument = shift @components; 305 306 if (not defined $instructorArgument) { 307 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Index"; 308 @arguments = (); 309 } 310 elsif ($instructorArgument eq "add_users") { 311 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::AddUsers"; 312 @arguments = (); 313 } 314 elsif ($instructorArgument eq "assigner") { 315 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Assigner"; 316 @arguments = (); 317 } 318 elsif ($instructorArgument eq "scoring") { 319 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Scoring"; 320 @arguments = (); 321 } 322 # elsif ($instructorArgument eq "scoring_totals") { 323 # $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringTotals"; 324 # @arguments = (); 325 # } 326 elsif ($instructorArgument eq "scoringDownload") { 327 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringDownload"; 328 @arguments = (); 329 } 330 elsif ($instructorArgument eq "users") { 331 my $userID = shift @components; 332 333 if (defined $userID) { 334 my $userArg = shift @components; 335 if (defined $userArg) { 336 if ($userArg eq "sets") { 337 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SetsAssignedToUser"; 338 @arguments = ($userID); 339 } 340 } 341 else { 342 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserDetail"; 343 @arguments = ($userID); 344 } 345 } 346 else { 347 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserList"; 348 @arguments = (); 349 } 350 } 351 elsif ($instructorArgument eq "sets") { 352 my $setID = shift @components; 353 354 if (defined $setID) { 355 my $setArg = shift @components; 356 357 if (defined $setArg) { 358 if ($setArg eq "problems") { 359 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemList"; 360 @arguments = ($setID); 361 } 362 elsif ($setArg eq "users") { 363 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet"; 364 @arguments = ($setID); 365 } 366 } 367 else { 368 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetEditor"; 369 @arguments = ($setID); 370 } 371 } 372 else { 373 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetList"; 374 @arguments = (); 375 376 } 377 } 378 elsif ($instructorArgument eq "pgProblemEditor") { 379 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::PGProblemEditor"; 380 @arguments = @components; 381 } 382 elsif ($instructorArgument eq "send_mail") { 383 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SendMail"; 384 @arguments = @components; 385 } 386 elsif ($instructorArgument eq "show_answers") { 387 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ShowAnswers"; 388 @arguments = @components; 389 } 390 elsif ($instructorArgument eq "stats") { 391 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Stats"; 392 @arguments = @components; 393 } 394 elsif ($instructorArgument eq "files") { 395 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::FileXfer"; 396 @arguments = @components; 397 } 398 } 399 else { 400 # $arg is a set ID 401 my $setID = $arg; 402 my $problemID = shift @components; 403 404 # check that the set is valid 405 if (grep /$setID/, $db->listUserSets($effectiveUser)) { 406 if (defined $problemID) { 407 # check that the problem is valid for this set 408 if (grep /$problemID/, $db->listUserProblems($effectiveUser, $setID)) { 409 $contentGenerator = "WeBWorK::ContentGenerator::Problem"; 410 @arguments = ($setID, $problemID); 411 } 412 else { 413 $contentGenerator = "WeBWorK::ContentGenerator::Error"; 414 $r->param("set", $setID); 415 $r->param("problem", $problemID); 416 $r->param("error", "Problem $problemID is not a valid problem in set $setID"); 417 $r->param("msg", "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."); 418 @arguments = ($setID); 419 } 420 } 421 else { 422 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSet"; 423 @arguments = ($setID); 424 } 425 426 } 427 else { 428 $contentGenerator = "WeBWorK::ContentGenerator::Error"; 429 $r->param("set", $setID); 430 $r->param("problem", $problemID) if (defined $problemID); 431 $r->param("error", "$setID is not a valid set"); 432 $r->param("msg", "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."); 433 } 434 435 } 436 } 437 438 =item Call the selected content generator 439 440 Instantiate the selected subclass of content generator and call its C<&go> method. Store the result. 441 442 =cut 443 444 my $result; 445 if ($contentGenerator) { 446 runtime_use($contentGenerator); 447 my $cg = $contentGenerator->new($r, $ce, $db); 448 @arguments = () unless @arguments; 449 $WeBWorK::timer = WeBWorK::Timing->new("${contentGenerator}::go(@arguments)") if $timingON == 1; 450 $WeBWorK::timer->start if $timingON == 1; 451 452 $result = $cg->go(@arguments); 453 454 $WeBWorK::timer->stop if $timingON == 1; 455 $WeBWorK::timer->save if $timingON == 1; 456 } else { 457 $result = NOT_FOUND; 458 } 459 460 =item Return the result of calling the content generator 461 462 The return value of the content generator's C<&go> function is returned. 463 464 =cut 465 466 return $result; 467 } 468 469 =back 470 471 =head1 AUTHOR 472 473 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 474 Hathaway, sh002i at math.rochester.edu. 475 476 =cut 477 478 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |