| 1 | package WeBWorK::ContentGenerator; |
1 | package WeBWorK::ContentGenerator; |
| 2 | |
2 | |
|
|
3 | use strict; |
|
|
4 | use warnings; |
| 3 | use CGI qw(-compile :html :form); |
5 | use CGI qw(-compile :html :form); |
| 4 | use Apache::Constants qw(:common); |
6 | use Apache::Constants qw(:common); |
| 5 | |
7 | |
| 6 | # Send 'die' message to the browser window |
8 | # Send 'die' message to the browser window |
| 7 | #use CGI::Carp qw(fatalsToBrowser); |
9 | #use CGI::Carp qw(fatalsToBrowser); |
| … | |
… | |
| 33 | |
35 | |
| 34 | sub print_form_data { |
36 | sub print_form_data { |
| 35 | my ($self, $begin, $middle, $end, $qr_omit) = @_; |
37 | my ($self, $begin, $middle, $end, $qr_omit) = @_; |
| 36 | my $return_string = ""; |
38 | my $return_string = ""; |
| 37 | |
39 | |
| 38 | $r=$self->{r}; |
40 | my $r=$self->{r}; |
| 39 | my @form_data = $r->param; |
41 | my @form_data = $r->param; |
| 40 | foreach my $name (@form_data) { |
42 | foreach my $name (@form_data) { |
| 41 | next if ($qr_omit and $name =~ /$qr_omit/); |
43 | next if ($qr_omit and $name =~ /$qr_omit/); |
| 42 | my @values = $r->param($name); |
44 | my @values = $r->param($name); |
|
|
45 | |
|
|
46 | |
|
|
47 | foreach my $variable (qw(begin name middle value end)) { |
|
|
48 | no strict 'refs'; |
|
|
49 | ${$variable} = "" unless defined ${$variable}; |
|
|
50 | } |
|
|
51 | |
| 43 | foreach my $value (@values) { |
52 | foreach my $value (@values) { |
| 44 | $return_string .= "$begin$name$middle$value$end"; |
53 | $return_string .= "$begin$name$middle$value$end"; |
| 45 | } |
54 | } |
| 46 | } |
55 | } |
| 47 | |
56 | |
| … | |
… | |
| 52 | my $self = shift; |
61 | my $self = shift; |
| 53 | my $r = $self->{r}; |
62 | my $r = $self->{r}; |
| 54 | my $courseEnvironment = $self->{courseEnvironment}; |
63 | my $courseEnvironment = $self->{courseEnvironment}; |
| 55 | my $html = ""; |
64 | my $html = ""; |
| 56 | |
65 | |
| 57 | foreach $param ("user","effectiveUser","key") { |
66 | foreach my $param ("user","effectiveUser","key") { |
| 58 | my $value = $r->param($param); |
67 | my $value = $r->param($param); |
| 59 | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); |
68 | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); |
| 60 | } |
69 | } |
| 61 | return $html; |
70 | return $html; |
| 62 | } |
71 | } |
| … | |
… | |
| 72 | my @fields = @_; |
81 | my @fields = @_; |
| 73 | @fields or @fields = $r->param; |
82 | @fields or @fields = $r->param; |
| 74 | my $courseEnvironment = $self->{courseEnvironment}; |
83 | my $courseEnvironment = $self->{courseEnvironment}; |
| 75 | my $html = ""; |
84 | my $html = ""; |
| 76 | |
85 | |
| 77 | foreach $param (@fields) { |
86 | foreach my $param (@fields) { |
| 78 | my $value = $r->param($param); |
87 | my $value = $r->param($param); |
| 79 | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); |
88 | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); |
| 80 | } |
89 | } |
| 81 | return $html; |
90 | return $html; |
| 82 | } |
91 | } |
| … | |
… | |
| 109 | ### Content-generating functions that should probably not be overridden |
118 | ### Content-generating functions that should probably not be overridden |
| 110 | ### by most subclasses |
119 | ### by most subclasses |
| 111 | |
120 | |
| 112 | sub logo { |
121 | sub logo { |
| 113 | my $self = shift; |
122 | my $self = shift; |
| 114 | return $self->{courseEnvironment}->{webworkUrls}->{logo}; |
123 | return $self->{courseEnvironment}->{webworkURLs}->{logo}; |
| 115 | } |
124 | } |
| 116 | |
125 | |
| 117 | sub htdocs_base { |
126 | sub htdocs_base { |
| 118 | my $self = shift; |
127 | my $self = shift; |
| 119 | return $self->{courseEnvironment}->{webworkUrls}->{base}; |
128 | return $self->{courseEnvironment}->{webworkURLs}->{base}; |
| 120 | } |
129 | } |
| 121 | |
130 | |
| 122 | sub test_args { |
131 | sub test_args { |
| 123 | my %args = %{$_[-1]}; |
132 | my %args = %{$_[-1]}; |
| 124 | |
133 | |
| … | |
… | |
| 164 | # This is incremental regex processing. |
173 | # This is incremental regex processing. |
| 165 | # the /c is so that pos($line) doesn't die when the regex fails. |
174 | # the /c is so that pos($line) doesn't die when the regex fails. |
| 166 | while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { |
175 | while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { |
| 167 | my ($before, $function, $raw_args) = ($1, $2, $3); |
176 | my ($before, $function, $raw_args) = ($1, $2, $3); |
| 168 | # $args here will be a hashref |
177 | # $args here will be a hashref |
| 169 | my $args = cook_args $raw_args if $raw_args =~ /\S/; |
178 | my $args = $raw_args =~ /\S/ ? cook_args $raw_args : {}; |
| 170 | print $before; |
179 | print $before; |
|
|
180 | |
| 171 | print $self->$function(@_, $args) if $self->can($function); |
181 | print $self->$function(@_, $args) if $self->can($function); |
| 172 | } |
182 | } |
| 173 | print substr $line, pos($line); |
183 | |
|
|
184 | print substr $line, (defined(pos($line)) ? pos($line) : 0); |
| 174 | } |
185 | } |
| 175 | } |
186 | } |
| 176 | |
187 | |
| 177 | # Do whatever needs to be done in order to get a page to the client. You |
188 | # Do whatever needs to be done in order to get a page to the client. You |
| 178 | # probably don't want to override this unless you're not making a web page |
189 | # probably don't want to override this unless you're not making a web page |
Parent Directory
| 
Revision Log
| 
Patch