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