[system] / trunk / webwork2 / lib / Apache / WeBWorK.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/Apache/WeBWorK.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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
11package Apache::WeBWorK; 13package Apache::WeBWorK;
12 14
13use strict; 15use strict;
15use Apache::Request; 17use Apache::Request;
16use WeBWorK::CourseEnvironment; 18use WeBWorK::CourseEnvironment;
17use WeBWorK::Test; 19use WeBWorK::Test;
18use WeBWorK::Authen; 20use WeBWorK::Authen;
19use WeBWorK::Login; 21use WeBWorK::Login;
22use WeBWorK::ProblemSets;
23use WeBWorK::ProblemSet;
24use 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
22sub handler() { 27sub 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
561; 941;
57
58__END__
59
60# if (!auth) {
61# loginpage
62# } else {
63# dispatch
64# }
65
66
67
68load 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
73disassemble the URI to some extent
74 - we need to know the course

Legend:
Removed from v.322  
changed lines
  Added in v.323

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9