[system] / trunk / webwork-modperl / lib / Apache / WeBWorK.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/Apache/WeBWorK.pm

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

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