Parent Directory
| 
Revision Log
handle undef CG result
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.53 2004/03/16 20:00:23 sh002i Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK; 18 19 =head1 NAME 20 21 WeBWorK - Dispatch requests to the appropriate content generator. 22 23 =head1 SYNOPSIS 24 25 my $r = Apache->request; 26 my $result = eval { WeBWorK::dispatch($r) }; 27 die "something bad happened: $@" if $@; 28 29 =head1 DESCRIPTION 30 31 C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request 32 object, it performs authentication and determines which subclass of 33 C<WeBWorK::ContentGenerator> to call. 34 35 =cut 36 37 BEGIN { $main::VERSION = "2.0"; } 38 39 40 my $timingON = 1; 41 42 use strict; 43 use warnings; 44 use Apache::Constants qw(:common REDIRECT DONE); 45 use WeBWorK::Authen; 46 use WeBWorK::Authz; 47 use WeBWorK::CourseEnvironment; 48 use WeBWorK::DB; 49 #use WeBWorK::Timing; 50 use WeBWorK::Upload; 51 use WeBWorK::Utils qw(runtime_use); 52 use WeBWorK::Request; 53 use WeBWorK::URLPath; 54 55 use constant AUTHEN_MODULE => "WeBWorK::ContentGenerator::Login"; 56 57 #sub debug(@) { print STDERR "dispatch_new: ", join("", @_) }; 58 sub debug(@) { }; 59 60 sub dispatch($) { 61 my ($apache) = @_; 62 my $r = new WeBWorK::Request $apache; 63 64 my $method = $r->method; 65 my $location = $r->location; 66 my $uri = $r->uri; 67 my $path_info = $r->path_info | ""; 68 my $args = $r->args || ""; 69 my $webwork_root = $r->dir_config("webwork_root"); 70 my $pg_root = $r->dir_config("pg_root"); 71 72 #$r->send_http_header("text/html"); 73 74 #print CGI::start_pre(); 75 76 debug("Hi, I'm the new dispatcher!\n"); 77 debug(("-" x 80) . "\n"); 78 79 debug("Okay, I got some basic information:\n"); 80 debug("The apache location is $location\n"); 81 debug("The request method is $method\n"); 82 debug("The URI is $uri\n"); 83 debug("The path-info is $path_info\n"); 84 debug("The argument string is $args\n"); 85 debug("The WeBWorK root directory is $webwork_root\n"); 86 debug("The PG root directory is $pg_root\n"); 87 debug(("-" x 80) . "\n"); 88 89 debug("The first thing we need to do is munge the path a little:\n"); 90 91 my ($path) = $uri =~ m/$location(.*)/; 92 $path = "/" if $path eq ""; # no path at all 93 94 debug("We can't trust the path-info, so we make our own path.\n"); 95 debug("path-info claims: $path_info\n"); 96 debug("but it's really: $path\n"); 97 debug("(if it's empty, we set it to \"/\".)\n"); 98 99 $path =~ s|/+|/|g; 100 debug("...and here it is without repeated slashes: $path\n"); 101 102 # lookbehind assertion for "not a slash" 103 # matches the boundary after the last char 104 $path =~ s|(?<=[^/])$|/|; 105 debug("...and here it is with a trailing slash: $path\n"); 106 107 debug(("-" x 80) . "\n"); 108 109 debug("Now we need to look at the path a little to figure out where we are\n"); 110 111 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 112 my $urlPath = WeBWorK::URLPath->newFromPath($path); 113 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 114 115 unless ($urlPath) { 116 debug("This path is invalid... see you later!\n"); 117 return DECLINED; 118 } 119 120 my $displayModule = $urlPath->module; 121 my %displayArgs = $urlPath->args; 122 123 debug("The display module for this path is: $displayModule\n"); 124 debug("...and here are the arguments we'll pass to it:\n"); 125 foreach my $key (keys %displayArgs) { 126 debug("\t$key => $displayArgs{$key}\n"); 127 } 128 129 unless ($displayModule) { 130 debug("The display module is empty, so we can DECLINE here.\n"); 131 return DECLINED; 132 } 133 134 my $selfPath = $urlPath->path; 135 my $parent = $urlPath->parent; 136 my $parentPath = $parent ? $parent->path : "<no parent>"; 137 138 debug("Reconstructing the original path gets us: $selfPath\n"); 139 debug("And we can generate the path to our parent, too: $parentPath\n"); 140 debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n"); 141 debug(("-" x 80) . "\n"); 142 143 debug("The URLPath looks good, we'll add it to the request.\n"); 144 $r->urlpath($urlPath); 145 146 debug("Now we want to look at the parameters we got.\n"); 147 148 debug("The raw params:\n"); 149 foreach my $key ($r->param) { 150 debug("\t$key\n"); 151 debug("\t\t$_\n") foreach $r->param($key); 152 } 153 154 #mungeParams($r); 155 156 debug("The munged params:\n"); 157 foreach my $key ($r->param) { 158 debug("\t$key\n"); 159 debug("\t\t$_\n") foreach $r->param($key); 160 } 161 162 debug(("-" x 80) . "\n"); 163 164 debug("We need to get a course environment (with or without a courseID!)\n"); 165 my $ce = new WeBWorK::CourseEnvironment($webwork_root, $location, $pg_root, $displayArgs{courseID}); 166 debug("Here's the course environment: $ce\n"); 167 $r->ce($ce); 168 169 my @uploads = $r->upload; 170 foreach my $u (@uploads) { 171 # make sure it's a "real" upload 172 next unless $u->filename; 173 174 # store the upload 175 my $upload = WeBWorK::Upload->store($u, 176 dir => $ce->{webworkDirs}->{uploadCache} 177 ); 178 179 # store the upload ID and hash in the file upload field 180 my $id = $upload->id; 181 my $hash = $upload->hash; 182 $r->param($u->name => "$id $hash"); 183 } 184 185 my ($db, $authz); 186 187 if ($displayArgs{courseID}) { 188 debug("We got a courseID from the URLPath, now we can do some stuff:\n"); 189 debug("...we can create a database object...\n"); 190 $db = new WeBWorK::DB($ce->{dbLayout}); 191 debug("(here's the DB handle: $db)\n"); 192 $r->db($db); 193 194 debug("...and we can authenticate the remote user...\n"); 195 my $authen = new WeBWorK::Authen($r); 196 my $authenOK = $authen->verify; 197 if ($authenOK) { 198 debug("Hi, ", $r->param("user"), ", glad you made it.\n"); 199 200 debug("Authentication succeeded, so it makes sense to create an authz object...\n"); 201 $authz = new WeBWorK::Authz($r, $ce, $db); 202 debug("(here's the authz object: $authz)\n"); 203 $r->authz($authz); 204 205 debug("Now we deal with the effective user:\n"); 206 my $userID = $r->param("user"); 207 my $eUserID = $r->param("effectiveUser") || $userID; 208 debug("userID=$userID eUserID=$eUserID\n"); 209 my $su_authorized = $authz->hasPermissions($userID, "become_student", $eUserID); 210 if ($su_authorized) { 211 debug("Ok, looks like you're is allowed to become $eUserID. Whoopie!\n"); 212 } else { 213 debug("Uh oh, you're isn't allowed to become $eUserID. Nice try!\n"); 214 $eUserID = $userID; 215 } 216 $r->param("effectiveUser" => $eUserID); 217 } else { 218 debug("Bad news: authentication failed!\n"); 219 $displayModule = AUTHEN_MODULE; 220 debug("set displayModule to $displayModule\n"); 221 } 222 } 223 224 debug(("-" x 80) . "\n"); 225 debug("Finally, we'll load the display module...\n"); 226 227 runtime_use($displayModule); 228 229 debug("...instantiate it...\n"); 230 231 my $instance = $displayModule->new($r); 232 233 debug("...and call it:\n"); 234 debug("-------------------- call to ${displayModule}::go\n"); 235 236 my $result = $instance->go(); 237 238 debug("-------------------- call to ${displayModule}::go\n"); 239 240 debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n"); 241 242 return $result; 243 } 244 245 sub mungeParams { 246 my ($r) = @_; 247 248 my @paramQueue; 249 250 # remove all the params from the request, and store them in the param queue 251 foreach my $key ($r->param) { 252 push @paramQueue, [ $key => [ $r->param($key) ] ]; 253 $r->parms->unset($key) 254 } 255 256 # exhaust the param queue, decoding encoded params 257 while (@paramQueue) { 258 my ($key, $values) = @{ shift @paramQueue }; 259 260 if ($key =~ m/\,/) { 261 # we have multiple params encoded in a single param 262 # split them up and add them to the end of the queue 263 push @paramQueue, map { [ $_, $values ] } split m/\,/, $key; 264 } elsif ($key =~ m/\:/) { 265 # we have a whole param encoded in a key 266 # split it up and add it to the end of the queue 267 my ($newKey, $newValue) = split m/\:/, $key; 268 push @paramQueue, [ $newKey, [ $newValue ] ]; 269 } else { 270 # this is a "normal" param 271 # add it to the param list 272 if (defined $r->param($key)) { 273 # the param already exists -- append the values we have 274 $r->param($key => [ $r->param($key), @$values ]); 275 } else { 276 # the param doesn't exist -- create it with the values we have 277 $r->param($key => $values); 278 } 279 } 280 } 281 } 282 283 284 =head1 AUTHOR 285 286 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 287 Hathaway, sh002i at math.rochester.edu. 288 289 =cut 290 291 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |