[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 494 Revision 798
… …
14use strict; 14use strict;
15use warnings; 15use warnings;
16use Apache::Constants qw(:common); 16use Apache::Constants qw(:common);
17use CGI qw(); 17use CGI qw();
18use URI::Escape; 18use URI::Escape;
19use WeBWorK::DB::Auth;
19use WeBWorK::Utils qw(readFile); 20use WeBWorK::Utils qw(readFile);
20#use CGI::Carp qw(fatalsToBrowser); 21use Carp qw(cluck);
21 22
22################################################################################ 23################################################################################
23# This is a very unruly file, so I'm going to use very large comments to divide 24# This is a very unruly file, so I'm going to use very large comments to divide
24# it into logical sections. 25# it into logical sections.
25################################################################################ 26################################################################################
… …
87# 88#
88sub template { 89sub template {
89 my ($self, $templateFile) = (shift, shift); 90 my ($self, $templateFile) = (shift, shift);
90 my $r = $self->{r}; 91 my $r = $self->{r};
91 my $courseEnvironment = $self->{courseEnvironment}; 92 my $courseEnvironment = $self->{courseEnvironment};
93 my @ifstack = (1); # Start off in printing mode
94 # say $ifstack[-1] to get the result of the last <#!--if-->
92 95
93 # so even though the variable $/ APPEARS to contain a newline, 96 # so even though the variable $/ APPEARS to contain a newline,
94 # <TEMPLATE> is slurping the whole file into the first element of 97 # <TEMPLATE> is slurping the whole file into the first element of
95 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 98 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!!
96 # 99 #
97 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 100 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
98 #my @template = <TEMPLATE>; 101 #my @template = <TEMPLATE>;
99 #close TEMPLATE; 102 #close TEMPLATE;
100 # 103 #
101 # Let's try something else instead: 104 # Let's try something else instead:
102
103 my @template = split /\n/, readFile($templateFile); 105 my @template = split /\n/, readFile($templateFile);
104 106
105 foreach my $line (@template) { 107 foreach my $line (@template) {
106 #warn "foo: $line\n";
107 # This is incremental regex processing. 108 # This is incremental regex processing.
108 # the /c is so that pos($line) doesn't die when the regex fails. 109 # the /c is so that pos($line) doesn't die when the regex fails.
109 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 110 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
110 my ($before, $function, $raw_args) = ($1, $2, $3); 111 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) : {}; 112 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : ();
113 print $before;
114 113
115 if ($self->can($function)) { 114 if ($ifstack[-1]) {
116 print $self->$function(@_, $args); 115 print $before;
117 } 116 }
117
118 if ($function eq "if") {
119 # a predicate can only be true if everything else on the ifstack is already true, for ANDing
120 push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]);
121 } elsif ($function eq "else" and @ifstack > 1) {
122 $ifstack[-1] = not $ifstack[-1];
123 } elsif ($function eq "endif" and @ifstack > 1) {
124 pop @ifstack;
125 } elsif ($ifstack[-1]) {
126 if ($self->can($function)) {
127 print $self->$function(@_, {@args});
128 }
129 }
118 } 130 }
119 131
132 if ($ifstack[-1]) {
120 print substr $line, (defined(pos($line)) ? pos($line) : 0); 133 print substr($line, (defined pos $line) ? pos $line : 0), "\n";
134 }
121 } 135 }
122} 136}
123 137
124# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 138# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
125# a reference to a hash containing the parsed arguments. 139# a list which pairs into key/values and fits nicely in {}s.
126# 140#
127sub cook_args($) { 141sub cook_args($) { # ... also used by bin/wwdb, so watch out
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.
130 my ($raw_args) = @_; 142 my ($raw_args) = @_;
131 my $args = {}; 143 my @args = ();
132 #my $quotable_string = qr/(?:".*?(?<![^\\](?:\\\\)*\\)"|\W*)/;
133 #my $quotable_string = qr/(?:".*?(?<!\\)"|\W*)/;
134 #my $test_string = '"hel \" lo" hello';
135 144
136 #warn $test_string =~ m/($quotable_string)/ ? $1 : "false"; 145 # Boy I love m//g in scalar context! Go read the camel book, heathen.
137 146 # First, get the whole token with the quotes on both ends...
138 while ($raw_args =~ m/\G\s*(\w*)="(.*?)"/g) { 147 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) {
139 #while ($raw_args =~ m/\G\s*($quotable_string)=($quotable_string)/g) { 148 my ($key, $value) = ($1, $2);
140 $args->{$1} = $2; 149 # ... then, rip out all the protecty backspaces
150 $value =~ s/\\(.)/$1/g;
151 push @args, $key => $value;
141 } 152 }
142 153
143 return $args; 154 return @args;
155}
156
157# This is different. It probably shouldn't print anything (except in debugging cases)
158# and it should return a boolean, not a string. &if is called in a nonstandard way
159# by &template, with $args as an arrayref instead of a hashref. this is a hack! yay!
160
161# OK, this is a pluggin architecture. it iterates through attributes of the "if" tag,
162# and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the
163# grand templating theme of an object-oriented pluggable architecture using ->can($).
164sub if {
165 my ($self, $args) = @_[0,-1];
166 # A single if "or"s it's components. Nesting produces "and".
167
168 my @args = @$args; # Hahahahaha, get it?!
169
170 if (@args % 2 != 0) {
171 # flip out and kill people, but do not commit seppuku
172 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n';
173 }
174
175 while (@args > 1) {
176 my ($key, $value) = (shift @args, shift @args);
177
178 # a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK
179 my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation
180 if ($self->can("if_$key") and $self->$sub("$value")) {
181 return 1;
182 }
183 }
184
185 return 0;
144} 186}
145 187
146################################################################################ 188################################################################################
147# Macros used by content generators to render common idioms 189# Macros used by content generators to render common idioms
148################################################################################ 190################################################################################
… …
197} 239}
198 240
199sub navMacro { 241sub navMacro {
200 my $self = shift; 242 my $self = shift;
201 my %args = %{ shift() }; 243 my %args = %{ shift() };
244 my $tail = shift;
202 my @links = @_; 245 my @links = @_;
203 my $auth = $self->url_authen_args; 246 my $auth = $self->url_authen_args;
247 my $ce = $self->{courseEnvironment};
248 my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
204 my @result; 249 my @result;
205 while (@links) { 250 while (@links) {
206 my $name = shift @links; 251 my $name = shift @links;
207 my $url = shift @links; 252 my $url = shift @links;
208 push @result, $url 253 my $img = shift @links;
209 ? CGI::a({-href=>"$url?$auth"}, $name) 254 my $html =
255 ($img && $args{style} eq "images")
256 ? CGI::img(
257 {src=>($prefix."/".$img.$args{imagesuffix}),
258 border=>"",
259 alt=>"$name"})
210 : $name; 260 : $name;
261 unless($img && !$url) {
262 push @result, $url
263 ? CGI::a({-href=>"$url?$auth$tail"}, $html)
264 : $html;
265 }
211 } 266 }
212 return join($args{separator}, @result), "\n"; 267 return join($args{separator}, @result), "\n";
213} 268}
214 269
215# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in 270# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in
… …
289 } 344 }
290 } 345 }
291 return $return_string; 346 return $return_string;
292} 347}
293 348
349sub errorOutput($$$) {
350 my ($self, $error, $details) = @_;
351 return
352 CGI::h2("Software Error"),
353 CGI::p(<<EOF),
354WeBWorK has encountered a software error while attempting to process this problem.
355It is likely that there is an error in the problem itself.
356If you are a student, contact your professor to have the error corrected.
357If you are a professor, please consut the error output below for more informaiton.
358EOF
359 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
360 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
361}
362
363sub warningOutput($$) {
364 my ($self, $warnings) = @_;
365
366 return
367 CGI::h2("Software Warnings"),
368 CGI::p(<<EOF),
369WeBWorK has encountered warnings while attempting to process this problem.
370It is likely that this indicates an error or ambiguity in the problem itself.
371If you are a student, contact your professor to have the problem corrected.
372If you are a professor, please consut the error output below for more informaiton.
373EOF
374 CGI::h3("Warning messages"),
375 CGI::blockquote(CGI::pre($warnings)),
376 ;
377}
378
294################################################################################ 379################################################################################
295# Generic versions of template escapes 380# Generic versions of template escapes
296################################################################################ 381################################################################################
297 382
298# Reminder: here are the template functions currently defined: 383# Reminder: here are the template functions currently defined:
299# 384#
385# head
300# path 386# path
301# style = text|image 387# style = text|image
302# image = URL of image 388# image = URL of image
303# text = text separator 389# text = text separator
304# quicklinks 390# loginstatus
391# links
305# siblings 392# siblings
306# nav 393# nav
307# style = text|image 394# style = text|image
308# imageprefix = prefix to image URL 395# imageprefix = prefix to image URL
309# imagesuffix = suffix to image URL 396# imagesuffix = suffix to image URL
… …
316 my $r = $self->{r}; 403 my $r = $self->{r};
317 $r->content_type('text/html'); 404 $r->content_type('text/html');
318 $r->send_http_header(); 405 $r->send_http_header();
319} 406}
320 407
408sub loginstatus {
409 my $self = shift;
410 my $r = $self->{r};
411 my $user = $r->param("user");
412 my $eUser = $r->param("effectiveUser");
413 my $key = $r->param("key");
414 return "" unless $key;
415 my $exitURL = $r->uri() . "?user=$user&key=$key";
416 print CGI::small("User:", "$user");
417 if ($user ne $eUser) {
418 print CGI::br(), CGI::font({-color=>'red'},
419 CGI::small("Acting as:", "$eUser")
420 ),
421 CGI::br(), CGI::a({-href=>$exitURL},
422 CGI::small("Stop Acting")
423 );
424 }
425 return "";
426}
427
428# *** drunk code. rewrite.
429# also, this should be structured s.t. subclasses can add items to the links
430# area, i.e. "stacking"
321sub quicklinks { 431sub links {
322 my $self = shift; 432 my $self = shift;
323 my $ce = $self->{courseEnvironment}; 433 my $ce = $self->{courseEnvironment};
434 my $userName = $self->{r}->param("user");
435 my $courseName = $ce->{courseName};
324 my $root = $ce->{webworkURLs}->{root}; 436 my $root = $ce->{webworkURLs}->{root};
325 my $courseName = $ce->{courseName}; 437 my $permLevel = WeBWorK::DB::Auth->new($ce)->getPermissions($userName);
438 my $key = WeBWorK::DB::Auth->new($ce)->getKey($userName);
439 return "" unless defined $key;
440
441 # URLs to parts of the system
326 my $probSets = "$root/$courseName/?" . $self->url_authen_args(); 442 my $probSets = "$root/$courseName/?" . $self->url_authen_args();
327# my $prefs = "$root/prefs/?" . $self->url_authen_args(); 443 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args();
444 my $prof = "$root/$courseName/prof/?" . $self->url_authen_args();
328# my $help = $ce->{webworkURLs}->{docs} . "?" . $self->url_authen_args(); 445 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args();
329 my $logout = "$root/$courseName/"; 446 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args();
447
330 return 448 return
331 CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), 449 CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(),
332# CGI::a({-href=>$prefs}, "User Options"), CGI::br(), 450 CGI::a({-href=>$prefs}, "User Options"), CGI::br(),
451 ($permLevel > 0
452 ? CGI::a({-href=>$prof}, "Professor") . CGI::br()
453 : ""),
333# CGI::a({-href=>$help}, "Help"), CGI::br(), 454 CGI::a({-href=>$help}, "Help"), CGI::br(),
334 CGI::a({-href=>$logout}, "Log Out"), CGI::br(), 455 CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
335 ; 456 ;
336} 457}
337 458
338sub title { 459# &if_can will return 1 if the current object->can("do $_[1]")
339 return "WeBWorK"; 460sub if_can ($$) {
461 my ($self, $arg) = (@_);
462
463 if ($self->can("$arg")) {
464 return 1;
465 } else {
466 return 0;
467 }
340} 468}
341 469
342sub body { 470# Every content generator is logged in unless it says otherwise.
343 return "Generated content"; 471sub if_loggedin($$) {
472 my ($self, $arg) = (@_);
473
474 return $arg;
344} 475}
345 476
3461; 4771;
478
479__END__
480
481=head1 AUTHOR
482
483Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu
484and Sam Hathaway, sh002i (at) math.rochester.edu.
485
486=cut
Legend:
Removed from v.494  
changed lines
  Added in v.798
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9