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