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

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package Apache::WeBWorK;
    7 
    8 =head1 NAME
    9 
   10 Apache::WeBWorK - The WeBWorK dispatcher module.
   11 
   12 =cut
   13 
   14 use strict;
   15 use warnings;
   16 use Apache::Constants qw(:common REDIRECT);
   17 use Apache::Request;
   18 use WeBWorK::Authen;
   19 use WeBWorK::Authz;
   20 use WeBWorK::ContentGenerator::Login;
   21 use WeBWorK::ContentGenerator::Hardcopy;
   22 use WeBWorK::ContentGenerator::Problem;
   23 use WeBWorK::ContentGenerator::ProblemSet;
   24 use WeBWorK::ContentGenerator::ProblemSets;
   25 use WeBWorK::ContentGenerator::Test;
   26 use WeBWorK::CourseEnvironment;
   27 
   28 # This module should be installed as a Handler for the location selected for
   29 # WeBWorK on your webserver. Here is an example of a stanza that can be added
   30 # to your httpd.conf file to achieve this:
   31 #
   32 # <IfModule mod_perl.c>
   33 #     PerlFreshRestart On
   34 #     <Location /modperl-sam>
   35 #         SetHandler perl-script
   36 #         PerlSetVar webwork_root /opt/webwork
   37 #         <Perl>
   38 #             use lib '/opt/webwork/lib';
   39 #         </Perl>
   40 #         PerlHandler Apache::WeBWorK
   41 #     </Location>
   42 # </IfModule>
   43 
   44 sub handler() {
   45   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
   46 
   47   # This stuff is pretty much copied out of the O'Reilly mod_perl book.
   48   # It's for figuring out the basepath.  I may change this up if I
   49   # find a better way to do it.
   50   my $path_info = $r->path_info;
   51   my $path_translated = $r->lookup_uri($path_info)->filename;
   52   my $current_uri = $r->uri;
   53   my $args = $r->args;
   54 
   55   # If it's a valid WeBWorK URI, it ends in a /.  This is assumed
   56   # alllll over the place.
   57   unless (substr($current_uri,-1) eq '/') {
   58     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
   59     return REDIRECT;
   60   }
   61 
   62   # Create the @components array, which contains the path specified in the URL
   63   my($junk, @components) = split "/", $path_info;
   64   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   65   my $course = shift @components;
   66 
   67   # If no course was specified, phreak out.
   68   # Eventually, display a list of courses, or something.
   69   unless (defined $course) {
   70     return DECLINED;
   71   }
   72 
   73   # Try to get the course environment.
   74   my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
   75   if ($@) { # If there was an error getting the requested course
   76     # TODO: display an error page.  For now, 404 it.
   77     warn $@;
   78     return DECLINED;
   79   }
   80 
   81   # Freak out if the requested course doesn't exist.  For now, this is just a
   82   # check to see if the course directory exists.
   83   if (!-e $course_env->{webworkDirs}->{courses} . "/$course") {
   84     return DECLINED;
   85   }
   86 
   87   ### Begin dispatching ###
   88 
   89   # WeBWorK::Authen::verify erases the passwd field and sets the key field
   90   # if login is successful.
   91   if (!WeBWorK::Authen->new($r, $course_env)->verify) {
   92     return WeBWorK::ContentGenerator::Login->new($r, $course_env)->go;
   93   } else {
   94     # After we are authenticated, there are some things that need to be
   95     # sorted out, Authorization-wize, before we start dispatching to individual
   96     # content generators.
   97     my $effectiveUser = $r->param("effectiveUser") || "";
   98     my $user = $r->param("user");
   99     my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser);
  100     # This hoary statement has the effect of forcing effectiveUser to equal user unless
  101     # the user is otherwise authorized.
  102     if (!($user ne $effectiveUser && $su_authorized) || !defined $effectiveUser) {
  103       $r->param("effectiveUser",$user);
  104     }
  105 
  106     my $arg = shift @components;
  107     if (!defined $arg) { # We want the list of problem sets
  108       return WeBWorK::ContentGenerator::ProblemSets->new($r, $course_env)->go;
  109     } elsif ($arg eq "hardcopy") {
  110       my $hardcopyArgument = shift @components || "";
  111       return WeBWorK::ContentGenerator::Hardcopy->new($r, $course_env)->go($hardcopyArgument);
  112     } elsif ($arg eq "prof") {
  113       # ***
  114     } elsif ($arg eq "prefs") {
  115       # ***
  116     } elsif ($arg eq "test") {
  117       return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go;
  118     } else { # We've got the name of a problem set.
  119       my $problem_set = $arg;
  120       my $ps_arg = shift @components;
  121 
  122       if (!defined $ps_arg) {
  123         # list the problems in the problem set
  124         return WeBWorK::ContentGenerator::ProblemSet->new($r, $course_env)->go($problem_set);
  125       } elsif ($ps_arg eq "hardcopy") {
  126         ###
  127       }
  128       else {
  129         # We've got the name of a problem
  130         my $problem = $ps_arg;
  131         return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem);
  132       }
  133     }
  134 
  135   }
  136 
  137   # If the dispatcher doesn't know any modules that want to handle
  138   # the current path, it'll claim that the path does not exist by
  139   # declining the request.
  140   return DECLINED;
  141 }
  142 
  143 1;