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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1795 Revision 1796
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.45 2004/02/12 04:26:17 sh002i Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK.pm,v 1.43 2004/01/25 19:56:09 gage Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
73 73
74 # This stuff is pretty much copied out of the O'Reilly mod_perl book. 74 # This stuff is pretty much copied out of the O'Reilly mod_perl book.
75 # It's for figuring out the basepath. I may change this up if I find a 75 # It's for figuring out the basepath. I may change this up if I find a
76 # better way to do it. 76 # better way to do it.
77 my $path_info = $r->path_info || ""; 77 my $path_info = $r->path_info || "";
78 #$path_info =~ s|/+|/|g; # strip multiple forward slashes 78 $path_info =~ s!/+!/!g; # strip multiple forward slashes
79 #$r->path_info($path_info); # store that back into the request object
80 my $current_uri = $r->uri; 79 my $current_uri = $r->uri;
81 my $args = $r->args; 80 my $args = $r->args;
82 81
83 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/; 82 my ($urlRoot) = $current_uri =~ m/^(.*)$path_info/;
84 83
… …
101 # from within the system have trailing slashes, and we don't 100 # from within the system have trailing slashes, and we don't
102 # need POST data from outside the system anyway!) 101 # need POST data from outside the system anyway!)
103 } 102 }
104 103
105 # Create the @components array, which contains the path specified in the URL 104 # Create the @components array, which contains the path specified in the URL
106 my($junk, @components) = split /\/+/, $path_info; 105 my($junk, @components) = split "/", $path_info;
107 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf 106 my $webwork_root = $r->dir_config('webwork_root'); # From a PerlSetVar in httpd.conf
108 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf 107 my $pg_root = $r->dir_config('pg_root'); # From a PerlSetVar in httpd.conf
109 my $course = shift @components; 108 my $course = shift @components;
110 109
111=item Read the course environment 110=item Read the course environment
… …
237 $courseID ($courseID) - list of sets 236 $courseID ($courseID) - list of sets
238 hardcopy (Hardcopy Generator) - generate hardcopy for user/set pairs 237 hardcopy (Hardcopy Generator) - generate hardcopy for user/set pairs
239 options (User Options) - change email address and password 238 options (User Options) - change email address and password
240 feedback (Feedback) - send feedback to professor via email 239 feedback (Feedback) - send feedback to professor via email
241 logout (Logout) - expire session and erase authentication tokens 240 logout (Logout) - expire session and erase authentication tokens
242 #test (Test) - display request information 241 test (Test) - display request information
243 quiz_mode (Quiz) - "quiz" containing all problems from a set 242 quiz_mode (Quiz) - "quiz" containing all problems from a set
244 instructor (Instructor Tools) - main menu for instructor tools 243 instructor (Instructor Tools) - main menu for instructor tools
245 add_users (Add Users) - to be removed 244 add_users (Add Users) - to be removed
246 scoring (Scoring Tools) - generate scoring files for problem sets 245 scoring (Scoring Tools) - generate scoring files for problem sets
247 scoringDownload - send a scoring file to the client 246 scoringDownload - send a scoring file to the client
… …
284 } 283 }
285 elsif ($arg eq "logout") { 284 elsif ($arg eq "logout") {
286 $contentGenerator = "WeBWorK::ContentGenerator::Logout"; 285 $contentGenerator = "WeBWorK::ContentGenerator::Logout";
287 @arguments = (); 286 @arguments = ();
288 } 287 }
289 #elsif ($arg eq "test") { 288 elsif ($arg eq "test") {
290 # $contentGenerator = "WeBWorK::ContentGenerator::Test"; 289 $contentGenerator = "WeBWorK::ContentGenerator::Test";
291 # @arguments = (); 290 @arguments = ();
292 #} 291 }
293 elsif ($arg eq "quiz_mode" ) { 292 elsif ($arg eq "quiz_mode" ) {
294 $contentGenerator = "WeBWorK::ContentGenerator::GatewayQuiz"; 293 $contentGenerator = "WeBWorK::ContentGenerator::GatewayQuiz";
295 @arguments = @components; 294 @arguments = @components;
296 } 295 }
297 elsif ($arg eq "equation" ) { 296 elsif ($arg eq "equation" ) {
… …
396 } 395 }
397 else { 396 else {
398 # $arg is a set ID 397 # $arg is a set ID
399 my $setID = $arg; 398 my $setID = $arg;
400 my $problemID = shift @components; 399 my $problemID = shift @components;
401 400
401 # check that the set is valid
402 if (grep /$setID/, $db->listUserSets($effectiveUser)) {
402 if (defined $problemID) { 403 if (defined $problemID) {
404 # check that the problem is valid for this set
405 if (grep /$problemID/, $db->listUserProblems($effectiveUser, $setID)) {
403 $contentGenerator = "WeBWorK::ContentGenerator::Problem"; 406 $contentGenerator = "WeBWorK::ContentGenerator::Problem";
404 @arguments = ($setID, $problemID); 407 @arguments = ($setID, $problemID);
408 }
409 else {
410 $contentGenerator = "WeBWorK::ContentGenerator::Error";
411 @arguments = ($setID, "$problemID (error)", "Problem $problemID is not a valid problem in set $setID", "The problem number ($problemID) entered in the URL in your web browser does not seem to be a valid problem for the current set ($setID). Please check to make sure that the problem number was entered correctly. If you believe this error was generated mistakenly, please report it to your professor. You can view a list of sets by clicking on the link \"Problem Sets\" on the left.");
412 }
405 } 413 }
414 else {
415 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSet";
416 @arguments = ($setID);
417 }
418
419 }
406 else { 420 else {
407 $contentGenerator = "WeBWorK::ContentGenerator::ProblemSet"; 421 $contentGenerator = "WeBWorK::ContentGenerator::Error";
408 @arguments = ($setID); 422 @arguments = ("$setID (error)", "$problemID (error)", "$setID is not a valid set for user $user", "The set ($setID) entered in the URL in your web browser does not seem to be a valid set for the current user. Please check to make sure that the set was entered correctly. If you believe this error was generated mistakenly, please report it to your professor.");
409 } 423 }
424
410 } 425 }
411 } 426 }
412 427
413=item Call the selected content generator 428=item Call the selected content generator
414 429
Legend:
Removed from v.1795  
changed lines
  Added in v.1796
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9