Parent Directory
| 
Revision Log
Commented out extra brace which kept this from compiling. :-) --Mike
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.45 2004/02/12 04:26:17 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 #$r->path_info($path_info); # store that back into the request object 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->{dbLayout}); 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 "equation" ) { 298 $contentGenerator = "WeBWorK::ContentGenerator::EquationDisplay"; 299 @arguments = @components; 300 } 301 elsif ($arg eq "instructor") { 302 my $instructorArgument = shift @components; 303 304 if (not defined $instructorArgument) { 305 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Index"; 306 @arguments = (); 307 } 308 elsif ($instructorArgument eq "add_users") { 309 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::AddUsers"; 310 @arguments = (); 311 } 312 elsif ($instructorArgument eq "assigner") { 313 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Assigner"; 314 @arguments = (); 315 } 316 elsif ($instructorArgument eq "scoring") { 317 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Scoring"; 318 @arguments = (); 319 } 320 # elsif ($instructorArgument eq "scoring_totals") { 321 # $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringTotals"; 322 # @arguments = (); 323 # } 324 elsif ($instructorArgument eq "scoringDownload") { 325 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringDownload"; 326 @arguments = (); 327 } 328 elsif ($instructorArgument eq "users") { 329 my $userID = shift @components; 330 331 if (defined $userID) { 332 my $userArg = shift @components; 333 if (defined $userArg) { 334 if ($userArg eq "sets") { 335 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SetsAssignedToUser"; 336 @arguments = ($userID); 337 } 338 } 339 else { 340 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserDetail"; 341 @arguments = ($userID); 342 } 343 } 344 else { 345 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UserList"; 346 @arguments = (); 347 } 348 } 349 elsif ($instructorArgument eq "sets") { 350 my $setID = shift @components; 351 352 if (defined $setID) { 353 my $setArg = shift @components; 354 355 if (defined $setArg) { 356 if ($setArg eq "problems") { 357 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemList"; 358 @arguments = ($setID); 359 } 360 elsif ($setArg eq "users") { 361 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet"; 362 @arguments = ($setID); 363 } 364 } 365 else { 366 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetEditor"; 367 @arguments = ($setID); 368 } 369 } 370 else { 371 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ProblemSetList"; 372 @arguments = (); 373 374 } 375 } 376 elsif ($instructorArgument eq "pgProblemEditor") { 377 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::PGProblemEditor"; 378 @arguments = @components; 379 } 380 elsif ($instructorArgument eq "send_mail") { 381 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::SendMail"; 382 @arguments = @components; 383 } 384 elsif ($instructorArgument eq "show_answers") { 385 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::ShowAnswers"; 386 @arguments = @components; 387 } 388 elsif ($instructorArgument eq "stats") { 389 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::Stats"; 390 @arguments = @components; 391 } 392 elsif ($instructorArgument eq "files") { 393 $contentGenerator = "WeBWorK::ContentGenerator::Instructor::FileXfer"; 394 @arguments = @components; 395 } 396 } 397 else { 398 # $arg is a set ID 399 my $setID = $arg; 400 my $problemID = shift @components; 401 402 if (defined $problemID) { 403 $contentGenerator = "WeBWorK::ContentGenerator::Problem"; 404 @arguments = ($setID, $problemID); 405 } 406 else { 407 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSet"; 408 @arguments = ($setID); 409 } 410 } 411 } 412 413 =item Call the selected content generator 414 415 Instantiate the selected subclass of content generator and call its C<&go> method. Store the result. 416 417 =cut 418 419 my $result; 420 if ($contentGenerator) { 421 runtime_use($contentGenerator); 422 my $cg = $contentGenerator->new($r, $ce, $db); 423 @arguments = () unless @arguments; 424 $WeBWorK::timer = WeBWorK::Timing->new("${contentGenerator}::go(@arguments)") if $timingON == 1; 425 $WeBWorK::timer->start if $timingON == 1; 426 427 $result = $cg->go(@arguments); 428 429 $WeBWorK::timer->stop if $timingON == 1; 430 $WeBWorK::timer->save if $timingON == 1; 431 } else { 432 $result = NOT_FOUND; 433 } 434 435 =item Return the result of calling the content generator 436 437 The return value of the content generator's C<&go> function is returned. 438 439 =cut 440 441 return $result; 442 } 443 444 =back 445 446 =head1 AUTHOR 447 448 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 449 Hathaway, sh002i at math.rochester.edu. 450 451 =cut 452 453 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |