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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1509 - (download) (as text) (annotate)
Fri Sep 19 02:28:28 2003 UTC (9 years, 8 months ago) by gage
File size: 9744 byte(s)
Provides link to Instructor2 alternate interface for instructors.
--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9