| 1 | package WeBWorK::Test; |
1 | package WeBWorK::Test; |
|
|
2 | |
|
|
3 | # This file will cease to be as soon as the real content generation modules |
|
|
4 | # have been written. However, there's always reason to keep it around, as |
|
|
5 | # it showcases many things that new content generators will want to do, |
|
|
6 | # since it's generally where I dump new functionality before I put it in any |
|
|
7 | # end-user modules. |
| 2 | |
8 | |
| 3 | use Apache::Request; |
9 | use Apache::Request; |
| 4 | use Apache::Constants qw(:common); |
10 | use Apache::Constants qw(:common); |
|
|
11 | use WeBWorK::ContentGenerator; |
| 5 | |
12 | |
| 6 | sub new($$$) { |
13 | our @ISA = qw(WeBWorK::ContentGenerator); |
| 7 | my $class = shift; |
|
|
| 8 | my $self = {}; |
|
|
| 9 | ($self->{r}, $self->{courseEnvironment}) = @_; |
|
|
| 10 | bless $self, $class; |
|
|
| 11 | return $self; |
|
|
| 12 | } |
|
|
| 13 | |
14 | |
| 14 | sub go($) { |
15 | sub go($) { |
| 15 | my $self = shift; |
16 | my $self = shift; |
| 16 | my $r = $self->{r}; |
17 | my $r = $self->{r}; |
| 17 | $r->content_type("text/html"); |
18 | $r->content_type("text/html"); |
| 18 | $r->send_http_header; |
19 | $r->send_http_header; |
| 19 | |
20 | |
| 20 | # get some stuff together |
21 | # get some stuff together |
| 21 | my $user = $r->param("user"); |
22 | my $user = $r->param("user"); |
| 22 | my $key = $r->param("key"); |
23 | my $key = $r->param("key"); |
|
|
24 | my $uri = $r->uri; |
| 23 | |
25 | |
| 24 | print<<EOT; |
26 | print<<EOT; |
| 25 | <html> |
27 | <html> |
| 26 | <head><title>Welcome to Hell.</title></head> |
28 | <head><title>Welcome to Hell.</title></head> |
| 27 | <body> |
29 | <body> |
| 28 | <h1>There you go.</h1> |
30 | <h1>There you go.</h1> |
|
|
31 | <p>You're now accessing $uri.</p> |
| 29 | EOT |
32 | EOT |
| 30 | my @previous_data = $r->param; |
33 | $self->print_form_data(""," = ","<br>"); |
| 31 | foreach my $name (@previous_data) { |
34 | |
| 32 | my @values = $r->param($name); |
|
|
| 33 | foreach my $value (@values) { |
|
|
| 34 | print "$name = $value<br>\n"; |
|
|
| 35 | } |
|
|
| 36 | } |
|
|
| 37 | |
|
|
| 38 | print '<br><form method="POST" action="',$r->uri,'">'; |
35 | print '<br><form method="POST" action="',$r->uri,'">'; |
| 39 | foreach my $name (@previous_data) { |
36 | $self->print_form_data('<input type="hidden" name="','" value = "',"\">\n"); |
| 40 | my @values = $r->param($name); |
|
|
| 41 | foreach my $value (@values) { |
|
|
| 42 | print "\n<input type=\"hidden\" name=\"$name\" value=\"$value\">\n"; |
|
|
| 43 | } |
|
|
| 44 | } |
|
|
| 45 | print '<input type="submit" value="repost"></form>'; |
37 | print '<input type="submit" value="repost"></form>'; |
| 46 | |
38 | |
| 47 | print '<form method="POST" action="',$r->uri,'">'; |
39 | print '<form method="POST" action="',$r->uri,'">'; |
| 48 | foreach my $name (@previous_data) { |
40 | $self->print_form_data('<input type="hidden" name="','" value = "',"\">\n",qr/^key$/); |
| 49 | next if ($name eq "key"); |
|
|
| 50 | my @values = $r->param($name); |
|
|
| 51 | foreach my $value (@values) { |
|
|
| 52 | print "\n<input type=\"hidden\" name=\"$name\" value=\"$value\">\n"; |
41 | print "<input type=\"hidden\" name=\"key\" value=\"invalidkeyhahaha\">"; |
| 53 | } |
|
|
| 54 | } |
|
|
| 55 | print '<input type="submit" value="repost without key"></form>'; |
42 | print '<input type="submit" value="invalidate key"></form>'; |
| 56 | |
43 | |
| 57 | |
44 | |
| 58 | print<<EOT; |
45 | print<<EOT; |
| 59 | </body> |
46 | </body> |
| 60 | </html> |
47 | </html> |
Parent Directory
| 
Revision Log
| 
Patch