[system] / trunk / webwork-modperl / lib / Apache / WeBWorK.pm Repository:
ViewVC logotype

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

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

Revision 283 Revision 343
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;
14use Apache::Constants qw(:common REDIRECT); 16use Apache::Constants qw(:common REDIRECT);
17use Apache::Request;
15use WeBWorK::CourseEnvironment; 18use WeBWorK::CourseEnvironment;
16use Apache::Request; 19use WeBWorK::Test;
20use WeBWorK::Authen;
21use WeBWorK::Login;
22use WeBWorK::ProblemSets;
23use WeBWorK::ProblemSet;
24use WeBWorK::Problem;
17 25
18# 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
19sub handler() { 27sub handler() {
20 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.
21 my $path_info = $r->path_info; 33 my $path_info = $r->path_info;
22 my $path_translated = $r->lookup_uri($path_info)->filename; 34 my $path_translated = $r->lookup_uri($path_info)->filename;
23 my $current_uri = $r->uri; 35 my $current_uri = $r->uri;
24 unless ($path_info) { 36 my $args = $r->args;
37
38 # If it's a valid WeBWorK URI, it ends in a /. This is assumed
39 # alllll over the place.
40 unless (substr($current_uri,-1) eq '/') {
25 $r->header_out(Location => "$current_uri/"); 41 $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
26 return REDIRECT; 42 return REDIRECT;
27 } 43 }
28 44
29 $r->content_type('text/html');
30 $r->send_http_header;
31 return OK if $r->header_only; 45 return OK if $r->header_only;
46
32 my($junk, @components) = split "/", $path_info; 47 my($junk, @components) = split "/", $path_info;
33 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 48 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
34 my $course = shift @components; 49 my $course = shift @components;
35 # catch errors in $@ 50
51 # Try to get the course environment.
36 my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);}; 52 my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
37 if ($@) { 53 if ($@) { # If no course exists matching the requested course
38 # TODO: display an error page. For now, print something mildly useful 54 # TODO: display an error page. For now, 404 it.
39 $r->print('<p><font color=red>'.$@.'</font></p>'); 55 return DECLINED;
40 } 56 }
41 57
42 # These values are part of the standard webwork form, and at least two 58 # WeBWorK::Authen::verify erases the passwd field and sets the key field
43 # of them should appear in every form on the system. Depending on when 59 # if login is successful.
44 # you are reading this, this may or may not be enforced in the code. 60 if (!WeBWorK::Authen->new($r, $course_env)->verify) {
45 $user = $r->param('user'); 61 return WeBWorK::Login->new($r, $course_env)->go;
46 $passwd = $r->param('passwd'); 62 } else {
47 $key = $r->param('key'); 63 my $arg = shift @components;
48 64 if (!defined $arg) { # We want the list of problem sets
49 65 return WeBWorK::ProblemSets->new($r, $course_env)->go;
50 66 } elsif ($arg eq "prof") {
51 $r->print(<<END); 67 ###
52COURSE = $course<br> 68 } elsif ($arg eq "prefs") {
53WEBWORK_ROOT = $webwork_root<br> 69 ###
54URI = <em>$current_uri</em><br> 70 } else { # We've got the name of a problem set.
55Path information = <em>$path_info</em><br> 71 my $problem_set = $arg;
56Translated path = <em>$path_translated</em> 72 my $ps_arg = shift @components;
57</body>
58</html>
59END
60 73
61 return OK; 74 if (!defined $ps_arg) {
75 # list the problems in the problem set
76 return WeBWorK::ProblemSet->new($r, $course_env)->go($problem_set);
77 } elsif ($ps_arg eq "hardcopy") {
78 ###
79 }
80 else {
81 # We've got the name of a problem
82 my $problem = $ps_arg;
83 return WeBWorK::Problem->new($r, $course_env)->go($problem_set, $problem);
84 }
85 }
86
87 if (1) {
88 return WeBWorK::Test->new($r, $course_env)->go;
89 }
90 }
91
92 # If the dispatcher doesn't know any modules that want to handle
93 # the current path, it'll claim that the path does not exist by
94 # declining the request.
95 return DECLINED;
62} 96}
63 97
641; 981;
65
66__END__
67
68# if (!auth) {
69# loginpage
70# } else {
71# dispatch
72# }
73
74
75
76load some global settings for the system
77 - apparently, these are going to live in the package Global
78 - this sucks, since it's not really the global namespace
79 - but whatever.
80
81disassemble the URI to some extent
82 - we need to know the course
Legend:
Removed from v.283  
changed lines
  Added in v.343
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9