[system] / trunk / webwork-modperl / lib / Apache / WeBWorK.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 393 - (download) (as text) (annotate)
Thu Jun 20 16:02:12 2002 UTC (17 years, 5 months ago) by sh002i
File size: 4632 byte(s)
removed PerlModule line -- unnecessary.
-sam

    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 # PerlRequire /path/to/webwork/conf/init.pl
    6 # PerlSetVar webwork_root /path/to/webwork
    7 # <Location /webwork>
    8 # SetHandler perl-script
    9 # PerlHandler Apache::WeBWorK
   10 # </Location>
   11 
   12 # In addition, you will have to edit init.pl in what should be obvious ways.
   13 
   14 package Apache::WeBWorK;
   15 
   16 use strict;
   17 use Apache::Constants qw(:common REDIRECT);
   18 use Apache::Request;
   19 use Data::UUID;
   20 use WeBWorK::CourseEnvironment;
   21 use WeBWorK::Authen;
   22 use WeBWorK::Authz;
   23 use WeBWorK::ContentGenerator::Test;
   24 use WeBWorK::ContentGenerator::Login;
   25 use WeBWorK::ContentGenerator::ProblemSets;
   26 use WeBWorK::ContentGenerator::ProblemSet;
   27 use WeBWorK::ContentGenerator::Problem;
   28 use WeBWorK::Constants qw(SECRET);
   29 
   30 # Yes, this is supposed to be in the global namespace.  We're only setting it if
   31 my $SECRET;
   32 
   33 # Sets up the common environment needed for every subsystem and then dispatches
   34 # the page request to the appropriate content generator.
   35 
   36 # This function has MANY MANY points of exit (return statements)!  woo!
   37 # call it a quirk of my coding style.  I think it makes it easier to read in this case.
   38 
   39 sub handler() {
   40   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
   41 
   42   # This stuff is pretty much copied out of the O'Reilly mod_perl book.
   43   # It's for figuring out the basepath.  I may change this up if I
   44   # find a better way to do it.
   45   my $path_info = $r->path_info;
   46   my $path_translated = $r->lookup_uri($path_info)->filename;
   47   my $current_uri = $r->uri;
   48   my $args = $r->args;
   49 
   50   # If it's a valid WeBWorK URI, it ends in a /.  This is assumed
   51   # alllll over the place.
   52   unless (substr($current_uri,-1) eq '/') {
   53     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
   54     return REDIRECT;
   55   }
   56 
   57   # Create the @components array, which contains the path specified in the URL
   58   my($junk, @components) = split "/", $path_info;
   59   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   60   my $course = shift @components;
   61 
   62   # Try to get the course environment.
   63   my $course_env = eval {WeBWorK::CourseEnvironment->new($webwork_root, $course);};
   64   if ($@) { # If there was an error getting the requested course
   65     # TODO: display an error page.  For now, 404 it.
   66     warn $@;
   67     return DECLINED;
   68   }
   69 
   70   # Freak out if the requested course doesn't exist.  For now, this is just a
   71   # check to see if the course directory exists.
   72   if (!-e $course_env->{webworkDirs}->{courses} . "/$course") {
   73     return DECLINED;
   74   }
   75 
   76 
   77 
   78   ### Begin dispatching ###
   79 
   80   # WeBWorK::Authen::verify erases the passwd field and sets the key field
   81   # if login is successful.
   82   if (!WeBWorK::Authen->new($r, $course_env)->verify) {
   83     return WeBWorK::ContentGenerator::Login->new($r, $course_env)->go;
   84   } else {
   85     # After we are authenticated, there are some things that need to be
   86     # sorted out, Authorization-wize, before we start dispatching to individual
   87     # content generators.
   88     my $effectiveUser = $r->param("effectiveUser");
   89     my $user = $r->param("user");
   90     my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser);
   91     # This hoary statement has the effect of forcing effectiveUser to equal user unless
   92     # the user is otherwise authorized.
   93     if (!defined $effectiveUser || !($user ne $effectiveUser && $su_authorized)) {
   94       $r->param("effectiveUser",$user);
   95     }
   96 
   97     my $arg = shift @components;
   98     if (!defined $arg) { # We want the list of problem sets
   99       return WeBWorK::ContentGenerator::ProblemSets->new($r, $course_env)->go;
  100     } elsif ($arg eq "prof") {
  101       ###
  102     } elsif ($arg eq "prefs") {
  103       ###
  104     } elsif ($arg eq "test") {
  105       return WeBWorK::ContentGenerator::Test->new($r, $course_env)->go;
  106     } else { # We've got the name of a problem set.
  107       my $problem_set = $arg;
  108       my $ps_arg = shift @components;
  109 
  110       if (!defined $ps_arg) {
  111         # list the problems in the problem set
  112         return WeBWorK::ContentGenerator::ProblemSet->new($r, $course_env)->go($problem_set);
  113       } elsif ($ps_arg eq "hardcopy") {
  114         ###
  115       }
  116       else {
  117         # We've got the name of a problem
  118         my $problem = $ps_arg;
  119         return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem);
  120       }
  121     }
  122 
  123   }
  124 
  125   # If the dispatcher doesn't know any modules that want to handle
  126   # the current path, it'll claim that the path does not exist by
  127   # declining the request.
  128   return DECLINED;
  129 }
  130 
  131 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9