Parent Directory
|
Revision Log
Included timing code. --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 ContentGenerator. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use Apache::Constants qw(:common REDIRECT); 17 use Apache::Request; 18 use WeBWorK::Authen; 19 use WeBWorK::Authz; 20 use WeBWorK::ContentGenerator::Feedback; 21 use WeBWorK::ContentGenerator::GatewayQuiz; 22 use WeBWorK::ContentGenerator::Hardcopy; 23 use WeBWorK::ContentGenerator::Instructor::Assigner; 24 use WeBWorK::ContentGenerator::Instructor::Index; 25 use WeBWorK::ContentGenerator::Instructor::PGProblemEditor; 26 use WeBWorK::ContentGenerator::Instructor::ProblemList; 27 use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor; 28 use WeBWorK::ContentGenerator::Instructor::ProblemSetList; 29 use WeBWorK::ContentGenerator::Instructor::UserList; 30 use WeBWorK::ContentGenerator::Instructor::UserList; 31 use WeBWorK::ContentGenerator::Login; 32 use WeBWorK::ContentGenerator::Logout; 33 use WeBWorK::ContentGenerator::Options; 34 use WeBWorK::ContentGenerator::Problem; 35 use WeBWorK::ContentGenerator::ProblemSet; 36 use WeBWorK::ContentGenerator::ProblemSets; 37 use WeBWorK::ContentGenerator::Test; 38 use WeBWorK::CourseEnvironment; 39 use WeBWorK::DB; 40 use WeBWorK::Timing; 41 42 #sub dispatch($) { 43 # print STDERR "Executing &WeBWorK::dispatch\n"; 44 # return DECLINED; 45 #} 46 #1; 47 #__END__ 48 49 sub dispatch($) { 50 my ($apache) = @_; 51 my $r = Apache::Request->new($apache); 52 # have to deal with unpredictable GET or POST data, and sift 53 # through it for the key. So use Apache::Request 54 55 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 56 # It's for figuring out the basepath. I may change this up if I find a 57 # better way to do it. 58 my $path_info = $r->path_info || ""; 59 $path_info =~ s!/+!/!g; # strip multiple forward slashes 60 my $current_uri = $r->uri; 61 my $args = $r->args; 62 63 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; 64 65 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 66 # alllll over the place. 67 unless (substr($current_uri,-1) eq '/') { 68 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 69 return REDIRECT; 70 # *** any post data gets lost here -- fix that. 71 # (actually, it's not a problem, since all URLs generated 72 # from within the system have trailing slashes, and we don't 73 # need POST data from outside the system anyway!) 74 } 75 76 # Create the @components array, which contains the path specified in the URL 77 my($junk, @components) = split "/", $path_info; 78 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 79 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf 80 my $course = shift @components; 81 82 my $ceTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch get ce"); 83 $ceTimer->start; 84 85 # Try to get the course environment. 86 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);}; 87 if ($@) { # If there was an error getting the requested course 88 die "Failed to read course environment for $course: $@"; 89 } 90 91 $ceTimer->stop; 92 93 # If no course was specified, redirect to the home URL 94 unless (defined $course) { 95 $r->header_out(Location => $ce->{webworkURLs}->{home}); 96 return REDIRECT; 97 } 98 99 # Freak out if the requested course doesn't exist. For now, this is just a 100 # check to see if the course directory exists. 101 my $courseDir = $ce->{webworkDirs}->{courses} . "/$course"; 102 unless (-e $courseDir) { 103 die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?"; 104 } 105 106 my $dbTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch init db"); 107 $dbTimer->start; 108 109 # Bring up a connection to the database (for Authen/Authz, and eventually 110 # to be passed to content generators, when we clean this file up). 111 my $db = WeBWorK::DB->new($ce); 112 113 $dbTimer->stop; 114 115 ### Begin dispatching ### 116 117 my $dispatchTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch begin dispatching"); 118 $dispatchTimer->start; 119 120 my $result; 121 # WeBWorK::Authen::verify erases the passwd field and sets the key field 122 # if login is successful. 123 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { 124 $result = WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go; 125 } else { 126 # After we are authenticated, there are some things that need to be 127 # sorted out, Authorization-wize, before we start dispatching to individual 128 # content generators. 129 my $user = $r->param("user"); 130 my $effectiveUser = $r->param("effectiveUser") || $user; 131 my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser); 132 $effectiveUser = $user unless $su_authorized; 133 $r->param("effectiveUser", $effectiveUser); 134 135 my $arg = shift @components; 136 if (!defined $arg) { # We want the list of problem sets 137 $result = WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go; 138 } elsif ($arg eq "hardcopy") { 139 140 my $hardcopyArgument = shift @components; 141 $WeBWorK::timer1 = WeBWorK::Timing->new("hardcopy: $hardcopyArgument"); 142 $WeBWorK::timer1->start; 143 $hardcopyArgument = "" unless defined $hardcopyArgument; 144 my $result = WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument); 145 $WeBWorK::timer1 ->stop; 146 $WeBWorK::timer1 ->save; 147 return $result; 148 } elsif ($arg eq "instructor") { 149 my $instructorArgument = shift @components; 150 if (!defined $instructorArgument) { 151 $result = WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go; 152 } elsif ($instructorArgument eq "users") { 153 $result = WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go; 154 } elsif ($instructorArgument eq "sets") { 155 my $setID = shift @components; 156 if (defined $setID) { 157 my $setArg = shift @components; 158 if (!defined $setArg) { 159 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID); 160 } elsif ($setArg eq "problems") { 161 $result = WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID); 162 } elsif ($setArg eq "users") { 163 $result = WeBWorK::ContentGenerator::Instructor::Assigner->new($r, $ce, $db)->go($setID); 164 } 165 } else { 166 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go; 167 } 168 } elsif ($instructorArgument eq "pgProblemEditor") { 169 $result = WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components); 170 } 171 } elsif ($arg eq "options") { 172 $result = WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go; 173 } elsif ($arg eq "feedback") { 174 $result = WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go; 175 } elsif ($arg eq "logout") { 176 $result = WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go; 177 } elsif ($arg eq "test") { 178 $result = WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go; 179 } elsif ($arg eq "quiz_mode" ) { 180 # Gateway quiz capability -- very similar to problem set (initially) 181 $result = WeBWorK::ContentGenerator::GatewayQuiz->new($r, $ce, $db)->go(@components); 182 } else { # We've got the name of a problem set. 183 my $problem_set = $arg; 184 my $ps_arg = shift @components; 185 186 if (!defined $ps_arg) { 187 # list the problems in the problem set 188 $result = WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set); 189 } else { 190 # We've got the name of a problem 191 my $problem = $ps_arg; 192 <<<<<<< WeBWorK.pm 193 $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set/$problem"); 194 $WeBWorK::timer0->start; 195 my $result = WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); 196 $WeBWorK::timer0->stop; 197 $WeBWorK::timer0->save; 198 return $result; 199 ======= 200 $result = WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); 201 >>>>>>> 1.13 202 } 203 } 204 } 205 206 $dispatchTimer->stop; 207 208 return $result; 209 } 210 211 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |