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

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

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

Revision 468 Revision 469
… …
13 13
14use strict; 14use strict;
15use warnings; 15use warnings;
16use Apache::Constants qw(:common); 16use Apache::Constants qw(:common);
17use CGI qw(); 17use CGI qw();
18 18use URI::Escape;
19# Send 'die' message to the browser window
20#use CGI::Carp qw(fatalsToBrowser); 19#use CGI::Carp qw(fatalsToBrowser);
21 20
21################################################################################
22# This is a very unruly file, so I'm going to use very large comments to divide
23# it into logical sections.
24################################################################################
22 25
23# This is a superclass for Apache::WeBWorK's content generators.
24# You are /definitely/ encouraged to read this file, since there are
25# "abstract" functions here which show aproximately what form you would
26# want over-ridden sub-classes to follow.
27
28# new(Apache::Request, WeBWorK::CourseEnvironment) 26# new(Apache::Request, WeBWorK::CourseEnvironment) - create a new instance of a
27# content generator. Usually only called by the dispatcher, although one might
28# be able to use it for things like "sub-requests". Uh... uh... I have to think
29# about that one. The dispatcher uses this idiom:
30#
31#
32# WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever);
33#
34# and throws away the result ;)
35#
29sub new($$$) { 36sub new($$$) {
30 my $invocant = shift; 37 my $invocant = shift;
31 my $class = ref($invocant) || $invocant; 38 my $class = ref($invocant) || $invocant;
32 my $self = {}; 39 my $self = {};
33 ($self->{r}, $self->{courseEnvironment}) = @_; 40 ($self->{r}, $self->{courseEnvironment}) = @_;
34 bless $self, $class; 41 bless $self, $class;
35 return $self; 42 return $self;
36} 43}
37 44
45################################################################################
46# Invocation and template processing
47################################################################################
38 48
39# This is a quick and dirty function to print out all (or almost all) of the 49# go(@otherArguments) - render a page, using methods from the particular
40# fields in a form in a specified format. As you can see from the print 50# subclass of ContentGenerator. @otherArguments is passed to each method, so
41# statement, it just prints out $begining$name$middle$value$end for every 51# that the dispatcher can pass CG-specific data. The order of calls looks like
42# field who's name doesn't match $qr_omit, a quoted regex. 52# this:
43# In it's current incarnation, it should be called from subclasses only, 53#
44# by saying $self->print_form_data. Of course, you could construct a 54# * &pre_header_initialize - give subclasses a chance to do initialization
45# hashref with ->{r} being an Apache::Request, I suppose. 55# necessary for generating the HTTP header.
46sub print_form_data { 56# * &header - this class provides a standard HTTP header with Content-Type
47 my ($self, $begin, $middle, $end, $qr_omit) = @_; 57# text/html. Subclasses are welcome to overload this for things like
48 my $return_string = ""; 58# an image-creation content generator or a PDF generator.
49 59# * &initialize - let subclasses do post-header initialization.
60# * any "template escapes" defined in the system template and supported by
61# the subclass. Generic implementations of &title and &body are provided.
62#
63sub go {
64 my $self = shift;
50 my $r=$self->{r}; 65 my $r = $self->{r};
51 my @form_data = $r->param; 66 my $courseEnvironment = $self->{courseEnvironment};
67
68 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
69 $self->header(@_);
70 return OK if $r->header_only;
71
72 $self->initialize(@_) if $self->can("initialize");
73 $self->template($courseEnvironment->{templates}->{system}, @_);
74
75 return OK;
76}
77
78# template(STRING, @otherArguments) - parse a template, looking for escapes of
79# the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME
80# (if available) for each NAME. The escapes are called like:
81#
82# $self->NAME(@otherArguments, \%escapeArguments)
83#
84# where @otherArguments originates in the dispatcher and %escapeArguments is
85# parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR)
86#
87sub template {
88 my ($self, $templateFile) = (shift, shift);
89 my $r = $self->{r};
90 my $courseEnvironment = $self->{courseEnvironment};
91
92 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
93 my @template = <TEMPLATE>;
94 close TEMPLATE;
95
52 foreach my $name (@form_data) { 96 foreach my $line (@template) {
53 next if ($qr_omit and $name =~ /$qr_omit/); 97 # This is incremental regex processing.
54 my @values = $r->param($name); 98 # the /c is so that pos($line) doesn't die when the regex fails.
99 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
100 my ($before, $function, $raw_args) = ($1, $2, $3);
101 # $args here will be a hashref
102 my $args = $raw_args =~ /\S/ ? cook_args($raw_args) : {};
103 print $before;
104
105 print $self->$function(@_, $args) if $self->can($function);
106 }
55 107
56 108 print substr $line, (defined(pos($line)) ? pos($line) : 0);
57 foreach my $variable (qw(begin name middle value end)) {
58 no strict 'refs';
59 ${$variable} = "" unless defined ${$variable};
60 } 109 }
61
62 foreach my $value (@values) {
63 $return_string .= "$begin$name$middle$value$end";
64 }
65 }
66
67 return $return_string;
68} 110}
69# P.S. This function is beat, but I use it in places. We'll kill it eventually, I guess.
70 111
71sub hidden_authen_fields { 112# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
72 my $self = shift; 113# a reference to a hash containing the parsed arguments.
73 my $r = $self->{r}; 114#
74 my $courseEnvironment = $self->{courseEnvironment};
75 my $html = "";
76
77 foreach my $param ("user","effectiveUser","key") {
78 my $value = $r->param($param);
79 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});
80 }
81 return $html;
82}
83
84#sub hidden_authen_fields($) {
85# my $self = shift;
86# return $self->hidden_fields("user","effectiveUser","key");
87#}
88
89sub hidden_fields($;@) {
90 my $self = shift;
91 my $r = $self->{r};
92 my @fields = @_;
93 @fields or @fields = $r->param;
94 my $courseEnvironment = $self->{courseEnvironment};
95 my $html = "";
96
97 foreach my $param (@fields) {
98 my $value = $r->param($param);
99 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});
100 }
101 return $html;
102}
103
104### Functions that subclasses /should/ override under most circumstances
105
106sub title {
107 return "Superclass";
108}
109
110sub body {
111 print "Generated content";
112 "";
113}
114
115### Functions that subclasses /may/ want to override, if they've got something
116### special to say
117
118sub pre_header_initialize {}
119
120sub header {
121 my $self = shift;
122 my $r=$self->{r};
123 $r->content_type('text/html');
124 $r->send_http_header();
125}
126
127sub initialize {}
128
129### Content-generating functions that should probably not be overridden
130### by most subclasses
131
132sub logo {
133 my $self = shift;
134 return $self->{courseEnvironment}->{webworkURLs}->{logo};
135}
136
137sub htdocs_base {
138 my $self = shift;
139 return $self->{courseEnvironment}->{webworkURLs}->{base};
140}
141
142sub test_args {
143 my %args = %{$_[-1]};
144
145 print "<pre>";
146 print "$_ => $args{$_}\n" foreach (keys %args);
147 print "</pre>";
148 "";
149}
150
151# Used by &go to parse the argument fields of the template escapes
152sub cook_args($) { 115sub cook_args($) {
153 # There are a bunch of commented-out lines that I am using to remind myself 116 # There are a bunch of commented-out lines that I am using to remind myself
154 # That I want to write a better regex sometime. 117 # That I want to write a better regex sometime.
155 my ($raw_args) = @_; 118 my ($raw_args) = @_;
156 my $args = {}; 119 my $args = {};
… …
166 } 129 }
167 130
168 return $args; 131 return $args;
169} 132}
170 133
171# Perform substitution in a template file and print it. This should be called 134################################################################################
172# for all content generators that are creating HTML output, and is called by 135# Macros used by content generators to render common idioms
173# default by the &go method. 136################################################################################
174sub template { 137
175 my ($self, $templateFile) = (shift, shift); 138# pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash
139# reference contains the "style", "image", and "text" arguments to the escape.
140# The LIST consists of ordered key-value pairs of the form:
141#
142# "Page Name" => URL
143#
144# If the page should not have a link associated with it, the URL should be left
145# empty. Authentication data is added to the URL so you don't have to. A fully-
146# formed path line is returned, suitable for returning by a function
147# implementing the #path escape.
148#
149sub pathMacro {
150 my $self = shift;
151 my %args = %{ shift() };
152 my @path = @_;
153 my $sep;
154 if ($args{style} eq "image") {
155 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});
156 } else {
157 $sep = $args{text};
158 }
159 my $auth = $self->url_authen_args;
160 my @result;
161 while (@path) {
162 my $name = shift @path;
163 my $url = shift @path;
164 push @result, $url
165 ? CGI::a({-href=>"$url?$auth"}, $name)
166 : $name;
167 }
168 return join($sep, @result), "\n";
169}
170
171sub siblingsMacro {
172 my $self = shift;
173 my @siblings = @_;
174 my $sep = CGI::br();
175 my $auth = $self->url_authen_args;
176 my @result;
177 while (@siblings) {
178 my $name = shift @siblings;
179 my $url = shift @siblings;
180 push @result, $url
181 ? CGI::a({-href=>"$url?$auth"}, $name)
182 : $name;
183 }
184 return join($sep, @result), "\n";
185}
186
187sub navMacro {
188 my $self = shift;
189 my %args = %{ shift() };
190 my @links = @_;
191 my $auth = $self->url_authen_args;
192 my @result;
193 while (@links) {
194 my $name = shift @links;
195 my $url = shift @links;
196 push @result, $url
197 ? CGI::a({-href=>"$url?$auth"}, $name)
198 : $name;
199 }
200 return join($args{separator}, @result), "\n";
201}
202
203# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in
204# LIST (or all fields if list is empty), taking data from the current request.
205#
206sub hidden_fields($;@) {
207 my $self = shift;
176 my $r = $self->{r}; 208 my $r = $self->{r};
209 my @fields = @_;
210 @fields or @fields = $r->param;
177 my $courseEnvironment = $self->{courseEnvironment}; 211 my $courseEnvironment = $self->{courseEnvironment};
212 my $html = "";
178 213
179 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 214 foreach my $param (@fields) {
180 my @template = <TEMPLATE>; 215 my $value = $r->param($param);
181 close TEMPLATE; 216 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});
217 }
218 return $html;
219}
220
221# hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for
222# request fields used in authentication.
223#
224sub hidden_authen_fields($) {
225 my $self = shift;
226 return $self->hidden_fields("user","effectiveUser","key");
227}
228
229# url_args(LIST) - return a URL query string (without the leading `?')
230# containing values for each field mentioned in LIST, or all fields if list is
231# empty. Data is taken from the current request.
232#
233sub url_args($;@) {
234 my $self = shift;
235 my $r = $self->{r};
236 my @fields = @_;
237 @fields or @fields = $r->param;
238 my $courseEnvironment = $self->{courseEnvironment};
182 239
240 my @pairs;
241 foreach my $param (@fields) {
242 my $value = $r->param($param) || "";
243 push @pairs, uri_escape($param) . "=" . uri_escape($value);
244 }
245
246 return join("&", @pairs);
247}
248
249# url_authen_args() - use url_args to return a URL query string for request
250# fields used in authentication.
251#
252sub url_authen_args($) {
253 my $self = shift;
254 my $r = $self->{r};
255 return $self->url_args("user","effectiveUser","key");
256}
257
258# print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request
259# fields not matched by OMIT, placing BEGIN before each field name, MIDDLE
260# between each field and its value, and END after each value. Values are taken
261# from the current request. OMIT is a quoted reguar expression.
262#
263sub print_form_data {
264 my ($self, $begin, $middle, $end, $qr_omit) = @_;
265 my $return_string = "";
266 my $r=$self->{r};
267 my @form_data = $r->param;
183 foreach my $line (@template) { 268 foreach my $name (@form_data) {
184 # This is incremental regex processing. 269 next if ($qr_omit and $name =~ /$qr_omit/);
185 # the /c is so that pos($line) doesn't die when the regex fails. 270 my @values = $r->param($name);
186 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 271 foreach my $variable (qw(begin name middle value end)) {
187 my ($before, $function, $raw_args) = ($1, $2, $3); 272 no strict 'refs';
188 # $args here will be a hashref 273 ${$variable} = "" unless defined ${$variable};
189 my $args = $raw_args =~ /\S/ ? cook_args $raw_args : {};
190 print $before;
191
192 print $self->$function(@_, $args) if $self->can($function);
193 } 274 }
275 foreach my $value (@values) {
276 $return_string .= "$begin$name$middle$value$end";
194 277 }
195 print substr $line, (defined(pos($line)) ? pos($line) : 0);
196 } 278 }
279 return $return_string;
197} 280}
198 281
199# Do whatever needs to be done in order to get a page to the client. You 282################################################################################
200# probably don't want to override this unless you're not making a web page 283# Generic versions of template escapes
201# with the template. 284################################################################################
202sub go { 285
286# Reminder: here are the template functions currently defined:
287#
288# path
289# style = text|image
290# image = URL of image
291# text = text separator
292# quicklinks
293# siblings
294# nav
295# style = text|image
296# imageprefix = prefix to image URL
297# imagesuffix = suffix to image URL
298# separator = HTML to place in between links
299# title
300# body
301
302sub header {
203 my $self = shift; 303 my $self = shift;
204 my $r = $self->{r}; 304 my $r = $self->{r};
305 $r->content_type('text/html');
306 $r->send_http_header();
307}
308
309sub quicklinks {
310 my $self = shift;
205 my $courseEnvironment = $self->{courseEnvironment}; 311 my $ce = $self->{courseEnvironment};
312 my $root = $ce->{webworkURLs}->{root};
313 my $courseName = $ce->{courseName};
314 my $probSets = "$root/$courseName/?" . $self->url_authen_args();
315# my $prefs = "$root/prefs/?" . $self->url_authen_args();
316# my $help = $ce->{webworkURLs}->{docs} . "?" . $self->url_authen_args();
317 return CGI::p(
318 CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(),
319# CGI::a({-href=>$prefs}, "User Options"), CGI::br(),
320# CGI::a({-href=>$help}, "Help"), CGI::br(),
321 );
322}
206 323
207 $self->pre_header_initialize(@_); 324sub title {
208 $self->header(@_); return OK if $r->header_only; 325 return "WeBWorK";
209 $self->initialize(@_); 326}
210
211 $self->template($courseEnvironment->{templates}->{system}, @_);
212 327
213 return OK; 328sub body {
329 return "Generated content";
214} 330}
215 331
2161; 3321;
Legend:
Removed from v.468  
changed lines
  Added in v.469
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9