[system] / trunk / webwork2 / lib / WeBWorK.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1447 - (download) (as text) (annotate)
Mon Aug 4 08:06:10 2003 UTC (9 years, 9 months ago) by malsyned
File size: 9480 byte(s)
Added scoreDownload URL for ScoreDownload.pm module

    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 DONE);
   17 use Apache::Request;
   18 use WeBWorK::Authen;
   19 use WeBWorK::Authz;
   20 use WeBWorK::ContentGenerator::Feedback;
   21 use WeBWorK::ContentGenerator::GatewayQuiz;
   22 use WeBWorK::ContentGenerator::Hardcopy;
   23 use WeBWorK::ContentGenerator::Instructor::Assigner;
   24 use WeBWorK::ContentGenerator::Instructor::Index;
   25 use WeBWorK::ContentGenerator::Instructor::PGProblemEditor;
   26 use WeBWorK::ContentGenerator::Instructor::ProblemList;
   27 use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor;
   28 use WeBWorK::ContentGenerator::Instructor::ProblemSetList;
   29 use WeBWorK::ContentGenerator::Instructor::UserList;
   30 use WeBWorK::ContentGenerator::Instructor::SendMail;
   31 use WeBWorK::ContentGenerator::Instructor::ShowAnswers;
   32 use WeBWorK::ContentGenerator::Instructor::Scoring;
   33 use WeBWorK::ContentGenerator::Instructor::ScoringDownload;
   34 use WeBWorK::ContentGenerator::Instructor::ScoringTotals;
   35 use WeBWorK::ContentGenerator::Instructor::Stats;
   36 use WeBWorK::ContentGenerator::Login;
   37 use WeBWorK::ContentGenerator::Logout;
   38 use WeBWorK::ContentGenerator::Options;
   39 use WeBWorK::ContentGenerator::Problem;
   40 use WeBWorK::ContentGenerator::ProblemSet;
   41 use WeBWorK::ContentGenerator::ProblemSets;
   42 use WeBWorK::ContentGenerator::Test;
   43 use WeBWorK::CourseEnvironment;
   44 use WeBWorK::DB;
   45 use WeBWorK::Timing;
   46 
   47 #sub dispatch($) {
   48 # print STDERR "Executing &WeBWorK::dispatch\n";
   49 # return DECLINED;
   50 #}
   51 #1;
   52 #__END__
   53 
   54 sub dispatch($) {
   55   my ($apache) = @_;
   56   my $r = Apache::Request->new($apache);
   57     # have to deal with unpredictable GET or POST data, and sift
   58     # through it for the key. So use Apache::Request
   59 
   60   # This stuff is pretty much copied out of the O'Reilly mod_perl book.
   61   # It's for figuring out the basepath. I may change this up if I find a
   62   # better way to do it.
   63   my $path_info = $r->path_info || "";
   64   $path_info =~ s!/+!/!g; # strip multiple forward slashes
   65   my $current_uri = $r->uri;
   66   my $args = $r->args;
   67 
   68   my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/;
   69 
   70   # If it's a valid WeBWorK URI, it ends in a /.  This is assumed
   71   # alllll over the place.
   72   unless (substr($current_uri,-1) eq '/') {
   73     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
   74     return REDIRECT;
   75     # *** any post data gets lost here -- fix that.
   76     # (actually, it's not a problem, since all URLs generated
   77     # from within the system have trailing slashes, and we don't
   78     # need POST data from outside the system anyway!)
   79   }
   80 
   81   # Create the @components array, which contains the path specified in the URL
   82   my($junk, @components) = split "/", $path_info;
   83   my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
   84   my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf
   85   my $course = shift @components;
   86 
   87   # Try to get the course environment.
   88   my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);};
   89   if ($@) { # If there was an error getting the requested course
   90     die "Failed to read course environment for $course: $@";
   91   }
   92 
   93   # If no course was specified, redirect to the home URL
   94   unless (defined $course) {
   95     $r->header_out(Location => $ce->{webworkURLs}->{home});
   96     return REDIRECT;
   97   }
   98 
   99   # Freak out if the requested course doesn't exist.  For now, this is just a
  100   # check to see if the course directory exists.
  101   my $courseDir = $ce->{webworkDirs}->{courses} . "/$course";
  102   unless (-e $courseDir) {
  103     die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?";
  104   }
  105 
  106   # Bring up a connection to the database (for Authen/Authz, and eventually
  107   # to be passed to content generators, when we clean this file up).
  108   my $db = WeBWorK::DB->new($ce);
  109 
  110   ### Begin dispatching ###
  111 
  112   #my $dispatchTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch");
  113   #$dispatchTimer->start;
  114 
  115   my $result;
  116   # WeBWorK::Authen::verify erases the passwd field and sets the key field
  117   # if login is successful.
  118   if (!WeBWorK::Authen->new($r, $ce, $db)->verify) {
  119     $result = WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go;
  120   } else {
  121     # After we are authenticated, there are some things that need to be
  122     # sorted out, Authorization-wize, before we start dispatching to individual
  123     # content generators.
  124     my $user = $r->param("user");
  125     my $effectiveUser = $r->param("effectiveUser") || $user;
  126     my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser);
  127     $effectiveUser = $user unless $su_authorized;
  128     $r->param("effectiveUser", $effectiveUser);
  129 
  130     my $arg = shift @components;
  131     if (!defined $arg) { # We want the list of problem sets
  132       $result = WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go;
  133     } elsif ($arg eq "hardcopy") {
  134 
  135       my $hardcopyArgument = shift @components;
  136       $hardcopyArgument = "" unless defined $hardcopyArgument;
  137       $WeBWorK::timer1 = WeBWorK::Timing->new("hardcopy: $hardcopyArgument");
  138       $WeBWorK::timer1->start;
  139 
  140       my $result = WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument);
  141       $WeBWorK::timer1 ->stop;
  142       $WeBWorK::timer1 ->save;
  143       return $result;
  144     } elsif ($arg eq "instructor") {
  145       my $instructorArgument = shift @components;
  146       if (!defined $instructorArgument) {
  147         $result = WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go;
  148       } elsif ($instructorArgument eq "scoring") {
  149         $result = WeBWorK::ContentGenerator::Instructor::Scoring->new($r, $ce, $db)->go; #FIXME!!!!
  150       } elsif ($instructorArgument eq "scoringDownload") {
  151         $result = WeBWorK::ContentGenerator::Instructor::ScoringDownload->new($r, $ce, $db)->go;
  152       } elsif ($instructorArgument eq "scoring_totals") {
  153         $result = WeBWorK::ContentGenerator::Instructor::ScoringTotals->new($r, $ce, $db)->go;
  154       } elsif ($instructorArgument eq "users") {
  155         $result = WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go;
  156       } elsif ($instructorArgument eq "sets") {
  157         my $setID = shift @components;
  158         if (defined $setID) {
  159           my $setArg = shift @components;
  160           if (!defined $setArg) {
  161             $result = WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID);
  162           } elsif ($setArg eq "problems") {
  163             $result = WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID);
  164           } elsif ($setArg eq "users") {
  165             $result = WeBWorK::ContentGenerator::Instructor::Assigner->new($r, $ce, $db)->go($setID);
  166           }
  167         } else {
  168           $result = WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go;
  169         }
  170       } elsif ($instructorArgument eq "pgProblemEditor") {
  171         $result = WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components);
  172       } elsif ($instructorArgument eq "send_mail") {
  173         $result = WeBWorK::ContentGenerator::Instructor::SendMail->new($r, $ce, $db)->go(@components);
  174       } elsif ($instructorArgument eq "show_answers") {
  175         $result = WeBWorK::ContentGenerator::Instructor::ShowAnswers->new($r, $ce, $db)->go(@components);
  176       } elsif ($instructorArgument eq "stats") {
  177         $result = WeBWorK::ContentGenerator::Instructor::Stats->new($r, $ce, $db)->go(@components);
  178       }
  179     } elsif ($arg eq "options") {
  180       $result = WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go;
  181     } elsif ($arg eq "feedback") {
  182       $result = WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go;
  183     } elsif ($arg eq "logout") {
  184       $result = WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go;
  185     } elsif ($arg eq "test") {
  186       $result = WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go;
  187     } elsif ($arg eq "quiz_mode" ) {
  188       # Gateway quiz capability -- very similar to problem set (initially)
  189       $result = WeBWorK::ContentGenerator::GatewayQuiz->new($r, $ce, $db)->go(@components);
  190     } else { # We've got the name of a problem set.
  191       my $problem_set = $arg;
  192       my $ps_arg = shift @components;
  193 
  194       if (!defined $ps_arg) {
  195         # list the problems in the problem set
  196         $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set");
  197         $WeBWorK::timer0->start;
  198         $result = WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set);
  199         $WeBWorK::timer0->continue("problem set listing is done");
  200         $WeBWorK::timer0->stop;
  201         $WeBWorK::timer0->save;
  202       } else {
  203         # We've got the name of a problem
  204         my $problem = $ps_arg;
  205 
  206         $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set/$problem");
  207         $WeBWorK::timer0->start;
  208 #       my $pid = fork();
  209 #       if ($pid) {
  210 #         wait;
  211 #       } else {
  212           my $result = WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem);
  213 #         $WeBWorK::timer0->continue("Exiting child process");
  214 #         #$WeBWorK::timer0->stop;
  215 #           #$WeBWorK::timer0->save;
  216 #         eval{ APACHE::exit(0);} || warn "Error in leaving child |$@|";
  217 #         #  We REALLY REALLY want this grandchild to exit. But not the child.  How to do this
  218 #         # cleanly???? FIXME
  219 #       }
  220         $WeBWorK::timer0->continue("Problem done)");
  221         $WeBWorK::timer0->stop;
  222         $WeBWorK::timer0->save;
  223         return $result;
  224 
  225 
  226       }
  227     }
  228   }
  229 
  230   #$dispatchTimer->stop;
  231 
  232   return $result;
  233 }
  234 
  235 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9