| … | |
… | |
| 13 | use strict; |
13 | use strict; |
| 14 | use Apache::Constants qw(:common REDIRECT); |
14 | use Apache::Constants qw(:common REDIRECT); |
| 15 | use Apache::Request; |
15 | use Apache::Request; |
| 16 | use WeBWorK::CourseEnvironment; |
16 | use WeBWorK::CourseEnvironment; |
| 17 | use WeBWorK::Test; |
17 | use WeBWorK::Test; |
| 18 | #use WeBWorK::Authen; |
18 | use WeBWorK::Authen; |
|
|
19 | use WeBWorK::Login; |
| 19 | |
20 | |
| 20 | # registering discontent: wanted to call this dispatch, but mod_perl gave me lip |
21 | # registering discontent: wanted to call this dispatch, but mod_perl gave me lip |
| 21 | sub handler() { |
22 | sub handler() { |
| 22 | my $r = Apache::Request->new(shift); # have to deal with unpredictable GET or POST data ,and sift through it for the key. So use Apache::Request |
23 | my $r = Apache::Request->new(shift); # have to deal with unpredictable GET or POST data ,and sift through it for the key. So use Apache::Request |
| 23 | my $path_info = $r->path_info; |
24 | my $path_info = $r->path_info; |
| … | |
… | |
| 37 | if ($@) { |
38 | if ($@) { |
| 38 | # TODO: display an error page. For now, print something mildly useful |
39 | # TODO: display an error page. For now, print something mildly useful |
| 39 | return DECLINED; |
40 | return DECLINED; |
| 40 | } |
41 | } |
| 41 | |
42 | |
|
|
43 | # WeBWorK::Authen::verify erases the passwd field and sets the key field |
|
|
44 | # if login is successful. |
| 42 | # if (!WeBWorK::Authen->new($r, $course_env)->authen) { |
45 | if (!WeBWorK::Authen->new($r, $course_env)->verify) { |
| 43 | # return WeBWorK::Login->new($r, $course_env)->go(); |
46 | return WeBWorK::Login->new($r, $course_env)->go(); |
| 44 | # } else { |
47 | } else { |
| 45 | if (1) { |
48 | if (1) { |
| 46 | return WeBWorK::Test->new($r, $course_env)->go(); |
49 | return WeBWorK::Test->new($r, $course_env)->go(); |
| 47 | } |
50 | } |
| 48 | # } |
51 | } |
| 49 | |
|
|
| 50 | |
|
|
| 51 | |
|
|
| 52 | $r->print(<<END); |
|
|
| 53 | COURSE = $course<br> |
|
|
| 54 | WEBWORK_ROOT = $webwork_root<br> |
|
|
| 55 | URI = <em>$current_uri</em><br> |
|
|
| 56 | Path information = <em>$path_info</em><br> |
|
|
| 57 | Translated path = <em>$path_translated</em> |
|
|
| 58 | </body> |
|
|
| 59 | </html> |
|
|
| 60 | END |
|
|
| 61 | |
52 | |
| 62 | return OK; |
53 | return DECLINED; |
| 63 | } |
54 | } |
| 64 | |
55 | |
| 65 | 1; |
56 | 1; |
| 66 | |
57 | |
| 67 | __END__ |
58 | __END__ |