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

    1 # Apache::WeBWorK - The WeBWorK dispatcher module
    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
    4 
    5 # PerlModule Apache::WeBWorK
    6 # <Location /webwork>
    7 # SetHandler perl-script
    8 # PerlHandler Apache::WeBWorK::dispatch
    9 # </Location>
   10 
   11 package Apache::WeBWorK;
   12 
   13 use strict;
   14 use Apache::Constants qw(:common REDIRECT);
   15 use Apache::Request;
   16 use WeBWorK::CourseEnvironment;
   17 use WeBWorK::Test;
   18 #use WeBWorK::Authen;
   19 
   20 # registering discontent: wanted to call this dispatch, but mod_perl gave me lip
   21 sub handler() {
   22   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
   23   my $path_info = $r->path_info;
   24   my $path_translated = $r->lookup_uri($path_info)->filename;
   25   my $current_uri = $r->uri;
   26   unless ($path_info) {
   27     $r->header_out(Location => "$current_uri/");
   28     return REDIRECT;
   29   }
   30 
   31   return OK if $r->header_only;
   32   my($junk, @components) = split "/", $path_info;
   33   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   34   my $course = shift @components;
   35   # catch errors in $@
   36   my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
   37   if ($@) {
   38     # TODO: display an error page.  For now, print something mildly useful
   39     return DECLINED;
   40   }
   41 
   42 # if (!WeBWorK::Authen->new($r, $course_env)->authen) {
   43 #   return WeBWorK::Login->new($r, $course_env)->go();
   44 # } else {
   45     if (1) {
   46       return WeBWorK::Test->new($r, $course_env)->go();
   47     }
   48 # }
   49 
   50 
   51 
   52   $r->print(<<END);
   53 COURSE = $course<br>
   54 WEBWORK_ROOT = $webwork_root<br>
   55 URI = <em>$current_uri</em><br>
   56 Path information = <em>$path_info</em><br>
   57 Translated path = <em>$path_translated</em>
   58 </body>
   59 </html>
   60 END
   61 
   62   return OK;
   63 }
   64 
   65 1;
   66 
   67 __END__
   68 
   69 # if (!auth) {
   70 #   loginpage
   71 # } else {
   72 #   dispatch
   73 # }
   74 
   75 
   76 
   77 load some global settings for the system
   78   - apparently, these are going to live in the package Global
   79   - this sucks, since it's not really the global namespace
   80   - but whatever.
   81 
   82 disassemble the URI to some extent
   83   - we need to know the course