Parent Directory
| 
Revision Log
Added timing code for Instructor::Index to Instructor::Index.pm and also to WeBWorK.pm. We can remove this once we have finished testing various database configs. --Mike
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 =head1 SYNOPSIS 13 14 my $r = Apache->request; 15 my $result = eval { WeBWorK::dispatch($r) }; 16 die "something bad happened: $@" if $@; 17 18 =head1 DESCRIPTION 19 20 C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request 21 object, it performs authentication and determines which subclass of 22 C<WeBWorK::ContentGenerator> to call. 23 24 =head1 REQUEST FORMAT 25 26 FIXME: write this part 27 summary: the URI controls 28 29 =cut 30 31 BEGIN { $main::VERSION = "2.0"; } 32 33 use strict; 34 use warnings; 35 use Apache::Constants qw(:common REDIRECT DONE); 36 use Apache::Request; 37 use WeBWorK::Authen; 38 use WeBWorK::Authz; 39 use WeBWorK::ContentGenerator::Feedback; 40 use WeBWorK::ContentGenerator::GatewayQuiz; 41 use WeBWorK::ContentGenerator::Hardcopy; 42 use WeBWorK::ContentGenerator::Instructor::AddUsers; 43 use WeBWorK::ContentGenerator::Instructor::Assigner; 44 use WeBWorK::ContentGenerator::Instructor::Index; 45 #use WeBWorK::ContentGenerator::Instructor::Index2; 46 use WeBWorK::ContentGenerator::Instructor::PGProblemEditor; 47 use WeBWorK::ContentGenerator::Instructor::ProblemList; 48 use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor; 49 use WeBWorK::ContentGenerator::Instructor::ProblemSetList; 50 use WeBWorK::ContentGenerator::Instructor::UserList; 51 use WeBWorK::ContentGenerator::Instructor::SendMail; 52 use WeBWorK::ContentGenerator::Instructor::ShowAnswers; 53 use WeBWorK::ContentGenerator::Instructor::Scoring; 54 use WeBWorK::ContentGenerator::Instructor::ScoringDownload; 55 use WeBWorK::ContentGenerator::Instructor::ScoringTotals; 56 use WeBWorK::ContentGenerator::Instructor::Stats; 57 use WeBWorK::ContentGenerator::Login; 58 use WeBWorK::ContentGenerator::Logout; 59 use WeBWorK::ContentGenerator::Options; 60 use WeBWorK::ContentGenerator::Problem; 61 use WeBWorK::ContentGenerator::ProblemSet; 62 use WeBWorK::ContentGenerator::ProblemSets; 63 use WeBWorK::ContentGenerator::Test; 64 use WeBWorK::CourseEnvironment; 65 use WeBWorK::DB; 66 use WeBWorK::Timing; 67 68 =head1 THE C<&dispatch> FUNCTION 69 70 The C<&dispatch> function takes an Apache request object (REQUEST) and returns 71 an apache status code. Below is an overview of its operation: 72 73 =over 74 75 =cut 76 77 sub dispatch($) { 78 my ($apache) = @_; 79 my $r = Apache::Request->new($apache); 80 # have to deal with unpredictable GET or POST data, and sift 81 # through it for the key. So use Apache::Request 82 83 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 84 # It's for figuring out the basepath. I may change this up if I find a 85 # better way to do it. 86 my $path_info = $r->path_info || ""; 87 $path_info =~ s!/+!/!g; # strip multiple forward slashes 88 my $current_uri = $r->uri; 89 my $args = $r->args; 90 91 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; 92 93 =item Ensure that the URI ends with a "/" 94 95 Parts of WeBWorK assume that the current URI of a request ends with a "/". If 96 this is not the case, a redirection is issued to add the "/". This action will 97 discard any POST data associated with the request, so it is essential that all 98 POST requests include a "/" at the end of the URI. 99 100 =cut 101 102 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 103 # alllll over the place. 104 unless (substr($current_uri,-1) eq '/') { 105 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 106 return REDIRECT; 107 # *** any post data gets lost here -- fix that. 108 # (actually, it's not a problem, since all URLs generated 109 # from within the system have trailing slashes, and we don't 110 # need POST data from outside the system anyway!) 111 } 112 113 # Create the @components array, which contains the path specified in the URL 114 my($junk, @components) = split "/", $path_info; 115 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 116 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf 117 my $course = shift @components; 118 119 =item Read the course environment 120 121 C<WeBWorK::CourseEnvironment> is used to read the F<global.conf> configuration 122 file. If a course name was given in the request's URI, it is passed to 123 C<WeBWorK::CourseEnvironment>. In this case, the course-specific configuration 124 file (usually F<course.conf>) is also read by C<WeBWorK::CourseEnvironment> at 125 this point. 126 127 See also L<WeBWorK::CourseEnvironment>. 128 129 =cut 130 131 # Try to get the course environment. 132 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);}; 133 if ($@) { # If there was an error getting the requested course 134 die "Failed to read course environment for $course: $@"; 135 } 136 137 =item If no course was given, go to the site home page 138 139 If the URI did not include the name of a course, a redirection is issued to the 140 site home page, given but the course environemnt variable 141 C<$ce-E<gt>{webworkURLs}-E<gt>{home}>. 142 143 =cut 144 145 # If no course was specified, redirect to the home URL 146 unless (defined $course) { 147 $r->header_out(Location => $ce->{webworkURLs}->{home}); 148 return REDIRECT; 149 } 150 151 =item If the given course does not exist, fail 152 153 If the URI did include the name of a course, but the course directory was not 154 found, an exception is thrown. 155 156 =cut 157 158 # Freak out if the requested course doesn't exist. For now, this is just a 159 # check to see if the course directory exists. 160 my $courseDir = $ce->{webworkDirs}->{courses} . "/$course"; 161 unless (-e $courseDir) { 162 die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?"; 163 } 164 165 =item Initialize the database system 166 167 A C<WeBWorK::DB> object is created from the current course environment. 168 169 See also L<WeBWorK::DB>. 170 171 =cut 172 173 # Bring up a connection to the database (for Authen/Authz, and eventually 174 # to be passed to content generators, when we clean this file up). 175 my $db = WeBWorK::DB->new($ce); 176 177 ### Begin dispatching ### 178 179 #my $dispatchTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch"); 180 #$dispatchTimer->start; 181 182 my $result; 183 184 =item Check authentication 185 186 Use C<WeBWorK::Authen> to verify that the remote user has authenticated. 187 188 See also L<WeBWorK::Authen>. 189 190 =cut 191 192 # WeBWorK::Authen::verify erases the passwd field and sets the key field 193 # if login is successful. 194 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { 195 $result = WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go; 196 } else { 197 198 =item Determine if the user is allowed to set C<effectiveUser> 199 200 Use C<WeBWorK::Authz> to determine if the user is allowed to set 201 C<effectiveUser>. If so, set it to the requested value (or set it to the real 202 user name if no value is supplied). If not, set it to the real user name. 203 204 See also L<WeBWorK::Authz>. 205 206 =cut 207 208 # After we are authenticated, there are some things that need to be 209 # sorted out, Authorization-wize, before we start dispatching to individual 210 # content generators. 211 my $user = $r->param("user"); 212 my $effectiveUser = $r->param("effectiveUser") || $user; 213 my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser); 214 $effectiveUser = $user unless $su_authorized; 215 $r->param("effectiveUser", $effectiveUser); 216 217 =item Create and call the appropriate subclass of C<WeBWorK::ContentGenerator> based on the URI. 218 219 The dispatcher logic currently looks like this: 220 221 FIXME: write this part 222 for now, consult the code 223 224 =cut 225 226 my $arg = shift @components; 227 if (!defined $arg) { # We want the list of problem sets 228 $result = WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go; 229 } elsif ($arg eq "hardcopy") { 230 231 my $hardcopyArgument = shift @components; 232 $hardcopyArgument = "" unless defined $hardcopyArgument; 233 $WeBWorK::timer1 = WeBWorK::Timing->new("hardcopy: $hardcopyArgument"); 234 $WeBWorK::timer1->start; 235 236 my $result = WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument); 237 $WeBWorK::timer1 ->stop; 238 $WeBWorK::timer1 ->save; 239 return $result; 240 } elsif ($arg eq "instructor2") { 241 my $instructorArgument = shift @components; 242 if (!defined $instructorArgument) { 243 $result = WeBWorK::ContentGenerator::Instructor::Index2->new($r, $ce, $db)->go; 244 } 245 } elsif ($arg eq "instructor") { 246 my $instructorArgument = shift @components; 247 if (!defined $instructorArgument) { 248 $WeBWorK::timer2 = WeBWorK::Timing->new("Instructor index $course:"); 249 $WeBWorK::timer2->start; 250 $result = WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go; 251 $WeBWorK::timer2->continue("Listing instructor page is done"); 252 $WeBWorK::timer2->stop; 253 $WeBWorK::timer2->save; 254 } elsif ($instructorArgument eq "scoring") { 255 $result = WeBWorK::ContentGenerator::Instructor::Scoring->new($r, $ce, $db)->go; #FIXME!!!! 256 } elsif ($instructorArgument eq "add_users") { 257 $result = WeBWorK::ContentGenerator::Instructor::AddUsers->new($r, $ce, $db)->go; #FIXME!!!! 258 } elsif ($instructorArgument eq "scoringDownload") { 259 $result = WeBWorK::ContentGenerator::Instructor::ScoringDownload->new($r, $ce, $db)->go; 260 } elsif ($instructorArgument eq "scoring_totals") { 261 $result = WeBWorK::ContentGenerator::Instructor::ScoringTotals->new($r, $ce, $db)->go; 262 } elsif ($instructorArgument eq "users") { 263 $result = WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go; 264 } elsif ($instructorArgument eq "sets") { 265 my $setID = shift @components; 266 if (defined $setID) { 267 my $setArg = shift @components; 268 if (!defined $setArg) { 269 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID); 270 } elsif ($setArg eq "problems") { 271 $result = WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID); 272 } elsif ($setArg eq "users") { 273 $result = WeBWorK::ContentGenerator::Instructor::Assigner->new($r, $ce, $db)->go($setID); 274 } 275 } else { 276 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go; 277 } 278 } elsif ($instructorArgument eq "pgProblemEditor") { 279 $result = WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components); 280 } elsif ($instructorArgument eq "send_mail") { 281 $result = WeBWorK::ContentGenerator::Instructor::SendMail->new($r, $ce, $db)->go(@components); 282 } elsif ($instructorArgument eq "show_answers") { 283 $result = WeBWorK::ContentGenerator::Instructor::ShowAnswers->new($r, $ce, $db)->go(@components); 284 } elsif ($instructorArgument eq "stats") { 285 $result = WeBWorK::ContentGenerator::Instructor::Stats->new($r, $ce, $db)->go(@components); 286 } 287 } elsif ($arg eq "options") { 288 $result = WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go; 289 } elsif ($arg eq "feedback") { 290 $result = WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go; 291 } elsif ($arg eq "logout") { 292 $result = WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go; 293 } elsif ($arg eq "test") { 294 $result = WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go; 295 } elsif ($arg eq "quiz_mode" ) { 296 # Gateway quiz capability -- very similar to problem set (initially) 297 $result = WeBWorK::ContentGenerator::GatewayQuiz->new($r, $ce, $db)->go(@components); 298 } else { # We've got the name of a problem set. 299 my $problem_set = $arg; 300 my $ps_arg = shift @components; 301 302 if (!defined $ps_arg) { 303 # list the problems in the problem set 304 $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set"); 305 $WeBWorK::timer0->start; 306 $result = WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set); 307 $WeBWorK::timer0->continue("problem set listing is done"); 308 $WeBWorK::timer0->stop; 309 $WeBWorK::timer0->save; 310 } else { 311 # We've got the name of a problem 312 my $problem = $ps_arg; 313 314 $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set/$problem"); 315 $WeBWorK::timer0->start; 316 # my $pid = fork(); 317 # if ($pid) { 318 # wait; 319 # } else { 320 my $result = WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); 321 # $WeBWorK::timer0->continue("Exiting child process"); 322 # #$WeBWorK::timer0->stop; 323 # #$WeBWorK::timer0->save; 324 # eval{ APACHE::exit(0);} || warn "Error in leaving child |$@|"; 325 # # We REALLY REALLY want this grandchild to exit. But not the child. How to do this 326 # # cleanly???? FIXME 327 # } 328 $WeBWorK::timer0->continue("Problem done)"); 329 $WeBWorK::timer0->stop; 330 $WeBWorK::timer0->save; 331 return $result; 332 333 334 } 335 } 336 } 337 338 #$dispatchTimer->stop; 339 340 =item Return the result of calling the content generator 341 342 The return value of the content generator's C<&go> function is returned. 343 344 =cut 345 346 return $result; 347 } 348 349 =back 350 351 =head1 AUTHOR 352 353 Written by Dennis Lambe, malsyned at math.rochester.edu. 354 355 =cut 356 357 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |