--- trunk/webwork2/lib/WeBWorK.pm	2004/02/21 10:15:58	1821
+++ trunk/webwork2/lib/WeBWorK.pm	2004/03/04 21:00:51	1836
@@ -1,7 +1,7 @@
 ################################################################################
 # WeBWorK Online Homework Delivery System
 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
-# $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.48 2004/02/14 00:54:56 sh002i Exp $
+# $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.49 2004/02/21 10:15:58 toenail Exp $
 # 
 # This program is free software; you can redistribute it and/or modify it under
 # the terms of either: (a) the GNU General Public License as published by the
@@ -241,13 +241,12 @@
  	options (User Options) - change email address and password
  	feedback (Feedback) - send feedback to professor via email
  	logout (Logout) - expire session and erase authentication tokens
- 	test (Test) - display request information
  	quiz_mode (Quiz) - "quiz" containing all problems from a set
  	instructor (Instructor Tools) - main menu for instructor tools
- 		add_users (Add Users) - to be removed
+ 		add_users (Add Users) - add users to user list
+ 		assigner (Set Assigner) - assign sets to users
  		scoring (Scoring Tools) - generate scoring files for problem sets
  		scoringDownload - send a scoring file to the client
-  		scoring_totals - ???
 		users (Users) - view/edit users
  			$userID ($userID) - user detail for given user
  				sets (Assigned Sets) - view/edit sets assigned to given user
@@ -288,10 +287,10 @@
 			$contentGenerator = "WeBWorK::ContentGenerator::Logout";
 			@arguments = ();
 		}
-		elsif ($arg eq "test") {
-			$contentGenerator = "WeBWorK::ContentGenerator::Test";
-			@arguments = ();
-		}
+		#elsif ($arg eq "test") {
+		#	$contentGenerator = "WeBWorK::ContentGenerator::Test";
+		#	@arguments = ();
+		#}
 		elsif ($arg eq "quiz_mode" ) {
 			$contentGenerator = "WeBWorK::ContentGenerator::GatewayQuiz";
 			@arguments = @components;
@@ -319,10 +318,6 @@
 				$contentGenerator = "WeBWorK::ContentGenerator::Instructor::Scoring";
 				@arguments = ();
 			}
-# 			elsif ($instructorArgument eq "scoring_totals") {
-# 				$contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringTotals";
-# 				@arguments = ();
-# 			}
 			elsif ($instructorArgument eq "scoringDownload") {
 				$contentGenerator = "WeBWorK::ContentGenerator::Instructor::ScoringDownload";
 				@arguments = ();
@@ -445,7 +440,7 @@
 	if ($contentGenerator) {
 		runtime_use($contentGenerator);
 		my $cg = $contentGenerator->new($r, $ce, $db);
-		@arguments = () unless  @arguments;
+		@arguments = () unless @arguments;
 		$WeBWorK::timer = WeBWorK::Timing->new("${contentGenerator}::go(@arguments)") if $timingON == 1;
 		$WeBWorK::timer->start if $timingON == 1;
 		
@@ -468,6 +463,231 @@
 
 =back
 
+=head1 THE C<&dispatch_new> FUNCTION
+
+=cut
+
+use WeBWorK::Request;
+use WeBWorK::URLPath;
+
+use constant AUTHEN_MODULE => "WeBWorK::ContentGenerator::Login";
+
+sub debug(@) { print STDERR "dispatch_new: ", join("", @_) };
+
+sub dispatch_new($) {
+	my ($apache) = @_;
+	my $r = new WeBWorK::Request $apache;
+	
+	my $method = $r->method;
+	my $location = $r->location;
+	my $uri = $r->uri;
+	my $path_info = $r->path_info | "";
+	my $args = $r->args || "";
+	my $webwork_root = $r->dir_config("webwork_root");
+	my $pg_root = $r->dir_config("pg_root");
+	
+	#$r->send_http_header("text/html");
+	
+	#print CGI::start_pre();
+	
+	debug("Hi, I'm the new dispatcher!\n");
+	debug(("-" x 80) . "\n");
+	
+	debug("Okay, I got some basic information:\n");
+	debug("The apache location is $location\n");
+	debug("The request method is $method\n");
+	debug("The URI is $uri\n");
+	debug("The path-info is $path_info\n");
+	debug("The argument string is $args\n");
+	debug("The WeBWorK root directory is $webwork_root\n");
+	debug("The PG root directory is $pg_root\n");
+	debug(("-" x 80) . "\n");
+	
+	debug("The first thing we need to do is munge the path a little:\n");
+	
+	my ($path) = $uri =~ m/$location(.*)/;
+	$path = "/" if $path eq ""; # no path at all
+	
+	debug("We can't trust the path-info, so we make our own path.\n");
+	debug("path-info claims: $path_info\n");
+	debug("but it's really: $path\n");
+	debug("(if it's empty, we set it to \"/\".)\n");
+	
+	$path =~ s|/+|/|g;
+	debug("...and here it is without repeated slashes: $path\n");
+	
+	# lookbehind assertion for "not a slash"
+	# matches the boundary after the last char
+	$path =~ s|(?<=[^/])$|/|;
+	debug("...and here it is with a trailing slash: $path\n");
+	
+	debug(("-" x 80) . "\n");
+	
+	debug("Now we need to look at the path a little to figure out where we are\n");
+	
+	debug("-------------------- call to WeBWorK::URLPath::newFromPath\n");
+	my $urlPath = newFromPath WeBWorK::URLPath $path;
+	debug("-------------------- call to WeBWorK::URLPath::newFromPath\n");
+	
+	unless ($urlPath) {
+		debug("This path is invalid... see you later!\n");
+		return DECLINED;
+	}
+	
+	my $displayModule = $urlPath->module;
+	my %displayArgs = $urlPath->args;
+	
+	debug("The display module for this path is: $displayModule\n");
+	debug("...and here are the arguments we'll pass to it:\n");
+	foreach my $key (keys %displayArgs) {
+		debug("\t$key => $displayArgs{$key}\n");
+	}
+	
+	unless ($displayModule) {
+		debug("The display module is empty, so we can DECLINE here.\n");
+		return DECLINED;
+	}
+	
+	my $selfPath = $urlPath->path;
+	my $parent = $urlPath->parent;
+	my $parentPath = $parent ? $parent->path : "<no parent>";
+	
+	debug("Reconstructing the original path gets us: $selfPath\n");
+	debug("And we can generate the path to our parent, too: $parentPath\n");
+	debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n");
+	debug(("-" x 80) . "\n");
+	
+	debug("Now we want to look at the parameters we got.\n");
+	
+	debug("The raw params:\n");
+	foreach my $key ($r->param) {
+		debug("\t$key\n");
+		debug("\t\t$_\n") foreach $r->param($key);
+	}
+	
+	mungeParams($r);
+	
+	debug("The munged params:\n");
+	foreach my $key ($r->param) {
+		debug("\t$key\n");
+		debug("\t\t$_\n") foreach $r->param($key);
+	}
+	
+	debug(("-" x 80) . "\n");
+	
+	debug("We need to get a course environment (with or without a courseID!)\n");
+	my $ce = new WeBWorK::CourseEnvironment($webwork_root, $location, $pg_root, $displayArgs{courseID});
+	debug("Here's the course environment: $ce\n");
+	
+	# FIXME: add upload handling here!
+	
+	my ($db, $authz);
+	
+	if ($displayArgs{courseID}) {
+		debug("We got a courseID from the URLPath, now we can do some stuff:\n");
+		debug("...we can create a database object...\n");
+		$db = new WeBWorK::DB($ce->{dbLayout});
+		debug("(here's the DB handle: $db)\n");
+		
+		debug("...and we can authenticate the remote user...\n");
+		my $authen = new WeBWorK::Authen $r, $ce, $db;
+		my $authenOK = $authen->verify;
+		if ($authenOK) {
+			debug("Hi, ", $r->param("user"), ", glad you made it.\n");
+			
+			debug("Authentication succeeded, so it makes sense to create an authz object...\n");
+			$authz = new WeBWorK::Authz $r, $ce, $db;
+			debug("(here's the authz object: $authz)\n");
+			
+			debug("Now we deal with the effective user:\n");
+			my $userID = $r->param("user");
+			my $eUserID = $r->param("effectiveUser") || $userID;
+			debug("userID=$userID eUserID=$eUserID\n");
+			my $su_authorized = $authz->hasPermissions($userID, "become_student", $eUserID);
+			if ($su_authorized) {
+				debug("Ok, looks like you're is allowed to become $eUserID. Whoopie!\n");
+			} else {
+				debug("Uh oh, you're isn't allowed to become $eUserID. Nice try!\n");
+				$eUserID = $userID;
+			}
+			$r->param("effectiveUser" => $eUserID);
+		} else {
+			debug("Bad news: authentication failed!\n");
+			$displayModule = AUTHEN_MODULE;
+			debug("set displayModule to $displayModule\n");
+		}
+	}
+	
+	debug("Now we add \$ce, \$db, \$authz, and \$urlPath to the WeBWorK::Request object.\n");
+	$r->ce($ce);
+	$r->db($db);
+	$r->authz($authz);
+	$r->urlpath($urlPath);
+	
+	debug(("-" x 80) . "\n");
+	debug("Finally, we'll load the display module...\n");
+	
+	runtime_use($displayModule);
+	
+	debug("...instantiate it...\n");
+	
+	# FIXME: change ContentGenerator interface to use WeBWorK::Request
+	my $instance = $displayModule->new($r);
+	
+	debug("...and call it:\n");
+	debug("-------------------- call to ${displayModule}::go\n");
+	#print CGI::end_pre();
+	
+	my $result = $instance->go();
+	
+	#print CGI::start_pre();
+	debug("-------------------- call to ${displayModule}::go\n");
+	#print CGI::end_pre();
+	
+	debug("returning result: $result\n");
+	
+	return $result;
+}
+
+sub mungeParams {
+	my ($r) = @_;
+	
+	my @paramQueue;
+	
+	# remove all the params from the request, and store them in the param queue
+	foreach my $key ($r->param) {
+		push @paramQueue, [ $key => [ $r->param($key) ] ];
+		$r->parms->unset($key)
+	}
+	
+	# exhaust the param queue, decoding encoded params
+	while (@paramQueue) {
+		my ($key, $values) = @{ shift @paramQueue };
+		
+		if ($key =~ m/\,/) {
+			# we have multiple params encoded in a single param
+			# split them up and add them to the end of the queue
+			push @paramQueue, map { [ $_, $values ] } split m/\,/, $key;
+		} elsif ($key =~ m/\:/) {
+			# we have a whole param encoded in a key
+			# split it up and add it to the end of the queue
+			my ($newKey, $newValue) = split m/\:/, $key;
+			push @paramQueue, [ $newKey, [ $newValue ] ];
+		} else {
+			# this is a "normal" param
+			# add it to the param list
+			if (defined $r->param($key)) {
+				# the param already exists -- append the values we have
+				$r->param($key => [ $r->param($key), @$values ]);
+			} else {
+				# the param doesn't exist -- create it with the values we have
+				$r->param($key => $values);
+			}
+		}
+	}
+}
+
+
 =head1 AUTHOR
 
 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam