Parent Directory
| 
Revision Log
Added a Professor Tools stub module that provides redirection links to the WeBWorK 1.8 system -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 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::Login; 22 use WeBWorK::ContentGenerator::Logout; 23 use WeBWorK::ContentGenerator::Hardcopy; 24 use WeBWorK::ContentGenerator::Options; 25 use WeBWorK::ContentGenerator::Problem; 26 use WeBWorK::ContentGenerator::ProblemSet; 27 use WeBWorK::ContentGenerator::ProblemSets; 28 use WeBWorK::ContentGenerator::Professor; 29 use WeBWorK::ContentGenerator::Test; 30 use WeBWorK::CourseEnvironment; 31 32 # This module should be installed as a Handler for the location selected for 33 # WeBWorK on your webserver. Here is an example of a stanza that can be added 34 # to your httpd.conf file to achieve this: 35 # 36 # <IfModule mod_perl.c> 37 # PerlFreshRestart On 38 # <Location /modperl-sam> 39 # SetHandler perl-script 40 # PerlSetVar webwork_root /opt/webwork 41 # <Perl> 42 # use lib '/opt/webwork/lib'; 43 # </Perl> 44 # PerlHandler Apache::WeBWorK 45 # </Location> 46 # </IfModule> 47 48 sub handler() { 49 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 50 51 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 52 # It's for figuring out the basepath. I may change this up if I 53 # find a better way to do it. 54 my $path_info = $r->path_info || ""; 55 my $current_uri = $r->uri; 56 my $args = $r->args; 57 58 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 59 # alllll over the place. 60 unless (substr($current_uri,-1) eq '/') { 61 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 62 return REDIRECT; 63 # *** any post data gets lost here -- fix that. 64 } 65 66 # Create the @components array, which contains the path specified in the URL 67 my($junk, @components) = split "/", $path_info; 68 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 69 my $course = shift @components; 70 71 # If no course was specified, phreak out. 72 # Eventually, display a list of courses, or something. 73 unless (defined $course) { 74 warn "No course specified.\n"; 75 return DECLINED; 76 # *** we should either write a "Courses" module, or redirect to a static page. 77 } 78 79 # Try to get the course environment. 80 my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);}; 81 if ($@) { # If there was an error getting the requested course 82 # TODO: display an error page. For now, 404 it. 83 warn $@; 84 return DECLINED; 85 } 86 87 # Freak out if the requested course doesn't exist. For now, this is just a 88 # check to see if the course directory exists. 89 if (!-e $course_env->{webworkDirs}->{courses} . "/$course") { 90 warn "Course directory for $course not found at " 91 . $course_env->{webworkDirs}->{courses} . "/$course" ."\n"; 92 return DECLINED; 93 } 94 95 ### Begin dispatching ### 96 97 # WeBWorK::Authen::verify erases the passwd field and sets the key field 98 # if login is successful. 99 if (!WeBWorK::Authen->new($r, $course_env)->verify) { 100 return WeBWorK::ContentGenerator::Login->new($r, $course_env)->go; 101 } else { 102 # After we are authenticated, there are some things that need to be 103 # sorted out, Authorization-wize, before we start dispatching to individual 104 # content generators. 105 my $effectiveUser = $r->param("effectiveUser") || ""; 106 my $user = $r->param("user"); 107 my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser); 108 # This hoary statement has the effect of forcing effectiveUser to equal user unless 109 # the user is otherwise authorized. 110 if (!($user ne $effectiveUser && $su_authorized) || !defined $effectiveUser) { 111 $r->param("effectiveUser",$user); 112 } 113 114 my $arg = shift @components; 115 if (!defined $arg) { # We want the list of problem sets 116 return WeBWorK::ContentGenerator::ProblemSets->new($r, $course_env)->go; 117 } elsif ($arg eq "hardcopy") { 118 my $hardcopyArgument = shift @components; 119 $hardcopyArgument = "" unless defined $hardcopyArgument; 120 # *** can i say go(shift || "") here? 121 return WeBWorK::ContentGenerator::Hardcopy->new($r, $course_env)->go($hardcopyArgument); 122 } elsif ($arg eq "prof") { 123 return WeBWorK::ContentGenerator::Professor->new($r, $course_env)->go; 124 } elsif ($arg eq "options") { 125 return WeBWorK::ContentGenerator::Options->new($r, $course_env)->go; 126 } elsif ($arg eq "feedback") { 127 return WeBWorK::ContentGenerator::Feedback->new($r, $course_env)->go; 128 } elsif ($arg eq "logout") { 129 return WeBWorK::ContentGenerator::Logout->new($r, $course_env)->go; 130 } elsif ($arg eq "test") { 131 # *** we should change this name, or remove it altogether. 132 return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go; 133 } else { # We've got the name of a problem set. 134 my $problem_set = $arg; 135 my $ps_arg = shift @components; 136 137 if (!defined $ps_arg) { 138 # list the problems in the problem set 139 return WeBWorK::ContentGenerator::ProblemSet->new($r, $course_env)->go($problem_set); 140 } elsif ($ps_arg eq "hardcopy") { 141 # *** do we need this? hardcopy is not being called this way 142 } 143 else { 144 # We've got the name of a problem 145 my $problem = $ps_arg; 146 return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem); 147 } 148 } 149 150 } 151 152 # If the dispatcher doesn't know any modules that want to handle 153 # the current path, it'll claim that the path does not exist by 154 # declining the request. 155 return DECLINED; 156 } 157 158 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |