Parent Directory
| 
Revision Log
Revision 1130 -
(view)
(download)
(as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK.pm
| 1 : | sh002i | 986 | ################################################################################ |
| 2 : | # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project | ||
| 3 : | # $Id$ | ||
| 4 : | ################################################################################ | ||
| 5 : | |||
| 6 : | package WeBWorK; | ||
| 7 : | |||
| 8 : | =head1 NAME | ||
| 9 : | |||
| 10 : | WeBWorK - Dispatch requests to the appropriate ContentGenerator. | ||
| 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::Hardcopy; | ||
| 22 : | use WeBWorK::ContentGenerator::Instructor::Index; | ||
| 23 : | use WeBWorK::ContentGenerator::Instructor::PGProblemEditor; | ||
| 24 : | use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor; | ||
| 25 : | use WeBWorK::ContentGenerator::Instructor::ProblemSetList; | ||
| 26 : | use WeBWorK::ContentGenerator::Instructor::UserList; | ||
| 27 : | malsyned | 1005 | use WeBWorK::ContentGenerator::Instructor::ProblemList; |
| 28 : | malsyned | 1015 | use WeBWorK::ContentGenerator::Instructor::UserList; |
| 29 : | sh002i | 986 | use WeBWorK::ContentGenerator::Login; |
| 30 : | use WeBWorK::ContentGenerator::Logout; | ||
| 31 : | use WeBWorK::ContentGenerator::Options; | ||
| 32 : | use WeBWorK::ContentGenerator::Problem; | ||
| 33 : | use WeBWorK::ContentGenerator::ProblemSet; | ||
| 34 : | gage | 1130 | use WeBWorK::ContentGenerator::GatewayQuiz; |
| 35 : | sh002i | 986 | use WeBWorK::ContentGenerator::ProblemSets; |
| 36 : | use WeBWorK::ContentGenerator::Test; | ||
| 37 : | use WeBWorK::CourseEnvironment; | ||
| 38 : | use WeBWorK::DB; | ||
| 39 : | |||
| 40 : | sub dispatch($) { | ||
| 41 : | my ($apache) = @_; | ||
| 42 : | my $r = Apache::Request->new($apache); | ||
| 43 : | # have to deal with unpredictable GET or POST data, and sift | ||
| 44 : | # through it for the key. So use Apache::Request | ||
| 45 : | |||
| 46 : | # This stuff is pretty much copied out of the O'Reilly mod_perl book. | ||
| 47 : | # It's for figuring out the basepath. I may change this up if I find a | ||
| 48 : | # better way to do it. | ||
| 49 : | my $path_info = $r->path_info || ""; | ||
| 50 : | malsyned | 1047 | $path_info =~ s!/+!/!g; # strip multiple forward slashes |
| 51 : | sh002i | 986 | my $current_uri = $r->uri; |
| 52 : | my $args = $r->args; | ||
| 53 : | |||
| 54 : | malsyned | 1048 | my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; |
| 55 : | sh002i | 986 | |
| 56 : | # If it's a valid WeBWorK URI, it ends in a /. This is assumed | ||
| 57 : | # alllll over the place. | ||
| 58 : | unless (substr($current_uri,-1) eq '/') { | ||
| 59 : | $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); | ||
| 60 : | return REDIRECT; | ||
| 61 : | # *** any post data gets lost here -- fix that. | ||
| 62 : | } | ||
| 63 : | |||
| 64 : | # Create the @components array, which contains the path specified in the URL | ||
| 65 : | my($junk, @components) = split "/", $path_info; | ||
| 66 : | my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf | ||
| 67 : | sh002i | 1051 | my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf |
| 68 : | sh002i | 986 | my $course = shift @components; |
| 69 : | |||
| 70 : | # Try to get the course environment. | ||
| 71 : | sh002i | 1051 | my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);}; |
| 72 : | sh002i | 986 | if ($@) { # If there was an error getting the requested course |
| 73 : | # TODO: display an error page. For now, 404 it. | ||
| 74 : | warn $@; | ||
| 75 : | return DECLINED; | ||
| 76 : | } | ||
| 77 : | |||
| 78 : | # If no course was specified, redirect to the home URL | ||
| 79 : | unless (defined $course) { | ||
| 80 : | $r->header_out(Location => $ce->{webworkURLs}->{home}); | ||
| 81 : | return REDIRECT; | ||
| 82 : | } | ||
| 83 : | |||
| 84 : | # Freak out if the requested course doesn't exist. For now, this is just a | ||
| 85 : | # check to see if the course directory exists. | ||
| 86 : | if (!-e $ce->{webworkDirs}->{courses} . "/$course") { | ||
| 87 : | warn "Course directory for $course not found at " | ||
| 88 : | . $ce->{webworkDirs}->{courses} . "/$course" ."\n"; | ||
| 89 : | return DECLINED; | ||
| 90 : | } | ||
| 91 : | |||
| 92 : | # Bring up a connection to the database (for Authen/Authz, and eventually | ||
| 93 : | # to be passed to content generators, when we clean this file up). | ||
| 94 : | my $db = WeBWorK::DB->new($ce); | ||
| 95 : | |||
| 96 : | ### Begin dispatching ### | ||
| 97 : | |||
| 98 : | # WeBWorK::Authen::verify erases the passwd field and sets the key field | ||
| 99 : | # if login is successful. | ||
| 100 : | if (!WeBWorK::Authen->new($r, $ce, $db)->verify) { | ||
| 101 : | return WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go; | ||
| 102 : | } else { | ||
| 103 : | # After we are authenticated, there are some things that need to be | ||
| 104 : | # sorted out, Authorization-wize, before we start dispatching to individual | ||
| 105 : | # content generators. | ||
| 106 : | my $user = $r->param("user"); | ||
| 107 : | my $effectiveUser = $r->param("effectiveUser") || $user; | ||
| 108 : | my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser); | ||
| 109 : | $effectiveUser = $user unless $su_authorized; | ||
| 110 : | $r->param("effectiveUser", $effectiveUser); | ||
| 111 : | |||
| 112 : | my $arg = shift @components; | ||
| 113 : | if (!defined $arg) { # We want the list of problem sets | ||
| 114 : | return WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go; | ||
| 115 : | } elsif ($arg eq "hardcopy") { | ||
| 116 : | my $hardcopyArgument = shift @components; | ||
| 117 : | $hardcopyArgument = "" unless defined $hardcopyArgument; | ||
| 118 : | return WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument); | ||
| 119 : | } elsif ($arg eq "instructor") { | ||
| 120 : | my $instructorArgument = shift @components; | ||
| 121 : | if (!defined $instructorArgument) { | ||
| 122 : | return WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go; | ||
| 123 : | malsyned | 995 | } elsif ($instructorArgument eq "users") { |
| 124 : | sh002i | 986 | return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go; |
| 125 : | malsyned | 995 | } elsif ($instructorArgument eq "sets") { |
| 126 : | my $setID = shift @components; | ||
| 127 : | if (defined $setID) { | ||
| 128 : | malsyned | 1005 | my $setArg = shift @components; |
| 129 : | malsyned | 1015 | if (!defined $setArg) { |
| 130 : | return WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID); | ||
| 131 : | } elsif ($setArg eq "problems") { | ||
| 132 : | malsyned | 1005 | return WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID); |
| 133 : | malsyned | 1015 | } elsif ($setArg eq "users") { |
| 134 : | return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go($setID); | ||
| 135 : | malsyned | 1005 | } |
| 136 : | malsyned | 995 | } else { |
| 137 : | return WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go; | ||
| 138 : | } | ||
| 139 : | sh002i | 986 | } 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 : | gage | 1130 | } elsif ($arg eq "quiz" ) { |
| 151 : | # Gateway quiz capability -- very similar to problem set (initially) | ||
| 152 : | return WeBWorK::ContentGenerator::GatewayQuiz->new($r, $ce, $db)->go(@components); | ||
| 153 : | sh002i | 986 | } else { # We've got the name of a problem set. |
| 154 : | my $problem_set = $arg; | ||
| 155 : | my $ps_arg = shift @components; | ||
| 156 : | |||
| 157 : | if (!defined $ps_arg) { | ||
| 158 : | # list the problems in the problem set | ||
| 159 : | return WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set); | ||
| 160 : | } else { | ||
| 161 : | # We've got the name of a problem | ||
| 162 : | my $problem = $ps_arg; | ||
| 163 : | return WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); | ||
| 164 : | } | ||
| 165 : | } | ||
| 166 : | |||
| 167 : | } | ||
| 168 : | |||
| 169 : | # If the dispatcher doesn't know any modules that want to handle | ||
| 170 : | # the current path, it'll claim that the path does not exist by | ||
| 171 : | # declining the request. | ||
| 172 : | return DECLINED; | ||
| 173 : | } | ||
| 174 : | |||
| 175 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |