Diff of /trunk/webwork-modperl/lib/Apache/WeBWorK.pm

Revision 322		Revision 323
1	# Apache::WeBWorK - The WeBWorK dispatcher module	1	# Apache::WeBWorK - The WeBWorK dispatcher module
2	# Place something like the following in your Apache configuration to load the	2	# Place something like the following in your Apache configuration to load the
3	# WeBWorK module and install it as a handler for the WeBWorK system	3	# WeBWorK module and install it as a handler for the WeBWorK system
4		4
5	# PerlModule Apache::WeBWorK	5	# PerlModule Apache::WeBWorK
		6	# PerlRequire /path/to/webwork/conf/init.pl
		7	# PerlSetVar webwork_root /path/to/webwork
6	# <Location /webwork>	8	# <Location /webwork>
7	# SetHandler perl-script	9	# SetHandler perl-script
8	# PerlHandler Apache::WeBWorK::dispatch	10	# PerlHandler Apache::WeBWorK
9	# </Location>	11	# </Location>
10		12
11	package Apache::WeBWorK;	13	package Apache::WeBWorK;
12		14
13	use strict;	15	use strict;
…		…
15	use Apache::Request;	17	use Apache::Request;
16	use WeBWorK::CourseEnvironment;	18	use WeBWorK::CourseEnvironment;
17	use WeBWorK::Test;	19	use WeBWorK::Test;
18	use WeBWorK::Authen;	20	use WeBWorK::Authen;
19	use WeBWorK::Login;	21	use WeBWorK::Login;
		22	use WeBWorK::ProblemSets;
		23	use WeBWorK::ProblemSet;
		24	use WeBWorK::Problem;
20		25
21	# registering discontent: wanted to call this dispatch, but mod_perl gave me lip	26	# registering discontent: wanted to call this dispatch, but mod_perl gave me lip
22	sub handler() {	27	sub handler() {
23	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	28	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
		29
		30	# This stuff is pretty much copied out of the O'Reilly mod_perl book.
		31	# It's for figuring out the basepath. I may change this up if I
		32	# find a better way to do it.
24	my $path_info = $r->path_info;	33	my $path_info = $r->path_info;
25	my $path_translated = $r->lookup_uri($path_info)->filename;	34	my $path_translated = $r->lookup_uri($path_info)->filename;
26	my $current_uri = $r->uri;	35	my $current_uri = $r->uri;
27	unless ($path_info) {	36	unless ($path_info) {
28	$r->header_out(Location => "$current_uri/");	37	$r->header_out(Location => "$current_uri/");
29	return REDIRECT;	38	return REDIRECT;
30	}	39	}
31		40
32	return OK if $r->header_only;	41	return OK if $r->header_only;
		42
33	my($junk, @components) = split "/", $path_info;	43	my($junk, @components) = split "/", $path_info;
34	my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf	44	my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
35	my $course = shift @components;	45	my $course = shift @components;
36	# catch errors in $@	46
		47	# Try to get the course environment.
37	my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};	48	my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
38	if ($@) {	49	if ($@) { # If no course exists matching the requested course
39	# TODO: display an error page. For now, print something mildly useful	50	# TODO: display an error page. For now, 404 it.
40	return DECLINED;	51	return DECLINED;
41	}	52	}
42		53
43	# WeBWorK::Authen::verify erases the passwd field and sets the key field	54	# WeBWorK::Authen::verify erases the passwd field and sets the key field
44	# if login is successful.	55	# if login is successful.
45	if (!WeBWorK::Authen->new($r, $course_env)->verify) {	56	if (!WeBWorK::Authen->new($r, $course_env)->verify) {
46	return WeBWorK::Login->new($r, $course_env)->go();	57	return WeBWorK::Login->new($r, $course_env)->go;
47	} else {	58	} else {
		59	my $arg = shift @components;
		60	if (!defined $arg) { # We want the list of problem sets
		61	return WeBWorK::ProblemSets->new($r, $course_env)->go;
		62	} elsif ($arg eq "prof") {
		63	###
		64	} elsif ($arg eq "prefs") {
		65	###
		66	} else { # We've got the name of a problem set.
		67	my $problem_set = $arg;
		68	my $ps_arg = shift @components;
		69
		70	if (!defined $ps_arg) {
		71	# list the problems in the problem set
		72	return WeBWorK::ProblemSet->new($r, $course_env)->go($problem_set);
		73	} elsif ($ps_arg eq "hardcopy") {
		74	###
		75	}
		76	else {
		77	# We've got the name of a problem
		78	my $problem = $ps_arg;
		79	return WeBWorK::Problem->new($r, $course_env)->go($problem_set, $problem);
		80	}
		81	}
		82
48	if (1) {	83	if (1) {
49	return WeBWorK::Test->new($r, $course_env)->go();	84	return WeBWorK::Test->new($r, $course_env)->go;
50	}	85	}
51	}	86	}
52		87
		88	# If the dispatcher doesn't know any modules that want to handle
		89	# the current path, it'll claim that the path does not exist by
		90	# declining the request.
53	return DECLINED;	91	return DECLINED;
54	}	92	}
55		93
56	1;	94	1;
57
58	__END__
59
60	# if (!auth) {
61	# loginpage
62	# } else {
63	# dispatch
64	# }
65
66
67
68	load some global settings for the system
69	- apparently, these are going to live in the package Global
70	- this sucks, since it's not really the global namespace
71	- but whatever.
72
73	disassemble the URI to some extent
74	- we need to know the course

 Legend:



Removed from v.322
 


changed lines


 
Added in v.323
 Legend:



Removed from v.322
 


changed lines


 
Added in v.323
-Removed from v.322
+Added in v.323

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9