Parent Directory
| 
Revision Log
There's no longer a seperate "Add Set" content generator. That form is now right on the problem set list. -Dennis
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package Apache::WeBWorK; 7 8 =head1 NAME 9 10 Apache::WeBWorK - The WeBWorK dispatcher module. 11 12 =cut 13 14 # CGI::Carp makes pretty log and browser error messages. It should be loaded as 15 # soon as possible. 16 use CGI::Carp qw(fatalsToBrowser); 17 BEGIN { 18 # CGI::Carp needs a little patch to make it work with the "vanilla" 19 # mod_perl API (as opposed to Apache::Registry). _longmess is supposed 20 # to filter out evals that are always there, as a result of being run 21 # under mod_perl. Under the "vanilla" API, the first stack frame is 22 # "eval {...} called at /dev/null line 0". This needs to be removed. 23 # 24 # [later:] 25 # 26 # Ok, so apparently, when a die happens during compilation, the first 27 # stack frame is the following: 28 # 29 # eval 'require Apache::WeBWorK 30 # ;' called at /path/to/lib/Apache/WeBWorK.pm line 0 31 # 32 # So we'll try to handle that too. 33 sub CGI::Carp::_longmess { 34 my $message = Carp::longmess(); 35 my $mod_perl = exists $ENV{MOD_PERL}; 36 $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl; 37 38 # for a runtime call stack 39 $message =~ s,eval[^\n]+/dev/null line 0.*,,s if $mod_perl; 40 41 # for a compile-time call stack 42 my $pkg = __PACKAGE__; 43 $message =~ s/eval 'require $pkg\n.*//s if $mod_perl; 44 45 return $message; 46 } 47 } 48 49 use strict; 50 use warnings; 51 use Apache::Constants qw(:common REDIRECT); 52 use Apache::Request; 53 use WeBWorK::Authen; 54 use WeBWorK::Authz; 55 use WeBWorK::ContentGenerator::Feedback; 56 use WeBWorK::ContentGenerator::Login; 57 use WeBWorK::ContentGenerator::Logout; 58 use WeBWorK::ContentGenerator::Hardcopy; 59 use WeBWorK::ContentGenerator::Options; 60 use WeBWorK::ContentGenerator::Problem; 61 use WeBWorK::ContentGenerator::ProblemSet; 62 use WeBWorK::ContentGenerator::ProblemSets; 63 use WeBWorK::ContentGenerator::Instructor::Index; 64 use WeBWorK::ContentGenerator::Instructor::UserList; 65 use WeBWorK::ContentGenerator::Instructor::ProblemSetList; 66 use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor; 67 use WeBWorK::ContentGenerator::Instructor::PGProblemEditor; 68 use WeBWorK::ContentGenerator::Test; 69 use WeBWorK::CourseEnvironment; 70 use WeBWorK::DB; 71 72 =head1 CONFIGURATION 73 74 This module should be installed as a Handler for the location selected for 75 WeBWorK on your webserver. Here is an example of a stanza that can be added to 76 your httpd.conf file to achieve this: 77 78 <IfModule mod_perl.c> 79 PerlFreshRestart On 80 <Location /webwork> 81 SetHandler perl-script 82 PerlHandler Apache::WeBWorK 83 PerlSetVar webwork_root /path/to/webwork-modperl 84 <Perl> 85 use lib '/path/to/webwork-modperl/lib'; 86 use lib '/path/to/webwork-modperl/pglib'; 87 </Perl> 88 </Location> 89 </IfModule> 90 91 =cut 92 93 sub handler() { 94 my $r = Apache::Request->new(shift); # have to deal with unpredictable GET or POST data, and sift through it for the key. So use Apache::Request 95 96 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 97 # It's for figuring out the basepath. I may change this up if I 98 # find a better way to do it. 99 my $path_info = $r->path_info || ""; 100 my $current_uri = $r->uri; 101 my $args = $r->args; 102 103 $current_uri =~ m/^(.*)$path_info/; 104 my $urlRoot = $1; 105 106 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 107 # alllll over the place. 108 unless (substr($current_uri,-1) eq '/') { 109 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 110 return REDIRECT; 111 # *** any post data gets lost here -- fix that. 112 } 113 114 # Create the @components array, which contains the path specified in the URL 115 my($junk, @components) = split "/", $path_info; 116 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 117 my $course = shift @components; 118 119 # Try to get the course environment. 120 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $course);}; 121 if ($@) { # If there was an error getting the requested course 122 # TODO: display an error page. For now, 404 it. 123 warn $@; 124 return DECLINED; 125 } 126 127 # If no course was specified, redirect to the home URL 128 unless (defined $course) { 129 $r->header_out(Location => $ce->{webworkURLs}->{home}); 130 return REDIRECT; 131 } 132 133 # Freak out if the requested course doesn't exist. For now, this is just a 134 # check to see if the course directory exists. 135 if (!-e $ce->{webworkDirs}->{courses} . "/$course") { 136 warn "Course directory for $course not found at " 137 . $ce->{webworkDirs}->{courses} . "/$course" ."\n"; 138 return DECLINED; 139 } 140 141 # Bring up a connection to the database (for Authen/Authz, and eventually 142 # to be passed to content generators, when we clean this file up). 143 my $db = WeBWorK::DB->new($ce); 144 145 ### Begin dispatching ### 146 147 # WeBWorK::Authen::verify erases the passwd field and sets the key field 148 # if login is successful. 149 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { 150 return WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go; 151 } else { 152 # After we are authenticated, there are some things that need to be 153 # sorted out, Authorization-wize, before we start dispatching to individual 154 # content generators. 155 my $user = $r->param("user"); 156 my $effectiveUser = $r->param("effectiveUser") || $user; 157 my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser); 158 $effectiveUser = $user unless $su_authorized; 159 $r->param("effectiveUser", $effectiveUser); 160 161 my $arg = shift @components; 162 if (!defined $arg) { # We want the list of problem sets 163 return WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go; 164 } elsif ($arg eq "hardcopy") { 165 my $hardcopyArgument = shift @components; 166 $hardcopyArgument = "" unless defined $hardcopyArgument; 167 return WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument); 168 } elsif ($arg eq "instructor") { 169 my $instructorArgument = shift @components; 170 if (!defined $instructorArgument) { 171 return WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go; 172 } elsif ($instructorArgument eq "userList") { 173 return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go; 174 } elsif ($instructorArgument eq "problemSetList") { 175 return WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go; 176 } elsif ($instructorArgument eq "problemSetEditor") { 177 return WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go(@components); 178 } elsif ($instructorArgument eq "pgProblemEditor") { 179 return WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components); 180 } 181 } elsif ($arg eq "options") { 182 return WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go; 183 } elsif ($arg eq "feedback") { 184 return WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go; 185 } elsif ($arg eq "logout") { 186 return WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go; 187 } elsif ($arg eq "test") { 188 return WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go; 189 } else { # We've got the name of a problem set. 190 my $problem_set = $arg; 191 my $ps_arg = shift @components; 192 193 if (!defined $ps_arg) { 194 # list the problems in the problem set 195 return WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set); 196 } else { 197 # We've got the name of a problem 198 my $problem = $ps_arg; 199 return WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); 200 } 201 } 202 203 } 204 205 # If the dispatcher doesn't know any modules that want to handle 206 # the current path, it'll claim that the path does not exist by 207 # declining the request. 208 return DECLINED; 209 } 210 211 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |