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

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

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

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