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

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

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

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