Parent Directory
| 
Revision Log
moved PG modules and macro files from webwork-modperl to pg -sam
1 ################################################################################ 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 use WeBWorK::ContentGenerator::Instructor::ProblemList; 28 use WeBWorK::ContentGenerator::Instructor::UserList; 29 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 use WeBWorK::ContentGenerator::ProblemSets; 35 use WeBWorK::ContentGenerator::Test; 36 use WeBWorK::CourseEnvironment; 37 use WeBWorK::DB; 38 39 sub dispatch($) { 40 my ($apache) = @_; 41 my $r = Apache::Request->new($apache); 42 # have to deal with unpredictable GET or POST data, and sift 43 # through it for the key. So use Apache::Request 44 45 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 46 # It's for figuring out the basepath. I may change this up if I find a 47 # better way to do it. 48 my $path_info = $r->path_info || ""; 49 $path_info =~ s!/+!/!g; # strip multiple forward slashes 50 my $current_uri = $r->uri; 51 my $args = $r->args; 52 53 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; 54 55 # If it's a valid WeBWorK URI, it ends in a /. This is assumed 56 # alllll over the place. 57 unless (substr($current_uri,-1) eq '/') { 58 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); 59 return REDIRECT; 60 # *** any post data gets lost here -- fix that. 61 } 62 63 # Create the @components array, which contains the path specified in the URL 64 my($junk, @components) = split "/", $path_info; 65 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 66 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf 67 my $course = shift @components; 68 69 # Try to get the course environment. 70 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);}; 71 if ($@) { # If there was an error getting the requested course 72 # TODO: display an error page. For now, 404 it. 73 warn $@; 74 return DECLINED; 75 } 76 77 # If no course was specified, redirect to the home URL 78 unless (defined $course) { 79 $r->header_out(Location => $ce->{webworkURLs}->{home}); 80 return REDIRECT; 81 } 82 83 # Freak out if the requested course doesn't exist. For now, this is just a 84 # check to see if the course directory exists. 85 if (!-e $ce->{webworkDirs}->{courses} . "/$course") { 86 warn "Course directory for $course not found at " 87 . $ce->{webworkDirs}->{courses} . "/$course" ."\n"; 88 return DECLINED; 89 } 90 91 # Bring up a connection to the database (for Authen/Authz, and eventually 92 # to be passed to content generators, when we clean this file up). 93 my $db = WeBWorK::DB->new($ce); 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, $ce, $db)->verify) { 100 return WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->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 $user = $r->param("user"); 106 my $effectiveUser = $r->param("effectiveUser") || $user; 107 my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser); 108 $effectiveUser = $user unless $su_authorized; 109 $r->param("effectiveUser", $effectiveUser); 110 111 my $arg = shift @components; 112 if (!defined $arg) { # We want the list of problem sets 113 return WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go; 114 } elsif ($arg eq "hardcopy") { 115 my $hardcopyArgument = shift @components; 116 $hardcopyArgument = "" unless defined $hardcopyArgument; 117 return WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument); 118 } elsif ($arg eq "instructor") { 119 my $instructorArgument = shift @components; 120 if (!defined $instructorArgument) { 121 return WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go; 122 } elsif ($instructorArgument eq "users") { 123 return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go; 124 } elsif ($instructorArgument eq "sets") { 125 my $setID = shift @components; 126 if (defined $setID) { 127 my $setArg = shift @components; 128 if (!defined $setArg) { 129 return WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID); 130 } elsif ($setArg eq "problems") { 131 return WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID); 132 } elsif ($setArg eq "users") { 133 return WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go($setID); 134 } 135 } else { 136 return WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go; 137 } 138 } elsif ($instructorArgument eq "pgProblemEditor") { 139 return WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components); 140 } 141 } elsif ($arg eq "options") { 142 return WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go; 143 } elsif ($arg eq "feedback") { 144 return WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go; 145 } elsif ($arg eq "logout") { 146 return WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go; 147 } elsif ($arg eq "test") { 148 return WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go; 149 } else { # We've got the name of a problem set. 150 my $problem_set = $arg; 151 my $ps_arg = shift @components; 152 153 if (!defined $ps_arg) { 154 # list the problems in the problem set 155 return WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set); 156 } else { 157 # We've got the name of a problem 158 my $problem = $ps_arg; 159 return WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem); 160 } 161 } 162 163 } 164 165 # If the dispatcher doesn't know any modules that want to handle 166 # the current path, it'll claim that the path does not exist by 167 # declining the request. 168 return DECLINED; 169 } 170 171 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |