View of /trunk/webwork2/lib/WeBWorK.pm

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