[system] / branches / rel-2-4-dev / webwork2 / lib / WeBWorK.pm Repository:
ViewVC logotype

Annotation of /branches/rel-2-4-dev/webwork2/lib/WeBWorK.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1616 - (view) (download) (as text)
Original Path: trunk/webwork2/lib/WeBWorK.pm

1 : sh002i 986 ################################################################################
2 :     # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3 :     # $Id$
4 :     ################################################################################
5 :    
6 :     package WeBWorK;
7 :    
8 :     =head1 NAME
9 :    
10 : sh002i 1565 WeBWorK - Dispatch requests to the appropriate content generator.
11 : sh002i 986
12 : sh002i 1565 =head1 SYNOPSIS
13 :    
14 :     my $r = Apache->request;
15 :     my $result = eval { WeBWorK::dispatch($r) };
16 :     die "something bad happened: $@" if $@;
17 :    
18 :     =head1 DESCRIPTION
19 :    
20 :     C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request
21 :     object, it performs authentication and determines which subclass of
22 :     C<WeBWorK::ContentGenerator> to call.
23 :    
24 :     =head1 REQUEST FORMAT
25 :    
26 :     FIXME: write this part
27 :     summary: the URI controls
28 :    
29 : sh002i 986 =cut
30 :    
31 : sh002i 1548 BEGIN { $main::VERSION = "2.0"; }
32 :    
33 : gage 1612 my $timingON = 0;
34 : gage 1607
35 :    
36 : sh002i 986 use strict;
37 :     use warnings;
38 : gage 1377 use Apache::Constants qw(:common REDIRECT DONE);
39 : sh002i 986 use Apache::Request;
40 :     use WeBWorK::Authen;
41 :     use WeBWorK::Authz;
42 :     use WeBWorK::ContentGenerator::Feedback;
43 : sh002i 1195 use WeBWorK::ContentGenerator::GatewayQuiz;
44 : sh002i 986 use WeBWorK::ContentGenerator::Hardcopy;
45 : gage 1580 use WeBWorK::ContentGenerator::Instructor::AddUsers;
46 : sh002i 1195 use WeBWorK::ContentGenerator::Instructor::Assigner;
47 : sh002i 1616 use WeBWorK::ContentGenerator::Instructor::FileXfer;
48 : sh002i 986 use WeBWorK::ContentGenerator::Instructor::Index;
49 : gage 1580 #use WeBWorK::ContentGenerator::Instructor::Index2;
50 : sh002i 986 use WeBWorK::ContentGenerator::Instructor::PGProblemEditor;
51 : sh002i 1195 use WeBWorK::ContentGenerator::Instructor::ProblemList;
52 : sh002i 986 use WeBWorK::ContentGenerator::Instructor::ProblemSetEditor;
53 :     use WeBWorK::ContentGenerator::Instructor::ProblemSetList;
54 : malsyned 1411 use WeBWorK::ContentGenerator::Instructor::Scoring;
55 : malsyned 1447 use WeBWorK::ContentGenerator::Instructor::ScoringDownload;
56 : gage 1432 use WeBWorK::ContentGenerator::Instructor::ScoringTotals;
57 : sh002i 1616 use WeBWorK::ContentGenerator::Instructor::SendMail;
58 :     use WeBWorK::ContentGenerator::Instructor::ShowAnswers;
59 : gage 1430 use WeBWorK::ContentGenerator::Instructor::Stats;
60 : sh002i 1616 use WeBWorK::ContentGenerator::Instructor::UserList;
61 : sh002i 986 use WeBWorK::ContentGenerator::Login;
62 :     use WeBWorK::ContentGenerator::Logout;
63 :     use WeBWorK::ContentGenerator::Options;
64 :     use WeBWorK::ContentGenerator::Problem;
65 :     use WeBWorK::ContentGenerator::ProblemSet;
66 :     use WeBWorK::ContentGenerator::ProblemSets;
67 :     use WeBWorK::ContentGenerator::Test;
68 :     use WeBWorK::CourseEnvironment;
69 :     use WeBWorK::DB;
70 : sh002i 1195 use WeBWorK::Timing;
71 : sh002i 1616 use WeBWorK::Upload;
72 : sh002i 986
73 : sh002i 1565 =head1 THE C<&dispatch> FUNCTION
74 :    
75 :     The C<&dispatch> function takes an Apache request object (REQUEST) and returns
76 :     an apache status code. Below is an overview of its operation:
77 :    
78 :     =over
79 :    
80 :     =cut
81 :    
82 : sh002i 986 sub dispatch($) {
83 :     my ($apache) = @_;
84 :     my $r = Apache::Request->new($apache);
85 :     # have to deal with unpredictable GET or POST data, and sift
86 :     # through it for the key. So use Apache::Request
87 :    
88 :     # This stuff is pretty much copied out of the O'Reilly mod_perl book.
89 :     # It's for figuring out the basepath. I may change this up if I find a
90 :     # better way to do it.
91 :     my $path_info = $r->path_info || "";
92 : malsyned 1047 $path_info =~ s!/+!/!g; # strip multiple forward slashes
93 : sh002i 986 my $current_uri = $r->uri;
94 :     my $args = $r->args;
95 :    
96 : malsyned 1048 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/;
97 : sh002i 1565
98 :     =item Ensure that the URI ends with a "/"
99 :    
100 :     Parts of WeBWorK assume that the current URI of a request ends with a "/". If
101 :     this is not the case, a redirection is issued to add the "/". This action will
102 :     discard any POST data associated with the request, so it is essential that all
103 :     POST requests include a "/" at the end of the URI.
104 :    
105 :     =cut
106 : sh002i 1616
107 : sh002i 986 # If it's a valid WeBWorK URI, it ends in a /. This is assumed
108 :     # alllll over the place.
109 :     unless (substr($current_uri,-1) eq '/') {
110 :     $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : ""));
111 :     return REDIRECT;
112 :     # *** any post data gets lost here -- fix that.
113 : sh002i 1131 # (actually, it's not a problem, since all URLs generated
114 : gage 1377 # from within the system have trailing slashes, and we don't
115 : sh002i 1131 # need POST data from outside the system anyway!)
116 : sh002i 986 }
117 :    
118 :     # Create the @components array, which contains the path specified in the URL
119 :     my($junk, @components) = split "/", $path_info;
120 :     my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
121 : sh002i 1051 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf
122 : sh002i 986 my $course = shift @components;
123 : sh002i 1565
124 :     =item Read the course environment
125 :    
126 :     C<WeBWorK::CourseEnvironment> is used to read the F<global.conf> configuration
127 :     file. If a course name was given in the request's URI, it is passed to
128 :     C<WeBWorK::CourseEnvironment>. In this case, the course-specific configuration
129 :     file (usually F<course.conf>) is also read by C<WeBWorK::CourseEnvironment> at
130 :     this point.
131 :    
132 :     See also L<WeBWorK::CourseEnvironment>.
133 :    
134 :     =cut
135 : sh002i 1616
136 : sh002i 986 # Try to get the course environment.
137 : sh002i 1051 my $ce = eval {WeBWorK::CourseEnvironment->new($webwork_root, $urlRoot, $pg_root, $course);};
138 : sh002i 986 if ($@) { # If there was an error getting the requested course
139 : sh002i 1131 die "Failed to read course environment for $course: $@";
140 : sh002i 986 }
141 : sh002i 1565
142 :     =item If no course was given, go to the site home page
143 :    
144 :     If the URI did not include the name of a course, a redirection is issued to the
145 :     site home page, given but the course environemnt variable
146 :     C<$ce-E<gt>{webworkURLs}-E<gt>{home}>.
147 :    
148 :     =cut
149 : sh002i 1616
150 : sh002i 986 # If no course was specified, redirect to the home URL
151 :     unless (defined $course) {
152 :     $r->header_out(Location => $ce->{webworkURLs}->{home});
153 :     return REDIRECT;
154 :     }
155 : sh002i 1565
156 :     =item If the given course does not exist, fail
157 :    
158 :     If the URI did include the name of a course, but the course directory was not
159 :     found, an exception is thrown.
160 :    
161 :     =cut
162 : sh002i 1616
163 : sh002i 986 # Freak out if the requested course doesn't exist. For now, this is just a
164 :     # check to see if the course directory exists.
165 : sh002i 1131 my $courseDir = $ce->{webworkDirs}->{courses} . "/$course";
166 :     unless (-e $courseDir) {
167 :     die "Course directory for $course ($courseDir) not found. Perhaps the course does not exist?";
168 : sh002i 986 }
169 : sh002i 1565
170 :     =item Initialize the database system
171 :    
172 :     A C<WeBWorK::DB> object is created from the current course environment.
173 :    
174 :     See also L<WeBWorK::DB>.
175 :    
176 :     =cut
177 : sh002i 1616
178 : sh002i 986 # Bring up a connection to the database (for Authen/Authz, and eventually
179 :     # to be passed to content generators, when we clean this file up).
180 :     my $db = WeBWorK::DB->new($ce);
181 : sh002i 1565
182 : sh002i 1616 =item Capture any uploads
183 :    
184 :     Before checking authentication, we store any uploads sent by the client
185 :     and replace them with parameters referencing the stored uploads.
186 :    
187 :     =cut
188 :    
189 :     my @uploads = $r->upload;
190 :     foreach my $u (@uploads) {
191 :     # make sure it's a "real" upload
192 :     next unless $u->filename;
193 :    
194 :     # store the upload
195 :     my $upload = WeBWorK::Upload->store($u,
196 :     dir => $ce->{webworkDirs}->{uploadCache}
197 :     );
198 :    
199 :     # store the upload ID and hash in the file upload field
200 :     my $id = $upload->id;
201 :     my $hash = $upload->hash;
202 :     $r->param($u->name => "$id $hash");
203 :     }
204 :    
205 : sh002i 1565 =item Check authentication
206 :    
207 :     Use C<WeBWorK::Authen> to verify that the remote user has authenticated.
208 :    
209 :     See also L<WeBWorK::Authen>.
210 :    
211 :     =cut
212 : sh002i 1616
213 :     ### Begin dispatching ###
214 : sh002i 1565
215 : sh002i 1616 #my $dispatchTimer = WeBWorK::Timing->new(__PACKAGE__."::dispatch");
216 :     #$dispatchTimer->start;
217 :    
218 :     my $result;
219 :    
220 : sh002i 986 # WeBWorK::Authen::verify erases the passwd field and sets the key field
221 :     # if login is successful.
222 :     if (!WeBWorK::Authen->new($r, $ce, $db)->verify) {
223 : sh002i 1195 $result = WeBWorK::ContentGenerator::Login->new($r, $ce, $db)->go;
224 : sh002i 986 } else {
225 : sh002i 1565
226 :     =item Determine if the user is allowed to set C<effectiveUser>
227 :    
228 :     Use C<WeBWorK::Authz> to determine if the user is allowed to set
229 :     C<effectiveUser>. If so, set it to the requested value (or set it to the real
230 :     user name if no value is supplied). If not, set it to the real user name.
231 :    
232 :     See also L<WeBWorK::Authz>.
233 :    
234 :     =cut
235 : sh002i 1616
236 : sh002i 986 # After we are authenticated, there are some things that need to be
237 :     # sorted out, Authorization-wize, before we start dispatching to individual
238 :     # content generators.
239 :     my $user = $r->param("user");
240 :     my $effectiveUser = $r->param("effectiveUser") || $user;
241 :     my $su_authorized = WeBWorK::Authz->new($r, $ce, $db)->hasPermissions($user, "become_student", $effectiveUser);
242 :     $effectiveUser = $user unless $su_authorized;
243 :     $r->param("effectiveUser", $effectiveUser);
244 : sh002i 1565
245 :     =item Create and call the appropriate subclass of C<WeBWorK::ContentGenerator> based on the URI.
246 :    
247 :     The dispatcher logic currently looks like this:
248 :    
249 :     FIXME: write this part
250 :     for now, consult the code
251 :    
252 :     =cut
253 : sh002i 1616
254 : sh002i 986 my $arg = shift @components;
255 :     if (!defined $arg) { # We want the list of problem sets
256 : sh002i 1195 $result = WeBWorK::ContentGenerator::ProblemSets->new($r, $ce, $db)->go;
257 : sh002i 986 } elsif ($arg eq "hardcopy") {
258 : gage 1203
259 : sh002i 986 my $hardcopyArgument = shift @components;
260 :     $hardcopyArgument = "" unless defined $hardcopyArgument;
261 : gage 1607 $WeBWorK::timer1 = WeBWorK::Timing->new("hardcopy: $hardcopyArgument") if $timingON == 1;
262 :     $WeBWorK::timer1->start if $timingON == 1;
263 : gage 1377
264 : gage 1203 my $result = WeBWorK::ContentGenerator::Hardcopy->new($r, $ce, $db)->go($hardcopyArgument);
265 : gage 1607 $WeBWorK::timer1 ->stop if $timingON == 1;
266 :     $WeBWorK::timer1 ->save if $timingON == 1;
267 : gage 1203 return $result;
268 : gage 1509 } elsif ($arg eq "instructor2") {
269 :     my $instructorArgument = shift @components;
270 :     if (!defined $instructorArgument) {
271 :     $result = WeBWorK::ContentGenerator::Instructor::Index2->new($r, $ce, $db)->go;
272 :     }
273 : sh002i 986 } elsif ($arg eq "instructor") {
274 :     my $instructorArgument = shift @components;
275 :     if (!defined $instructorArgument) {
276 : gage 1607 $WeBWorK::timer2 = WeBWorK::Timing->new("Instructor index $course:") if $timingON == 1;
277 :     $WeBWorK::timer2->start if $timingON == 1;
278 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::Index->new($r, $ce, $db)->go;
279 : gage 1607 $WeBWorK::timer2->continue("Listing instructor page is done") if $timingON == 1;
280 :     $WeBWorK::timer2->stop if $timingON == 1;
281 :     $WeBWorK::timer2->save if $timingON == 1;
282 : malsyned 1411 } elsif ($instructorArgument eq "scoring") {
283 : gage 1432 $result = WeBWorK::ContentGenerator::Instructor::Scoring->new($r, $ce, $db)->go; #FIXME!!!!
284 : gage 1580 } elsif ($instructorArgument eq "add_users") {
285 :     $result = WeBWorK::ContentGenerator::Instructor::AddUsers->new($r, $ce, $db)->go; #FIXME!!!!
286 : malsyned 1447 } elsif ($instructorArgument eq "scoringDownload") {
287 :     $result = WeBWorK::ContentGenerator::Instructor::ScoringDownload->new($r, $ce, $db)->go;
288 : gage 1432 } elsif ($instructorArgument eq "scoring_totals") {
289 :     $result = WeBWorK::ContentGenerator::Instructor::ScoringTotals->new($r, $ce, $db)->go;
290 : malsyned 995 } elsif ($instructorArgument eq "users") {
291 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::UserList->new($r, $ce, $db)->go;
292 : malsyned 995 } elsif ($instructorArgument eq "sets") {
293 :     my $setID = shift @components;
294 :     if (defined $setID) {
295 : malsyned 1005 my $setArg = shift @components;
296 : malsyned 1015 if (!defined $setArg) {
297 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetEditor->new($r, $ce, $db)->go($setID);
298 : malsyned 1015 } elsif ($setArg eq "problems") {
299 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::ProblemList->new($r, $ce, $db)->go($setID);
300 : malsyned 1015 } elsif ($setArg eq "users") {
301 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::Assigner->new($r, $ce, $db)->go($setID);
302 : malsyned 1005 }
303 : malsyned 995 } else {
304 : gage 1607 $WeBWorK::timer2 = WeBWorK::Timing->new("Problem Set List $course:") if $timingON == 1;
305 :     $WeBWorK::timer2->start if $timingON == 1;
306 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($r, $ce, $db)->go;
307 : gage 1607 $WeBWorK::timer2->continue("Problem Set List is done");
308 :     $WeBWorK::timer2->stop if $timingON == 1;
309 :     $WeBWorK::timer2->save if $timingON == 1;
310 :    
311 : malsyned 995 }
312 : sh002i 986 } elsif ($instructorArgument eq "pgProblemEditor") {
313 : sh002i 1195 $result = WeBWorK::ContentGenerator::Instructor::PGProblemEditor->new($r, $ce, $db)->go(@components);
314 : gage 1377 } elsif ($instructorArgument eq "send_mail") {
315 :     $result = WeBWorK::ContentGenerator::Instructor::SendMail->new($r, $ce, $db)->go(@components);
316 : gage 1395 } elsif ($instructorArgument eq "show_answers") {
317 :     $result = WeBWorK::ContentGenerator::Instructor::ShowAnswers->new($r, $ce, $db)->go(@components);
318 : gage 1430 } elsif ($instructorArgument eq "stats") {
319 :     $result = WeBWorK::ContentGenerator::Instructor::Stats->new($r, $ce, $db)->go(@components);
320 : sh002i 1616 }elsif ($instructorArgument eq "files") {
321 :     $result = WeBWorK::ContentGenerator::Instructor::FileXfer->new($r, $ce, $db)->go(@components);
322 : sh002i 986 }
323 :     } elsif ($arg eq "options") {
324 : sh002i 1195 $result = WeBWorK::ContentGenerator::Options->new($r, $ce, $db)->go;
325 : sh002i 986 } elsif ($arg eq "feedback") {
326 : sh002i 1195 $result = WeBWorK::ContentGenerator::Feedback->new($r, $ce, $db)->go;
327 : sh002i 986 } elsif ($arg eq "logout") {
328 : sh002i 1195 $result = WeBWorK::ContentGenerator::Logout->new($r, $ce, $db)->go;
329 : sh002i 986 } elsif ($arg eq "test") {
330 : sh002i 1195 $result = WeBWorK::ContentGenerator::Test->new($r, $ce, $db)->go;
331 : gage 1135 } elsif ($arg eq "quiz_mode" ) {
332 : gage 1130 # Gateway quiz capability -- very similar to problem set (initially)
333 : sh002i 1195 $result = WeBWorK::ContentGenerator::GatewayQuiz->new($r, $ce, $db)->go(@components);
334 : sh002i 986 } else { # We've got the name of a problem set.
335 :     my $problem_set = $arg;
336 :     my $ps_arg = shift @components;
337 :    
338 :     if (!defined $ps_arg) {
339 :     # list the problems in the problem set
340 : gage 1607 $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set") if $timingON == 1;
341 :     $WeBWorK::timer0->start if $timingON == 1;
342 : sh002i 1195 $result = WeBWorK::ContentGenerator::ProblemSet->new($r, $ce, $db)->go($problem_set);
343 : gage 1607 $WeBWorK::timer0->continue("problem set listing is done") if $timingON == 1;
344 :     $WeBWorK::timer0->stop if $timingON == 1;
345 :     $WeBWorK::timer0->save if $timingON == 1;
346 : sh002i 986 } else {
347 :     # We've got the name of a problem
348 :     my $problem = $ps_arg;
349 : gage 1204
350 : gage 1607 $WeBWorK::timer0 = WeBWorK::Timing->new("Problem $course:$problem_set/$problem") if $timingON == 1;
351 :     $WeBWorK::timer0->start if $timingON == 1;
352 : gage 1382 # my $pid = fork();
353 : gage 1377 # if ($pid) {
354 :     # wait;
355 :     # } else {
356 :     my $result = WeBWorK::ContentGenerator::Problem->new($r, $ce, $db)->go($problem_set, $problem);
357 :     # $WeBWorK::timer0->continue("Exiting child process");
358 :     # #$WeBWorK::timer0->stop;
359 :     # #$WeBWorK::timer0->save;
360 :     # eval{ APACHE::exit(0);} || warn "Error in leaving child |$@|";
361 :     # # We REALLY REALLY want this grandchild to exit. But not the child. How to do this
362 :     # # cleanly???? FIXME
363 :     # }
364 : gage 1607 $WeBWorK::timer0->continue("Problem done)") if $timingON == 1;
365 :     $WeBWorK::timer0->stop if $timingON == 1;
366 :     $WeBWorK::timer0->save if $timingON == 1;
367 : gage 1203 return $result;
368 : gage 1204
369 :    
370 : sh002i 986 }
371 :     }
372 :     }
373 :    
374 : sh002i 1224 #$dispatchTimer->stop;
375 : sh002i 1565
376 :     =item Return the result of calling the content generator
377 :    
378 :     The return value of the content generator's C<&go> function is returned.
379 :    
380 :     =cut
381 : sh002i 1616
382 : sh002i 1195 return $result;
383 : sh002i 986 }
384 :    
385 : sh002i 1565 =back
386 :    
387 :     =head1 AUTHOR
388 :    
389 : sh002i 1616 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam
390 :     Hathaway, sh002i at math.rochester.edu.
391 : sh002i 1565
392 :     =cut
393 :    
394 : sh002i 986 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9