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 # PerlRequire /path/to/webwork/conf/init.pl
    7 # PerlSetVar webwork_root /path/to/webwork
    8 # <Location /webwork>
    9 # SetHandler perl-script
   10 # PerlHandler Apache::WeBWorK
   11 # </Location>
   12 
   13 # In addition, you will have to edit init.pl in what should be obvious ways.
   14 
   15 package Apache::WeBWorK;
   16 
   17 use strict;
   18 use Apache::Constants qw(:common REDIRECT);
   19 use Apache::Request;
   20 use WeBWorK::CourseEnvironment;
   21 use WeBWorK::Authen;
   22 use WeBWorK::ContentGenerator::Test;
   23 use WeBWorK::ContentGenerator::Login;
   24 use WeBWorK::ContentGenerator::ProblemSets;
   25 use WeBWorK::ContentGenerator::ProblemSet;
   26 use WeBWorK::ContentGenerator::Problem;
   27 
   28 # Sets up the common environment needed for every subsystem and then dispatches
   29 # the page request to the appropriate content generator.
   30 sub handler() {
   31   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
   32 
   33   # This stuff is pretty much copied out of the O'Reilly mod_perl book.
   34   # It's for figuring out the basepath.  I may change this up if I
   35   # find a better way to do it.
   36   my $path_info = $r->path_info;
   37   my $path_translated = $r->lookup_uri($path_info)->filename;
   38   my $current_uri = $r->uri;
   39   my $args = $r->args;
   40 
   41   # If it's a valid WeBWorK URI, it ends in a /.  This is assumed
   42   # alllll over the place.
   43   unless (substr($current_uri,-1) eq '/') {
   44     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
   45     return REDIRECT;
   46   }
   47 
   48   return OK if $r->header_only;
   49 
   50   my($junk, @components) = split "/", $path_info;
   51   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   52   my $course = shift @components;
   53 
   54   # Try to get the course environment.
   55   my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
   56   if ($@) { # If no course exists matching the requested course
   57     # TODO: display an error page.  For now, 404 it.
   58     warn $@;
   59     return DECLINED;
   60   }
   61 
   62   # WeBWorK::Authen::verify erases the passwd field and sets the key field
   63   # if login is successful.
   64   if (!WeBWorK::Authen->new($r, $course_env)->verify) {
   65     return WeBWorK::ContentGenerator::Login->new($r, $course_env)->go;
   66   } else {
   67     my $arg = shift @components;
   68     if (!defined $arg) { # We want the list of problem sets
   69       return WeBWorK::ContentGenerator::ProblemSets->new($r, $course_env)->go;
   70     } elsif ($arg eq "prof") {
   71       ###
   72     } elsif ($arg eq "prefs") {
   73       ###
   74     } elsif ($arg eq "test") {
   75       return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go;
   76     } else { # We've got the name of a problem set.
   77       my $problem_set = $arg;
   78       my $ps_arg = shift @components;
   79 
   80       if (!defined $ps_arg) {
   81         # list the problems in the problem set
   82         return WeBWorK::ContentGenerator::ProblemSet->new($r, $course_env)->go($problem_set);
   83       } elsif ($ps_arg eq "hardcopy") {
   84         ###
   85       }
   86       else {
   87         # We've got the name of a problem
   88         my $problem = $ps_arg;
   89         return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem);
   90       }
   91     }
   92 
   93     if (1) {
   94       return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go;
   95     }
   96   }
   97 
   98   # If the dispatcher doesn't know any modules that want to handle
   99   # the current path, it'll claim that the path does not exist by
  100   # declining the request.
  101   return DECLINED;
  102 }
  103 
  104 1;