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