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