View of /trunk/webwork2/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::Feedback;
   21 use WeBWorK::ContentGenerator::Login;
   22 use WeBWorK::ContentGenerator::Logout;
   23 use WeBWorK::ContentGenerator::Hardcopy;
   24 use WeBWorK::ContentGenerator::Options;
   25 use WeBWorK::ContentGenerator::Problem;
   26 use WeBWorK::ContentGenerator::ProblemSet;
   27 use WeBWorK::ContentGenerator::ProblemSets;
   28 use WeBWorK::ContentGenerator::Professor;
   29 use WeBWorK::ContentGenerator::Instructor;
   30 use WeBWorK::ContentGenerator::Test;
   31 use WeBWorK::CourseEnvironment;
   32 use WeBWorK::DB;
   33 
   34 # This module should be installed as a Handler for the location selected for
   35 # WeBWorK on your webserver. Here is an example of a stanza that can be added
   36 # to your httpd.conf file to achieve this:
   37 #
   38 # <IfModule mod_perl.c>
   39 #   PerlFreshRestart On
   40 #   <Location /webwork>
   41 #     SetHandler perl-script
   42 #     PerlHandler Apache::WeBWorK
   43 #     PerlSetVar webwork_root /path/to/webwork-modperl
   44 #     <Perl>
   45 #       use lib '/path/to/webwork-modperl/lib';
   46 #       use lib '/path/to/webwork-modperl/pglib';
   47 #     </Perl>
   48 #   </Location>
   49 # </IfModule>
   50 
   51 sub handler() {
   52   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
   53 
   54   # This stuff is pretty much copied out of the O'Reilly mod_perl book.
   55   # It's for figuring out the basepath.  I may change this up if I
   56   # find a better way to do it.
   57   my $path_info = $r->path_info || "";
   58   my $current_uri = $r->uri;
   59   my $args = $r->args;
   60 
   61   $current_uri =~ m/^(.*)$path_info/;
   62   my $urlRoot = $1;
   63 
   64   # If it's a valid WeBWorK URI, it ends in a /.  This is assumed
   65   # alllll over the place.
   66   unless (substr($current_uri,-1) eq '/') {
   67     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
   68     return REDIRECT;
   69     # *** any post data gets lost here -- fix that.
   70   }
   71 
   72   # Create the @components array, which contains the path specified in the URL
   73   my($junk, @components) = split "/", $path_info;
   74   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   75   my $course = shift @components;
   76 
   77   # Try to get the course environment.
   78   my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $course);};
   79   if ($@) { # If there was an error getting the requested course
   80     # TODO: display an error page.  For now, 404 it.
   81     warn $@;
   82     return DECLINED;
   83   }
   84 
   85   # If no course was specified, redirect to the home URL
   86   unless (defined $course) {
   87     $r->header_out(Location => $ce->{webworkURLs}->{home});
   88     return REDIRECT;
   89   }
   90 
   91   # Freak out if the requested course doesn't exist.  For now, this is just a
   92   # check to see if the course directory exists.
   93   if (!-e $ce->{webworkDirs}->{courses} . "/$course") {
   94     warn "Course directory for $course not found at "
   95       . $ce->{webworkDirs}->{courses} . "/$course" ."\n";
   96     return DECLINED;
   97   }
   98 
   99   # Bring up a connection to the database (for Authen/Authz, and eventually
  100   # to be passed to content generators, when we clean this file up).
  101   my $db = WeBWorK::DB->new($ce);
  102 
  103   ### Begin dispatching ###
  104 
  105   # WeBWorK::Authen::verify erases the passwd field and sets the key field
  106   # if login is successful.
  107   if (!WeBWorK::Authen->new($r, $ce, $db)->verify) {
  108     return WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go;
  109   } else {
  110     # After we are authenticated, there are some things that need to be
  111     # sorted out, Authorization-wize, before we start dispatching to individual
  112     # content generators.
  113     my $user = $r->param("user");
  114     my $effectiveUser = $r->param("effectiveUser") || $user;
  115     my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser);
  116     $effectiveUser = $user unless $su_authorized;
  117     $r->param("effectiveUser", $effectiveUser);
  118 
  119     my $arg = shift @components;
  120     if (!defined $arg) { # We want the list of problem sets
  121       return WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go;
  122     } elsif ($arg eq "hardcopy") {
  123       my $hardcopyArgument = shift @components;
  124       $hardcopyArgument = "" unless defined $hardcopyArgument;
  125       return WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument);
  126     } elsif ($arg eq "instructor") {
  127       my $instructorArgument = shift @components;
  128       if (!defined $instructorArgument) {
  129         return WeBWorK::ContentGenerator::Instructor->new($r, $ce, $db)->go;
  130       } else {
  131 
  132       }
  133     } elsif ($arg eq "prof") {
  134       return WeBWorK::ContentGenerator::Professor->new($r, $ce, $db)->go;
  135     } elsif ($arg eq "options") {
  136       return WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go;
  137     } elsif ($arg eq "feedback") {
  138       return WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go;
  139     } elsif ($arg eq "logout") {
  140       return WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go;
  141     } elsif ($arg eq "test") {
  142       return WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go;
  143     } else { # We've got the name of a problem set.
  144       my $problem_set = $arg;
  145       my $ps_arg = shift @components;
  146 
  147       if (!defined $ps_arg) {
  148         # list the problems in the problem set
  149         return WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set);
  150       } else {
  151         # We've got the name of a problem
  152         my $problem = $ps_arg;
  153         return WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem);
  154       }
  155     }
  156 
  157   }
  158 
  159   # If the dispatcher doesn't know any modules that want to handle
  160   # the current path, it'll claim that the path does not exist by
  161   # declining the request.
  162   return DECLINED;
  163 }
  164 
  165 1;