Parent Directory
| 
Revision Log
Tweaked the links section a bit. Moved instructor links into their own submethod, since they were getting complicated. --Mike
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::Authz; 20 use WeBWorK::DB; 21 use WeBWorK::Utils qw(readFile); 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 # WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever); 34 # 35 # and throws away the result ;) 36 # 37 sub new($$$$) { 38 my ($invocant, $r, $ce, $db) = @_; 39 my $class = ref($invocant) || $invocant; 40 my $self = { 41 r => $r, 42 ce => $ce, 43 db => $db, 44 authz => WeBWorK::Authz->new($r, $ce, $db) 45 }; 46 bless $self, $class; 47 return $self; 48 } 49 50 ################################################################################ 51 # Invocation and template processing 52 ################################################################################ 53 54 # go(@otherArguments) - render a page, using methods from the particular 55 # subclass of ContentGenerator. @otherArguments is passed to each method, so 56 # that the dispatcher can pass CG-specific data. The order of calls looks like 57 # this: 58 # 59 # * &pre_header_initialize - give subclasses a chance to do initialization 60 # necessary for generating the HTTP header. 61 # * &header - this class provides a standard HTTP header with Content-Type 62 # text/html. Subclasses are welcome to overload this for things like 63 # an image-creation content generator or a PDF generator. 64 # * &initialize - let subclasses do post-header initialization. 65 # * any "template escapes" defined in the system template and supported by 66 # the subclass. Generic implementations of &title and &body are provided. 67 # 68 sub go { 69 my $self = shift; 70 71 my $r = $self->{r}; 72 my $courseEnvironment = $self->{ce}; 73 74 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 75 $self->header(@_); 76 return OK if $r->header_only; 77 78 $self->initialize(@_) if $self->can("initialize"); 79 $self->template($courseEnvironment->{templates}->{system}, @_); 80 81 return OK; 82 } 83 84 # template(STRING, @otherArguments) - parse a template, looking for escapes of 85 # the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME 86 # (if available) for each NAME. The escapes are called like: 87 # 88 # $self->NAME(@otherArguments, \%escapeArguments) 89 # 90 # where @otherArguments originates in the dispatcher and %escapeArguments is 91 # parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR) 92 # 93 sub template { 94 my ($self, $templateFile) = (shift, shift); 95 my $r = $self->{r}; 96 my $courseEnvironment = $self->{ce}; 97 my @ifstack = (1); # Start off in printing mode 98 # say $ifstack[-1] to get the result of the last <#!--if--> 99 100 # so even though the variable $/ APPEARS to contain a newline, 101 # <TEMPLATE> is slurping the whole file into the first element of 102 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 103 # 104 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 105 #my @template = <TEMPLATE>; 106 #close TEMPLATE; 107 # 108 # Let's try something else instead: 109 my @template = split /\n/, readFile($templateFile); 110 111 foreach my $line (@template) { 112 # This is incremental regex processing. 113 # the /c is so that pos($line) doesn't die when the regex fails. 114 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 115 my ($before, $function, $raw_args) = ($1, $2, $3); 116 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : (); 117 118 if ($ifstack[-1]) { 119 print $before; 120 } 121 122 if ($function eq "if") { 123 # a predicate can only be true if everything else on the ifstack is already true, for ANDing 124 push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]); 125 } elsif ($function eq "else" and @ifstack > 1) { 126 $ifstack[-1] = not $ifstack[-1]; 127 } elsif ($function eq "endif" and @ifstack > 1) { 128 pop @ifstack; 129 } elsif ($ifstack[-1]) { 130 if ($self->can($function)) { 131 my @result = $self->$function(@_, {@args}); 132 if (@result) { 133 print @result; 134 } else { 135 warn "Template escape $function returned an empty list."; 136 } 137 } 138 } 139 } 140 141 if ($ifstack[-1]) { 142 print substr($line, (defined pos $line) ? pos $line : 0), "\n"; 143 } 144 } 145 } 146 147 # cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 148 # a list which pairs into key/values and fits nicely in {}s. 149 # 150 sub cook_args($) { # ... also used by bin/wwdb, so watch out 151 my ($raw_args) = @_; 152 my @args = (); 153 154 # Boy I love m//g in scalar context! Go read the camel book, heathen. 155 # First, get the whole token with the quotes on both ends... 156 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) { 157 my ($key, $value) = ($1, $2); 158 # ... then, rip out all the protecty backspaces 159 $value =~ s/\\(.)/$1/g; 160 push @args, $key => $value; 161 } 162 163 return @args; 164 } 165 166 # This is different. It probably shouldn't print anything (except in debugging cases) 167 # and it should return a boolean, not a string. &if is called in a nonstandard way 168 # by &template, with $args as an arrayref instead of a hashref. this is a hack! yay! 169 170 # OK, this is a pluggin architecture. it iterates through attributes of the "if" tag, 171 # and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the 172 # grand templating theme of an object-oriented pluggable architecture using ->can($). 173 sub if { 174 my ($self, $args) = @_[0,-1]; 175 # A single if "or"s it's components. Nesting produces "and". 176 177 my @args = @$args; # Hahahahaha, get it?! 178 179 if (@args % 2 != 0) { 180 # flip out and kill people, but do not commit seppuku 181 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n'; 182 } 183 184 while (@args > 1) { 185 my ($key, $value) = (shift @args, shift @args); 186 187 # a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK 188 my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation 189 if ($self->can("if_$key") and $self->$sub("$value")) { 190 return 1; 191 } 192 } 193 194 return 0; 195 } 196 197 ################################################################################ 198 # Macros used by content generators to render common idioms 199 ################################################################################ 200 201 # pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash 202 # reference contains the "style", "image", and "text" arguments to the escape. 203 # The LIST consists of ordered key-value pairs of the form: 204 # 205 # "Page Name" => URL 206 # 207 # If the page should not have a link associated with it, the URL should be left 208 # empty. Authentication data is added to the URL so you don't have to. A fully- 209 # formed path line is returned, suitable for returning by a function 210 # implementing the #path escape. 211 # 212 sub pathMacro { 213 my $self = shift; 214 my %args = %{ shift() }; 215 my @path = @_; 216 my $sep; 217 if ($args{style} eq "image") { 218 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 219 } else { 220 $sep = $args{text}; 221 } 222 my $auth = $self->url_authen_args; 223 my @result; 224 while (@path) { 225 my $name = shift @path; 226 my $url = shift @path; 227 push @result, $url 228 ? CGI::a({-href=>"$url?$auth"}, $name) 229 : $name; 230 } 231 return join($sep, @result) . "\n"; 232 } 233 234 sub siblingsMacro { 235 my $self = shift; 236 my @siblings = @_; 237 my $sep = CGI::br(); 238 my $auth = $self->url_authen_args; 239 my @result; 240 while (@siblings) { 241 my $name = shift @siblings; 242 my $url = shift @siblings; 243 push @result, $url 244 ? CGI::a({-href=>"$url?$auth"}, $name) 245 : $name; 246 } 247 return join($sep, @result), "\n"; 248 } 249 250 sub navMacro { 251 my $self = shift; 252 my %args = %{ shift() }; 253 my $tail = shift; 254 my @links = @_; 255 my $auth = $self->url_authen_args; 256 my $ce = $self->{ce}; 257 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 258 my @result; 259 while (@links) { 260 my $name = shift @links; 261 my $url = shift @links; 262 my $img = shift @links; 263 my $html = 264 ($img && $args{style} eq "images") 265 ? CGI::img( 266 {src=>($prefix."/".$img.$args{imagesuffix}), 267 border=>"", 268 alt=>"$name"}) 269 : $name; 270 unless($img && !$url) { 271 push @result, $url 272 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 273 : $html; 274 } 275 } 276 return join($args{separator}, @result) . "\n"; 277 } 278 279 # hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in 280 # LIST (or all fields if list is empty), taking data from the current request. 281 # 282 sub hidden_fields($;@) { 283 my $self = shift; 284 my $r = $self->{r}; 285 my @fields = @_; 286 @fields or @fields = $r->param; 287 my $courseEnvironment = $self->{ce}; 288 my $html = ""; 289 290 foreach my $param (@fields) { 291 my $value = $r->param($param); 292 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 293 } 294 return $html; 295 } 296 297 # hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for 298 # request fields used in authentication. 299 # 300 sub hidden_authen_fields($) { 301 my $self = shift; 302 return $self->hidden_fields("user","effectiveUser","key"); 303 } 304 305 # url_args(LIST) - return a URL query string (without the leading `?') 306 # containing values for each field mentioned in LIST, or all fields if list is 307 # empty. Data is taken from the current request. 308 # 309 sub url_args($;@) { 310 my $self = shift; 311 my $r = $self->{r}; 312 my @fields = @_; 313 @fields or @fields = $r->param; 314 my $courseEnvironment = $self->{ce}; 315 316 my @pairs; 317 foreach my $param (@fields) { 318 my $value = $r->param($param) || ""; 319 push @pairs, uri_escape($param) . "=" . uri_escape($value); 320 } 321 322 return join("&", @pairs); 323 } 324 325 # url_authen_args() - use url_args to return a URL query string for request 326 # fields used in authentication. 327 # 328 sub url_authen_args($) { 329 my $self = shift; 330 my $r = $self->{r}; 331 return $self->url_args("user","effectiveUser","key"); 332 } 333 334 # print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request 335 # fields not matched by OMIT, placing BEGIN before each field name, MIDDLE 336 # between each field and its value, and END after each value. Values are taken 337 # from the current request. OMIT is a quoted reguar expression. 338 # 339 sub print_form_data { 340 my ($self, $begin, $middle, $end, $qr_omit) = @_; 341 my $return_string = ""; 342 my $r=$self->{r}; 343 my @form_data = $r->param; 344 foreach my $name (@form_data) { 345 next if ($qr_omit and $name =~ /$qr_omit/); 346 my @values = $r->param($name); 347 foreach my $variable (qw(begin name middle value end)) { 348 no strict 'refs'; 349 ${$variable} = "" unless defined ${$variable}; 350 } 351 foreach my $value (@values) { 352 $return_string .= "$begin$name$middle$value$end"; 353 } 354 } 355 return $return_string; 356 } 357 358 sub errorOutput($$$) { 359 my ($self, $error, $details) = @_; 360 return 361 CGI::h3("Software Error"), 362 CGI::p(<<EOF), 363 WeBWorK has encountered a software error while attempting to process this 364 problem. It is likely that there is an error in the problem itself. If you are 365 a student, contact your professor to have the error corrected. If you are a 366 professor, please consut the error output below for more informaiton. 367 EOF 368 CGI::h3("Error messages"), CGI::p(CGI::tt($error)), 369 CGI::h3("Error context"), CGI::p(CGI::tt($details)); 370 } 371 372 sub warningOutput($$) { 373 my ($self, $warnings) = @_; 374 375 my @warnings = split m/\n+/, $warnings; 376 377 return 378 CGI::h3("Software Warnings"), 379 CGI::p(<<EOF), 380 WeBWorK has encountered warnings while attempting to process this problem. It 381 is likely that this indicates an error or ambiguity in the problem itself. If 382 you are a student, contact your professor to have the problem corrected. If you 383 are a professor, please consut the warning output below for more informaiton. 384 EOF 385 CGI::h3("Warning messages"), 386 CGI::ul(CGI::li(\@warnings)), 387 ; 388 } 389 390 ################################################################################ 391 # Generic versions of template escapes 392 ################################################################################ 393 394 # Reminder: here are the template functions currently defined: 395 # FIXME: this list is out of date!!!!!!!! 396 # 397 # head 398 # path 399 # style = text|image 400 # image = URL of image 401 # text = text separator 402 # loginstatus 403 # links 404 # siblings 405 # nav 406 # style = text|image 407 # imageprefix = prefix to image URL 408 # imagesuffix = suffix to image URL 409 # separator = HTML to place in between links 410 # title 411 # body 412 413 sub header { 414 my $self = shift; 415 my $r = $self->{r}; 416 $r->content_type('text/html'); 417 $r->send_http_header(); 418 } 419 420 sub loginstatus { 421 my $self = shift; 422 my $r = $self->{r}; 423 my $user = $r->param("user"); 424 my $eUser = $r->param("effectiveUser"); 425 my $key = $r->param("key"); 426 return "" unless $key; 427 my $exitURL = $r->uri() . "?user=$user&key=$key"; 428 print CGI::small("User:", "$user"); 429 if ($user ne $eUser) { 430 print CGI::br(), CGI::font({-color=>'red'}, 431 CGI::small("Acting as:", "$eUser") 432 ), 433 CGI::br(), CGI::a({-href=>$exitURL}, 434 CGI::small("Stop Acting") 435 ); 436 } 437 return ""; 438 } 439 440 # FIXME: drunk code. rewrite. 441 # also, this should be structured s.t. subclasses can add items to the links 442 # area, i.e. "stacking" 443 sub links { 444 my $self = shift; 445 my @components = @_; 446 my $ce = $self->{ce}; 447 my $db = $self->{db}; 448 my $userName = $self->{r}->param("user"); 449 my $courseName = $ce->{courseName}; 450 my $root = $ce->{webworkURLs}->{root}; 451 my $permLevel = $db->getPermissionLevel($userName)->permission(); 452 my $key = $db->getKey($userName)->key(); 453 return "" unless defined $key; 454 455 # URLs to parts of the system 456 my $probSets = "$root/$courseName/?" . $self->url_authen_args(); 457 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); 458 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); 459 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); 460 461 return join("", 462 CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), 463 CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(), 464 CGI::a({-href=>$help}, "Help"), CGI::br(), 465 CGI::a({-href=>$logout}, "Log Out"), CGI::br(), 466 ($permLevel > 0 467 ? $self->instructor_links(@components) : "" 468 ), 469 ); 470 } 471 sub instructor_links { 472 my $self = shift; 473 my @components = @_; 474 my $args = pop(@components); # get hash of option arguments 475 my $courseName = $self->{ce}->{courseName}; 476 my $root = $self->{ce}->{webworkURLs}->{root}; 477 478 my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args(); 479 my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args(); 480 my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args(); 481 my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args(); 482 my ($set, $prob) = @components; 483 # Add direct links to sets e.g. 3:4 for set3 problem 4 484 my $setURL = (defined($set)) ? "$root/$courseName/instructor/sets/$set/?" . 485 $self->url_authen_args() : ''; 486 my $probURL = (defined($set) && defined($prob)) ? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" . 487 $self->url_authen_args() : ''; 488 my $setProb = ($setURL) ? CGI::a({-href=>$setURL},$set ) : ''; 489 490 $setProb .= ':'.CGI::a({-href=>$probURL},$prob) if $setProb && $probURL; 491 join("", 492 CGI::hr(), 493 CGI::a({-href=>$instructor}, "Instructor") , CGI::br(), 494 ' ',CGI::a({-href=>$sets}, "Set List") ," ", $setProb, CGI::br(), 495 ' ',CGI::a({-href=>$users}, "Class List") , CGI::br(), 496 ' ',CGI::a({-href=>$email}, "Send Email") , CGI::br(), 497 498 ) 499 500 } 501 # &if_can will return 1 if the current object->can("do $_[1]") 502 sub if_can ($$) { 503 my ($self, $arg) = (@_); 504 505 if ($self->can("$arg")) { 506 return 1; 507 } else { 508 return 0; 509 } 510 } 511 512 # Every content generator is logged in unless it says otherwise. 513 sub if_loggedin($$) { 514 my ($self, $arg) = (@_); 515 516 return $arg; 517 } 518 519 # Handling of errors in submissions 520 521 sub if_submiterror($$) { 522 my ($self, $arg) = @_; 523 if (exists $self->{submitError}) { 524 return $arg; 525 } else { 526 return !$arg; 527 } 528 } 529 530 sub submiterror { 531 my ($self) = @_; 532 if (exists $self->{submitError}) { 533 return $self->{submitError}; 534 } else { 535 return ""; 536 } 537 } 538 539 # General warning handling 540 541 sub if_warnings($$) { 542 my ($self, $arg) = @_; 543 return $self->{r}->notes("warnings") ? $arg : !$arg; 544 } 545 546 sub warnings { 547 my ($self) = @_; 548 my $r = $self->{r}; 549 if ($r->notes("warnings")) { 550 return $self->warningOutput($r->notes("warnings")); 551 } else { 552 return ""; 553 } 554 } 555 556 1; 557 558 __END__ 559 560 =head1 AUTHOR 561 562 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu 563 and Sam Hathaway, sh002i (at) math.rochester.edu. 564 565 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |