Parent Directory
| 
Revision Log
removed "nowrap" from barebones.template because it wasn't doing anything anyway, and every byte counts ;-) Changed "Logged in as:" to "User:" in ContentGenerator and killed the CGI::br calls in that message and the "Acting as:" message Added more context to the context URL in Feedback, and properly obfuscated some code. --Dennis
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator; 7 8 =head1 NAME 9 10 WeBWorK::ContentGenerator - base class for modules that generate page content. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use Apache::Constants qw(:common); 17 use CGI qw(); 18 use URI::Escape; 19 use WeBWorK::DB::Auth; 20 use WeBWorK::Utils qw(readFile); 21 use Carp qw(cluck); 22 23 ################################################################################ 24 # This is a very unruly file, so I'm going to use very large comments to divide 25 # it into logical sections. 26 ################################################################################ 27 28 # new(Apache::Request, WeBWorK::CourseEnvironment) - create a new instance of a 29 # content generator. Usually only called by the dispatcher, although one might 30 # be able to use it for things like "sub-requests". Uh... uh... I have to think 31 # about that one. The dispatcher uses this idiom: 32 # 33 # 34 # WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever); 35 # 36 # and throws away the result ;) 37 # 38 sub new($$$) { 39 my $invocant = shift; 40 my $class = ref($invocant) || $invocant; 41 my $self = {}; 42 ($self->{r}, $self->{courseEnvironment}) = @_; 43 bless $self, $class; 44 return $self; 45 } 46 47 ################################################################################ 48 # Invocation and template processing 49 ################################################################################ 50 51 # go(@otherArguments) - render a page, using methods from the particular 52 # subclass of ContentGenerator. @otherArguments is passed to each method, so 53 # that the dispatcher can pass CG-specific data. The order of calls looks like 54 # this: 55 # 56 # * &pre_header_initialize - give subclasses a chance to do initialization 57 # necessary for generating the HTTP header. 58 # * &header - this class provides a standard HTTP header with Content-Type 59 # text/html. Subclasses are welcome to overload this for things like 60 # an image-creation content generator or a PDF generator. 61 # * &initialize - let subclasses do post-header initialization. 62 # * any "template escapes" defined in the system template and supported by 63 # the subclass. Generic implementations of &title and &body are provided. 64 # 65 sub go { 66 my $self = shift; 67 my $r = $self->{r}; 68 my $courseEnvironment = $self->{courseEnvironment}; 69 70 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 71 $self->header(@_); 72 return OK if $r->header_only; 73 74 $self->initialize(@_) if $self->can("initialize"); 75 $self->template($courseEnvironment->{templates}->{system}, @_); 76 77 return OK; 78 } 79 80 # template(STRING, @otherArguments) - parse a template, looking for escapes of 81 # the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME 82 # (if available) for each NAME. The escapes are called like: 83 # 84 # $self->NAME(@otherArguments, \%escapeArguments) 85 # 86 # where @otherArguments originates in the dispatcher and %escapeArguments is 87 # parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR) 88 # 89 sub template { 90 my ($self, $templateFile) = (shift, shift); 91 my $r = $self->{r}; 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--> 95 96 # so even though the variable $/ APPEARS to contain a newline, 97 # <TEMPLATE> is slurping the whole file into the first element of 98 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 99 # 100 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 101 #my @template = <TEMPLATE>; 102 #close TEMPLATE; 103 # 104 # Let's try something else instead: 105 my @template = split /\n/, readFile($templateFile); 106 107 foreach my $line (@template) { 108 # This is incremental regex processing. 109 # the /c is so that pos($line) doesn't die when the regex fails. 110 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 111 my ($before, $function, $raw_args) = ($1, $2, $3); 112 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : (); 113 114 if ($ifstack[-1]) { 115 print $before; 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 } 130 } 131 132 if ($ifstack[-1]) { 133 print substr($line, (defined pos $line) ? pos $line : 0), "\n"; 134 } 135 } 136 } 137 138 # cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 139 # a list which pairs into key/values and fits nicely in {}s. 140 # 141 sub cook_args($) { 142 my ($raw_args) = @_; 143 my @args = (); 144 145 # Boy I love m//g in scalar context! Go read the camel book, heathen. 146 # First, get the whole token with the quotes on both ends... 147 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) { 148 my ($key, $value) = ($1, $2); 149 # ... then, rip out all the protecty backspaces 150 $value =~ s/\\(.)/$1/g; 151 push @args, $key => $value; 152 } 153 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($). 164 sub 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; 186 } 187 188 ################################################################################ 189 # Macros used by content generators to render common idioms 190 ################################################################################ 191 192 # pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash 193 # reference contains the "style", "image", and "text" arguments to the escape. 194 # The LIST consists of ordered key-value pairs of the form: 195 # 196 # "Page Name" => URL 197 # 198 # If the page should not have a link associated with it, the URL should be left 199 # empty. Authentication data is added to the URL so you don't have to. A fully- 200 # formed path line is returned, suitable for returning by a function 201 # implementing the #path escape. 202 # 203 sub pathMacro { 204 my $self = shift; 205 my %args = %{ shift() }; 206 my @path = @_; 207 my $sep; 208 if ($args{style} eq "image") { 209 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 210 } else { 211 $sep = $args{text}; 212 } 213 my $auth = $self->url_authen_args; 214 my @result; 215 while (@path) { 216 my $name = shift @path; 217 my $url = shift @path; 218 push @result, $url 219 ? CGI::a({-href=>"$url?$auth"}, $name) 220 : $name; 221 } 222 return join($sep, @result), "\n"; 223 } 224 225 sub siblingsMacro { 226 my $self = shift; 227 my @siblings = @_; 228 my $sep = CGI::br(); 229 my $auth = $self->url_authen_args; 230 my @result; 231 while (@siblings) { 232 my $name = shift @siblings; 233 my $url = shift @siblings; 234 push @result, $url 235 ? CGI::a({-href=>"$url?$auth"}, $name) 236 : $name; 237 } 238 return join($sep, @result), "\n"; 239 } 240 241 sub navMacro { 242 my $self = shift; 243 my %args = %{ shift() }; 244 my $tail = shift; 245 my @links = @_; 246 my $auth = $self->url_authen_args; 247 my $ce = $self->{courseEnvironment}; 248 my @result; 249 while (@links) { 250 my $name = shift @links; 251 my $url = shift @links; 252 my $img = shift @links; 253 my $html = ($img && $args{style} eq "images") ? CGI::img({src=>($args{imageprefix}.$img.$args{imagesuffix}), border=>""}): $name; 254 unless($img && !$url) { 255 push @result, $url 256 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 257 : $html; 258 } 259 } 260 return join($args{separator}, @result), "\n"; 261 } 262 263 # hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in 264 # LIST (or all fields if list is empty), taking data from the current request. 265 # 266 sub hidden_fields($;@) { 267 my $self = shift; 268 my $r = $self->{r}; 269 my @fields = @_; 270 @fields or @fields = $r->param; 271 my $courseEnvironment = $self->{courseEnvironment}; 272 my $html = ""; 273 274 foreach my $param (@fields) { 275 my $value = $r->param($param); 276 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 277 } 278 return $html; 279 } 280 281 # hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for 282 # request fields used in authentication. 283 # 284 sub hidden_authen_fields($) { 285 my $self = shift; 286 return $self->hidden_fields("user","effectiveUser","key"); 287 } 288 289 # url_args(LIST) - return a URL query string (without the leading `?') 290 # containing values for each field mentioned in LIST, or all fields if list is 291 # empty. Data is taken from the current request. 292 # 293 sub url_args($;@) { 294 my $self = shift; 295 my $r = $self->{r}; 296 my @fields = @_; 297 @fields or @fields = $r->param; 298 my $courseEnvironment = $self->{courseEnvironment}; 299 300 my @pairs; 301 foreach my $param (@fields) { 302 my $value = $r->param($param) || ""; 303 push @pairs, uri_escape($param) . "=" . uri_escape($value); 304 } 305 306 return join("&", @pairs); 307 } 308 309 # url_authen_args() - use url_args to return a URL query string for request 310 # fields used in authentication. 311 # 312 sub url_authen_args($) { 313 my $self = shift; 314 my $r = $self->{r}; 315 return $self->url_args("user","effectiveUser","key"); 316 } 317 318 # print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request 319 # fields not matched by OMIT, placing BEGIN before each field name, MIDDLE 320 # between each field and its value, and END after each value. Values are taken 321 # from the current request. OMIT is a quoted reguar expression. 322 # 323 sub print_form_data { 324 my ($self, $begin, $middle, $end, $qr_omit) = @_; 325 my $return_string = ""; 326 my $r=$self->{r}; 327 my @form_data = $r->param; 328 foreach my $name (@form_data) { 329 next if ($qr_omit and $name =~ /$qr_omit/); 330 my @values = $r->param($name); 331 foreach my $variable (qw(begin name middle value end)) { 332 no strict 'refs'; 333 ${$variable} = "" unless defined ${$variable}; 334 } 335 foreach my $value (@values) { 336 $return_string .= "$begin$name$middle$value$end"; 337 } 338 } 339 return $return_string; 340 } 341 342 sub errorOutput($$$) { 343 my ($self, $error, $details) = @_; 344 return 345 CGI::h2("Software Error"), 346 CGI::p(<<EOF), 347 WeBWorK has encountered a software error while attempting to process this problem. 348 It is likely that there is an error in the problem itself. 349 If you are a student, contact your professor to have the error corrected. 350 If you are a professor, please consut the error output below for more informaiton. 351 EOF 352 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)), 353 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details)); 354 } 355 356 sub warningOutput($$) { 357 my ($self, $warnings) = @_; 358 359 return 360 CGI::h2("Software Warnings"), 361 CGI::p(<<EOF), 362 WeBWorK has encountered warnings while attempting to process this problem. 363 It is likely that this indicates an error or ambiguity in the problem itself. 364 If you are a student, contact your professor to have the problem corrected. 365 If you are a professor, please consut the error output below for more informaiton. 366 EOF 367 CGI::h3("Warning messages"), 368 CGI::blockquote(CGI::pre($warnings)), 369 ; 370 } 371 372 ################################################################################ 373 # Generic versions of template escapes 374 ################################################################################ 375 376 # Reminder: here are the template functions currently defined: 377 # 378 # head 379 # path 380 # style = text|image 381 # image = URL of image 382 # text = text separator 383 # loginstatus 384 # links 385 # siblings 386 # nav 387 # style = text|image 388 # imageprefix = prefix to image URL 389 # imagesuffix = suffix to image URL 390 # separator = HTML to place in between links 391 # title 392 # body 393 394 sub header { 395 my $self = shift; 396 my $r = $self->{r}; 397 $r->content_type('text/html'); 398 $r->send_http_header(); 399 } 400 401 sub loginstatus { 402 my $self = shift; 403 my $r = $self->{r}; 404 my $user = $r->param("user"); 405 my $eUser = $r->param("effectiveUser"); 406 my $key = $r->param("key"); 407 return "" unless $key; 408 my $exitURL = $r->uri() . "?user=$user&key=$key"; 409 print CGI::small("User:", "$user"); 410 if ($user ne $eUser) { 411 print CGI::br(), CGI::font({-color=>'red'}, 412 CGI::small("Acting as:", "$eUser") 413 ), 414 CGI::br(), CGI::a({-href=>$exitURL}, 415 CGI::small("Stop Acting") 416 ); 417 } 418 return ""; 419 } 420 421 # *** drunk code. rewrite. 422 # also, this should be structured s.t. subclasses can add items to the links 423 # area, i.e. "stacking" 424 sub links { 425 my $self = shift; 426 my $ce = $self->{courseEnvironment}; 427 my $userName = $self->{r}->param("user"); 428 my $courseName = $ce->{courseName}; 429 my $root = $ce->{webworkURLs}->{root}; 430 my $permLevel = WeBWorK::DB::Auth->new($ce)->getPermissions($userName); 431 my $key = WeBWorK::DB::Auth->new($ce)->getKey($userName); 432 return "" unless defined $key; 433 434 # URLs to parts of the system 435 my $probSets = "$root/$courseName/?" . $self->url_authen_args(); 436 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); 437 my $prof = "$root/$courseName/prof/?" . $self->url_authen_args(); 438 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); 439 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); 440 441 return 442 CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), 443 CGI::a({-href=>$prefs}, "User Options"), CGI::br(), 444 ($permLevel > 0 445 ? CGI::a({-href=>$prof}, "Professor") . CGI::br() 446 : ""), 447 CGI::a({-href=>$help}, "Help"), CGI::br(), 448 CGI::a({-href=>$logout}, "Log Out"), CGI::br(), 449 ; 450 } 451 452 # &if_can will return 1 if the current object->can("do $_[1]") 453 sub if_can ($$) { 454 my ($self, $arg) = (@_); 455 456 if ($self->can("$arg")) { 457 return 1; 458 } else { 459 return 0; 460 } 461 } 462 463 # Every content generator is logged in unless it says otherwise. 464 sub if_loggedin($$) { 465 my ($self, $arg) = (@_); 466 467 return $arg; 468 } 469 470 1; 471 472 __END__ 473 474 =head1 AUTHOR 475 476 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu 477 and Sam Hathaway, sh002i (at) math.rochester.edu. 478 479 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |