[system] / trunk / webwork2 / lib / Apache / WeBWorK.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/Apache/WeBWorK.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 446 Revision 861
1# Apache::WeBWorK - The WeBWorK dispatcher module 1################################################################################
2# Place something like the following in your Apache configuration to load the 2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# WeBWorK module and install it as a handler for the WeBWorK system 3# $Id$
4 4################################################################################
5# PerlRequire /path/to/webwork/conf/init.pl
6# PerlSetVar webwork_root /path/to/webwork
7# <Location /webwork>
8# SetHandler perl-script
9# PerlHandler Apache::WeBWorK
10# </Location>
11
12# In addition, you will have to edit init.pl in what should be obvious ways.
13 5
14package Apache::WeBWorK; 6package Apache::WeBWorK;
7
8=head1 NAME
9
10Apache::WeBWorK - The WeBWorK dispatcher module.
11
12=cut
15 13
16use strict; 14use strict;
17use warnings; 15use warnings;
18use Apache::Constants qw(:common REDIRECT); 16use Apache::Constants qw(:common REDIRECT);
19use Apache::Request; 17use Apache::Request;
20use WeBWorK::CourseEnvironment;
21use WeBWorK::Authen; 18use WeBWorK::Authen;
22use WeBWorK::Authz; 19use WeBWorK::Authz;
20use WeBWorK::ContentGenerator::Feedback;
21use WeBWorK::ContentGenerator::Login;
22use WeBWorK::ContentGenerator::Logout;
23use WeBWorK::ContentGenerator::Hardcopy;
24use WeBWorK::ContentGenerator::Options;
25use WeBWorK::ContentGenerator::Problem;
26use WeBWorK::ContentGenerator::ProblemSet;
27use WeBWorK::ContentGenerator::ProblemSets;
28use WeBWorK::ContentGenerator::Instructor::Index;
29use WeBWorK::ContentGenerator::Instructor::UserList;
30use WeBWorK::ContentGenerator::Instructor::ProblemSetList;
31use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor;
23use WeBWorK::ContentGenerator::Test; 32use WeBWorK::ContentGenerator::Test;
24use WeBWorK::ContentGenerator::Login; 33use WeBWorK::CourseEnvironment;
25use WeBWorK::ContentGenerator::ProblemSets; 34use WeBWorK::DB;
26use WeBWorK::ContentGenerator::ProblemSet;
27use WeBWorK::ContentGenerator::Problem;
28 35
29# Sets up the common environment needed for every subsystem and then dispatches 36# This module should be installed as a Handler for the location selected for
30# the page request to the appropriate content generator. 37# WeBWorK on your webserver. Here is an example of a stanza that can be added
31 38# to your httpd.conf file to achieve this:
32# This function has MANY MANY points of exit (return statements)! woo! 39#
33# call it a quirk of my coding style. I think it makes it easier to read in this case. 40# <IfModule mod_perl.c>
41# PerlFreshRestart On
42# <Location /webwork>
43# SetHandler perl-script
44# PerlHandler Apache::WeBWorK
45# PerlSetVar webwork_root /path/to/webwork-modperl
46# <Perl>
47# use lib '/path/to/webwork-modperl/lib';
48# use lib '/path/to/webwork-modperl/pglib';
49# </Perl>
50# </Location>
51# </IfModule>
34 52
35sub handler() { 53sub handler() {
36 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 54 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
37 55
38 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 56 # This stuff is pretty much copied out of the O'Reilly mod_perl book.
39 # It's for figuring out the basepath. I may change this up if I 57 # It's for figuring out the basepath. I may change this up if I
40 # find a better way to do it. 58 # find a better way to do it.
41 my $path_info = $r->path_info; 59 my $path_info = $r->path_info || "";
42 my $path_translated = $r->lookup_uri($path_info)->filename;
43 my $current_uri = $r->uri; 60 my $current_uri = $r->uri;
44 my $args = $r->args; 61 my $args = $r->args;
62
63 $current_uri =~ m/^(.*)$path_info/;
64 my $urlRoot = $1;
45 65
46 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 66 # If it's a valid WeBWorK URI, it ends in a /. This is assumed
47 # alllll over the place. 67 # alllll over the place.
48 unless (substr($current_uri,-1) eq '/') { 68 unless (substr($current_uri,-1) eq '/') {
49 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 69 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
50 return REDIRECT; 70 return REDIRECT;
71 # *** any post data gets lost here -- fix that.
51 } 72 }
52 73
53 # Create the @components array, which contains the path specified in the URL 74 # Create the @components array, which contains the path specified in the URL
54 my($junk, @components) = split "/", $path_info; 75 my($junk, @components) = split "/", $path_info;
55 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 76 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
56 my $course = shift @components; 77 my $course = shift @components;
57 78
58 # Try to get the course environment. 79 # Try to get the course environment.
59 my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);}; 80 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $course);};
60 if ($@) { # If there was an error getting the requested course 81 if ($@) { # If there was an error getting the requested course
61 # TODO: display an error page. For now, 404 it. 82 # TODO: display an error page. For now, 404 it.
62 warn $@; 83 warn $@;
63 return DECLINED; 84 return DECLINED;
64 } 85 }
65 86
87 # If no course was specified, redirect to the home URL
88 unless (defined $course) {
89 $r->header_out(Location => $ce->{webworkURLs}->{home});
90 return REDIRECT;
91 }
92
66 # Freak out if the requested course doesn't exist. For now, this is just a 93 # Freak out if the requested course doesn't exist. For now, this is just a
67 # check to see if the course directory exists. 94 # check to see if the course directory exists.
68 if (!-e $course_env->{webworkDirs}->{courses} . "/$course") { 95 if (!-e $ce->{webworkDirs}->{courses} . "/$course") {
96 warn "Course directory for $course not found at "
97 . $ce->{webworkDirs}->{courses} . "/$course" ."\n";
69 return DECLINED; 98 return DECLINED;
70 } 99 }
100
101 # Bring up a connection to the database (for Authen/Authz, and eventually
102 # to be passed to content generators, when we clean this file up).
103 my $db = WeBWorK::DB->new($ce);
71 104
72 ### Begin dispatching ### 105 ### Begin dispatching ###
73 106
74 # WeBWorK::Authen::verify erases the passwd field and sets the key field 107 # WeBWorK::Authen::verify erases the passwd field and sets the key field
75 # if login is successful. 108 # if login is successful.
76 if (!WeBWorK::Authen->new($r, $course_env)->verify) { 109 if (!WeBWorK::Authen->new($r, $ce, $db)->verify) {
77 return WeBWorK::ContentGenerator::Login->new($r, $course_env)->go; 110 return WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go;
78 } else { 111 } else {
79 # After we are authenticated, there are some things that need to be 112 # After we are authenticated, there are some things that need to be
80 # sorted out, Authorization-wize, before we start dispatching to individual 113 # sorted out, Authorization-wize, before we start dispatching to individual
81 # content generators. 114 # content generators.
82 my $effectiveUser = $r->param("effectiveUser");
83 my $user = $r->param("user"); 115 my $user = $r->param("user");
116 my $effectiveUser = $r->param("effectiveUser") || $user;
84 my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser); 117 my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser);
85 # This hoary statement has the effect of forcing effectiveUser to equal user unless 118 $effectiveUser = $user unless $su_authorized;
86 # the user is otherwise authorized.
87 if (!($user ne $effectiveUser && $su_authorized) || !defined $effectiveUser) {
88 $r->param("effectiveUser",$user); 119 $r->param("effectiveUser", $effectiveUser);
89 }
90 120
91 my $arg = shift @components; 121 my $arg = shift @components;
92 if (!defined $arg) { # We want the list of problem sets 122 if (!defined $arg) { # We want the list of problem sets
93 return WeBWorK::ContentGenerator::ProblemSets->new($r, $course_env)->go; 123 return WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go;
124 } elsif ($arg eq "hardcopy") {
125 my $hardcopyArgument = shift @components;
126 $hardcopyArgument = "" unless defined $hardcopyArgument;
127 return WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument);
128 } elsif ($arg eq "instructor") {
129 my $instructorArgument = shift @components;
130 if (!defined $instructorArgument) {
131 return WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go;
132 } elsif ($instructorArgument eq "userList") {
133 return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go;
134 } elsif ($instructorArgument eq "problemSetList") {
135 return WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go;
136 } elsif ($instructorArgument eq "problemSetEditor") {
137 return WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go;
138
139 }
94 } elsif ($arg eq "prof") { 140 } elsif ($arg eq "options") {
95 ### 141 return WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go;
96 } elsif ($arg eq "prefs") { 142 } elsif ($arg eq "feedback") {
97 ### 143 return WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go;
144 } elsif ($arg eq "logout") {
145 return WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go;
98 } elsif ($arg eq "test") { 146 } elsif ($arg eq "test") {
99 return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go; 147 return WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go;
100 } else { # We've got the name of a problem set. 148 } else { # We've got the name of a problem set.
101 my $problem_set = $arg; 149 my $problem_set = $arg;
102 my $ps_arg = shift @components; 150 my $ps_arg = shift @components;
103 151
104 if (!defined $ps_arg) { 152 if (!defined $ps_arg) {
105 # list the problems in the problem set 153 # list the problems in the problem set
106 return WeBWorK::ContentGenerator::ProblemSet->new($r, $course_env)->go($problem_set); 154 return WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set);
107 } elsif ($ps_arg eq "hardcopy") {
108 ###
109 }
110 else { 155 } else {
111 # We've got the name of a problem 156 # We've got the name of a problem
112 my $problem = $ps_arg; 157 my $problem = $ps_arg;
113 return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem); 158 return WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem);
114 } 159 }
115 } 160 }
116 161
117 } 162 }
118 163
119 # If the dispatcher doesn't know any modules that want to handle 164 # If the dispatcher doesn't know any modules that want to handle
120 # the current path, it'll claim that the path does not exist by 165 # the current path, it'll claim that the path does not exist by
121 # declining the request. 166 # declining the request.
122 return DECLINED; 167 return DECLINED;
123} 168}
Legend:
Removed from v.446  
changed lines
  Added in v.861
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9