Parent Directory
| 
Revision Log
added documentation, added support for a new "textonly" argument to the "path" macro.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.79 2004/03/06 18:50:00 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator; 18 19 =head1 NAME 20 21 WeBWorK::ContentGenerator - base class for modules that generate page content. 22 23 =head1 SYNOPSIS 24 25 # start with a WeBWorK::Request object: $r 26 27 use WeBWorK::ContentGenerator::SomeSubclass; 28 29 my $cg = WeBWorK::ContentGenerator::SomeSubclass->new($r); 30 my $result = $cg->go(); 31 32 =head1 DESCRIPTION 33 34 FIXME: write this 35 36 =cut 37 38 use strict; 39 use warnings; 40 use Apache::Constants qw(:common); 41 use CGI qw(); 42 use URI::Escape; 43 use WeBWorK::Authz; 44 use WeBWorK::DB; 45 use WeBWorK::Utils qw(readFile); 46 47 ################################################################################ 48 # This is a very unruly file, so I'm going to use very large comments to divide 49 # it into logical sections. 50 ################################################################################ 51 52 =head1 CONSTRUCTOR 53 54 =over 55 56 =item new($r) 57 58 Create a new instance of a content generator. Supply a WeBWorK::Request object 59 $r. 60 61 =cut 62 63 sub new { 64 my ($invocant, $r) = @_; 65 my $class = ref($invocant) || $invocant; 66 my $self = { 67 r => $r, # this is now a WeBWorK::Request 68 ce => $r->ce(), # these three are here for 69 db => $r->db(), # backward-compatability 70 authz => $r->authz(), # with unconverted CGs 71 noContent => undef, 72 }; 73 bless $self, $class; 74 return $self; 75 } 76 77 =back 78 79 =cut 80 81 ################################################################################ 82 # Invocation and template processing 83 ################################################################################ 84 85 =head1 INVOCATION 86 87 =over 88 89 =item go() 90 91 Render a page, using methods from the particular subclass of ContentGenerator. 92 go() will call the following methods when invoked: 93 94 =over 95 96 =item pre_header_initialize() 97 98 Give the subclass a chance to do initialization necessary before generating the 99 HTTP header. 100 101 =item header() 102 103 This method provides a standard HTTP header with Content-Type text/html. 104 Subclasses are welcome to override this for things like an image-creation 105 content generator or a PDF generator. In addition, if header() returns a value, 106 that will be the value returned by go(). 107 108 =item initialize() 109 110 Let the subclass do post-header initialization. 111 112 If pre_header_initialize() or header() sets $self->{noContent} to a true value, 113 initialize() will not be run and the content or template processing code 114 will not be executed. This is probably only desirable if a redirect has been 115 issued. 116 117 =item template() 118 119 The layout template is processed. See template() below. 120 121 If the subclass implements a method named content(), it is called 122 instead and no template processing occurs. 123 124 =back 125 126 =cut 127 128 sub go { 129 my $self = shift; 130 131 my $r = $self->{r}; 132 my $ce = $self->{ce}; 133 my $returnValue = OK; 134 135 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 136 my $headerReturn = $self->header(@_); 137 $returnValue = $headerReturn if defined $headerReturn; 138 return $returnValue if $r->header_only or $self->{noContent}; 139 140 # if the sendFile flag is set, send the file and exit; 141 if ($self->{sendFile}) { 142 return $self->sendFile; 143 } 144 145 $self->initialize(@_) if $self->can("initialize"); 146 147 # A content generator will have a "content" method if it does not 148 # wish to be passed through template processing, but wishes to be 149 # completely responsible for it's own output. 150 if ($self->can("content")) { 151 $self->content(@_); 152 } else { 153 # if the content generator specifies a custom template name, use that 154 # field in the $ce->{templates} hash instead of "system" if it exists. 155 my $templateName; 156 if ($self->can("templateName")) { 157 $templateName = $self->templateName; 158 } else { 159 $templateName = "system"; 160 } 161 $templateName = "system" unless exists $ce->{templates}->{$templateName}; 162 $self->template($ce->{templates}->{$templateName}, @_); 163 } 164 165 return $returnValue; 166 } 167 168 =item sendFile() 169 170 =cut 171 172 sub sendFile { 173 my ($self) = @_; 174 175 my $file = $self->{sendFile}->{source}; 176 177 return NOT_FOUND unless -e $file; 178 return FORBIDDEN unless -r $file; 179 180 open my $fh, "<", $file 181 or return SERVER_ERROR; 182 while (<$fh>) { 183 print $_; 184 } 185 close $fh; 186 187 return OK; 188 } 189 190 =back 191 192 =cut 193 194 =head1 TEMPLATE PROCESSING 195 196 =over 197 198 =item template($templateFile) 199 200 =cut 201 202 # template(STRING, @otherArguments) - parse a template, looking for escapes of 203 # the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME 204 # (if available) for each NAME. The escapes are called like: 205 # 206 # $self->NAME(@otherArguments, \%escapeArguments) 207 # 208 # where @otherArguments originates in the dispatcher and %escapeArguments is 209 # parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR) 210 # 211 sub template { 212 my ($self, $templateFile) = (shift, shift); 213 my $r = $self->{r}; 214 my $courseEnvironment = $self->{ce}; 215 my @ifstack = (1); # Start off in printing mode 216 # say $ifstack[-1] to get the result of the last <#!--if--> 217 218 # so even though the variable $/ APPEARS to contain a newline, 219 # <TEMPLATE> is slurping the whole file into the first element of 220 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 221 # 222 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 223 #my @template = <TEMPLATE>; 224 #close TEMPLATE; 225 # 226 # Let's try something else instead: 227 my @template = split /\n/, readFile($templateFile); 228 229 foreach my $line (@template) { 230 # This is incremental regex processing. 231 # the /c is so that pos($line) doesn't die when the regex fails. 232 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 233 my ($before, $function, $raw_args) = ($1, $2, $3); 234 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : (); 235 236 if ($ifstack[-1]) { 237 print $before; 238 } 239 240 if ($function eq "if") { 241 # a predicate can only be true if everything else on the ifstack is already true, for ANDing 242 push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]); 243 } elsif ($function eq "else" and @ifstack > 1) { 244 $ifstack[-1] = not $ifstack[-1]; 245 } elsif ($function eq "endif" and @ifstack > 1) { 246 pop @ifstack; 247 } elsif ($ifstack[-1]) { 248 if ($self->can($function)) { 249 my @result = $self->$function(@_, {@args}); 250 if (@result) { 251 print @result; 252 } else { 253 warn "Template escape $function returned an empty list."; 254 } 255 } 256 } 257 } 258 259 if ($ifstack[-1]) { 260 print substr($line, (defined pos $line) ? pos $line : 0), "\n"; 261 } 262 } 263 } 264 265 =item cook_args($string) 266 267 =cut 268 269 # cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 270 # a list which pairs into key/values and fits nicely in {}s. 271 # 272 sub cook_args($) { # ... also used by bin/wwdb, so watch out 273 my ($raw_args) = @_; 274 my @args = (); 275 276 # Boy I love m//g in scalar context! Go read the camel book, heathen. 277 # First, get the whole token with the quotes on both ends... 278 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) { 279 my ($key, $value) = ($1, $2); 280 # ... then, rip out all the protecty backspaces 281 $value =~ s/\\(.)/$1/g; 282 push @args, $key => $value; 283 } 284 285 return @args; 286 } 287 288 =item if($args) 289 290 =cut 291 292 # This is different. It probably shouldn't print anything (except in debugging cases) 293 # and it should return a boolean, not a string. &if is called in a nonstandard way 294 # by &template, with $args as an arrayref instead of a hashref. this is a hack! yay! 295 296 # OK, this is a pluggin architecture. it iterates through attributes of the "if" tag, 297 # and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the 298 # grand templating theme of an object-oriented pluggable architecture using ->can($). 299 sub if { 300 my ($self, $args) = @_[0,-1]; 301 # A single if "or"s it's components. Nesting produces "and". 302 303 my @args = @$args; # Hahahahaha, get it?! 304 305 if (@args % 2 != 0) { 306 # flip out and kill people, but do not commit seppuku 307 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n'; 308 } 309 310 while (@args > 1) { 311 my ($key, $value) = (shift @args, shift @args); 312 313 # a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK 314 my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation 315 if ($self->can("if_$key") and $self->$sub("$value")) { 316 return 1; 317 } 318 } 319 320 return 0; 321 } 322 323 =back 324 325 =cut 326 327 ################################################################################ 328 # Macros used by content generators to render common idioms 329 ################################################################################ 330 331 # FIXME: some of these should be moved to WeBWorK::HTML:: modules! 332 333 =head1 HTML MACROS 334 335 Macros used by content generators to render common idioms 336 337 =over 338 339 =item pathMacro($args, @path) 340 341 Helper macro for <!--#path--> escape: $args is a hash reference containing the 342 "style", "image", "text", and "textonly" arguments to the escape. @path consists 343 of ordered key-value pairs of the form: 344 345 "Page Name" => URL 346 347 If the page should not have a link associated with it, the URL should be left 348 empty. Authentication data is added to the URL so you don't have to. A fully- 349 formed path line is returned, suitable for returning by a function implementing 350 the #path escape. 351 352 =cut 353 354 sub pathMacro { 355 my $self = shift; 356 my %args = %{ shift() }; 357 my @path = @_; 358 $args{style} = "text" if $args{textonly}; 359 my $sep; 360 if ($args{style} eq "image") { 361 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 362 } else { 363 $sep = $args{text}; 364 } 365 my $auth = $self->url_authen_args; 366 my @result; 367 while (@path) { 368 my $name = shift @path; 369 my $url = shift @path; 370 if ($url and not $args{textonly}) { 371 push @result, CGI::a({-href=>"$url?$auth"}, $name); 372 } else { 373 push @result, $name; 374 } 375 } 376 return join($sep, @result) . "\n"; 377 } 378 379 =item siblingsMacro(@siblings) 380 381 =cut 382 383 sub siblingsMacro { 384 my $self = shift; 385 my @siblings = @_; 386 my $sep = CGI::br(); 387 my $auth = $self->url_authen_args; 388 my @result; 389 while (@siblings) { 390 my $name = shift @siblings; 391 my $url = shift @siblings; 392 push @result, $url 393 ? CGI::a({-href=>"$url?$auth"}, $name) 394 : $name; 395 } 396 return join($sep, @result), "\n"; 397 } 398 399 =item navMacro($args, $tail) 400 401 =cut 402 403 sub navMacro { 404 my $self = shift; 405 my %args = %{ shift() }; 406 my $tail = shift; 407 my @links = @_; 408 my $auth = $self->url_authen_args; 409 my $ce = $self->{ce}; 410 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 411 my @result; 412 while (@links) { 413 my $name = shift @links; 414 my $url = shift @links; 415 my $img = shift @links; 416 my $html = 417 ($img && $args{style} eq "images") 418 ? CGI::img( 419 {src=>($prefix."/".$img.$args{imagesuffix}), 420 border=>"", 421 alt=>"$name"}) 422 : $name; 423 unless($img && !$url) { 424 push @result, $url 425 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 426 : $html; 427 } 428 } 429 return join($args{separator}, @result) . "\n"; 430 } 431 432 =item hidden_fields(@fields) 433 434 Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if 435 list is empty), taking data from the current request. 436 437 =cut 438 439 sub hidden_fields($;@) { 440 my $self = shift; 441 my $r = $self->{r}; 442 my @fields = @_; 443 @fields or @fields = $r->param; 444 my $courseEnvironment = $self->{ce}; 445 my $html = ""; 446 447 foreach my $param (@fields) { 448 my $value = $r->param($param); 449 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 450 } 451 return $html; 452 } 453 454 =item hidden_authen_fields() 455 456 Use hidden_fields to return hidden <INPUT> tags for request fields used in 457 authentication. 458 459 =cut 460 461 sub hidden_authen_fields($) { 462 my $self = shift; 463 return $self->hidden_fields("user","effectiveUser","key"); 464 } 465 466 =item url_args(@fields) 467 468 Return a URL query string (without the leading `?') containing values for each 469 field mentioned in @fields, or all fields if list is empty. Data is taken from 470 the current request. 471 472 =cut 473 474 sub url_args($;@) { 475 my $self = shift; 476 my $r = $self->{r}; 477 my @fields = @_; 478 @fields or @fields = $r->param; # If no fields are passed in, do them all. 479 my $courseEnvironment = $self->{ce}; 480 481 my @pairs; 482 foreach my $param (@fields) { 483 my @values = $r->param($param); 484 foreach my $value (@values) { 485 push @pairs, uri_escape($param) . "=" . uri_escape($value); 486 } 487 } 488 489 return join("&", @pairs); 490 } 491 492 =item url_authen_args() 493 494 Use url_args to return a URL query string for request fields used in 495 authentication. 496 497 =cut 498 499 sub url_authen_args($) { 500 my $self = shift; 501 my $r = $self->{r}; 502 return $self->url_args("user","effectiveUser","key"); 503 } 504 505 =item nbsp($string) 506 507 If string is the empty string, the HTML entity C< > is returned. 508 Otherwise the string is returned. 509 510 =cut 511 512 sub nbsp { 513 my $self = shift; 514 my $str = shift; 515 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings 516 # tricky cases: $str =0; 517 # $str is a complex number 518 } 519 520 =item print_form_data($begin, $middle, $end, $omit) 521 522 Return a string containing request fields not matched by $omit, placing $begin 523 before each field name, $middle between each field and its value, and $end after 524 each value. Values are taken from the current request. $omit is a quoted reguar 525 expression. 526 527 =cut 528 529 sub print_form_data { 530 my ($self, $begin, $middle, $end, $qr_omit) = @_; 531 my $return_string = ""; 532 my $r=$self->{r}; 533 my @form_data = $r->param; 534 foreach my $name (@form_data) { 535 next if ($qr_omit and $name =~ /$qr_omit/); 536 my @values = $r->param($name); 537 foreach my $variable (qw(begin name middle value end)) { 538 no strict 'refs'; 539 ${$variable} = "" unless defined ${$variable}; 540 } 541 foreach my $value (@values) { 542 $return_string .= "$begin$name$middle$value$end"; 543 } 544 } 545 return $return_string; 546 } 547 548 =item errorOutput($error, $details) 549 550 =cut 551 552 sub errorOutput($$$) { 553 my ($self, $error, $details) = @_; 554 return 555 CGI::h3("Software Error"), 556 CGI::p(<<EOF), 557 WeBWorK has encountered a software error while attempting to process this 558 problem. It is likely that there is an error in the problem itself. If you are 559 a student, contact your professor to have the error corrected. If you are a 560 professor, please consut the error output below for more informaiton. 561 EOF 562 CGI::h3("Error messages"), CGI::p(CGI::tt($error)), 563 CGI::h3("Error context"), CGI::p(CGI::tt($details)); 564 } 565 566 =item warningOutput($warnings) 567 568 =cut 569 570 sub warningOutput($$) { 571 my ($self, $warnings) = @_; 572 573 my @warnings = split m/\n+/, $warnings; 574 575 return 576 CGI::h3("Software Warnings"), 577 CGI::p(<<EOF), 578 WeBWorK has encountered warnings while attempting to process this problem. It 579 is likely that this indicates an error or ambiguity in the problem itself. If 580 you are a student, contact your professor to have the problem corrected. If you 581 are a professor, please consut the warning output below for more informaiton. 582 EOF 583 CGI::h3("Warning messages"), 584 CGI::ul(CGI::li(\@warnings)), 585 ; 586 } 587 588 =back 589 590 =cut 591 592 ################################################################################ 593 # Generic versions of template escapes 594 ################################################################################ 595 596 =head1 THE HEADER METHOD 597 598 =over 599 600 =item header() 601 602 The C<header> method is defined in WeBWorK::ContentGenerator to generate a 603 default C<Content-type> of text/html and send the HTTP header. 604 605 =back 606 607 =cut 608 609 sub header { 610 my $self = shift; 611 my $r = $self->{r}; 612 613 if ($self->{sendFile}) { 614 my $contentType = $self->{sendFile}->{type}; 615 my $fileName = $self->{sendFile}->{name}; 616 $r->content_type($contentType); 617 $r->header_out("Content-Disposition" => "attachment; filename=\"$fileName\""); 618 } else { 619 $r->content_type("text/html"); 620 621 } 622 623 $r->send_http_header(); 624 return OK; 625 } 626 627 =head1 TEMPLATE ESCAPE METHODS 628 629 Template escape methods are invoked when a 630 C< <!--#escape argument="value" ... -> > construct is encountered in the 631 template. The methods can be defined here in ContentGenerator, or in a 632 particular subclass. Arguments are passed to the method as a reference to a 633 hash. 634 635 The following template escapes are currently defined: 636 637 =over 638 639 =item head 640 641 Any tags that should appear in the HEAD of the document. Not defined by default. 642 643 =item info 644 645 Auxiliary information related to the C<body>. Not defined by default. 646 647 =item links 648 649 Links that should appear on every page. Defined in WeBWorK::ContentGenerator by 650 default. 651 652 =cut 653 654 # FIXME: drunk code. rewrite. 655 # also, this should be structured s.t. subclasses can add items to the links 656 # area, i.e. "stacking" 657 sub links { 658 my $self = shift; 659 my @components = @_; 660 my $ce = $self->{ce}; 661 my $db = $self->{db}; 662 my $userName = $self->{r}->param("user"); 663 my $courseName = $ce->{courseName}; 664 my $root = $ce->{webworkURLs}->{root}; 665 666 #my $Key = $db->getKey($userName); # checked 667 #my $key = (defiend $key 668 # ? $Key->key() 669 # : ""); 670 # 671 #return "" unless defined $key; 672 # This has been replaced by using "#if loggedin" in ur.template. 673 674 # URLs to parts of the system 675 my $probSets = "$root/$courseName/?" . $self->url_authen_args(); 676 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); 677 my $grades = "$root/$courseName/grades/?" . $self->url_authen_args(); 678 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); 679 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); 680 681 my $PermissionLevel = $db->getPermissionLevel($userName); # checked 682 my $permLevel = (defined $PermissionLevel 683 ? $PermissionLevel->permission() 684 : 0); 685 686 return join("", 687 CGI::div( {style=>'font-size:larger'},CGI::a({-href=>$probSets}, "Problem Sets") 688 ), 689 CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(), 690 CGI::a({-href=>$grades}, "Grades"), CGI::br(), 691 CGI::a({-href=>$help,-target=>'_help_'}, "Help"), CGI::br(), 692 CGI::a({-href=>$logout}, "Log Out"), CGI::br(), 693 ($permLevel > 0 694 ? $self->instructor_links(@components) : "" 695 ), 696 ); 697 } 698 699 sub instructor_links { 700 my $self = shift; 701 my @components = @_; 702 my $args = pop(@components); # get hash of option arguments 703 my $courseName = $self->{ce}->{courseName}; 704 my $root = $self->{ce}->{webworkURLs}->{root}; 705 my $userName = $self->{r}->param("effectiveUser"); 706 $userName = $self->{r}->param("user") unless defined $userName; 707 my ($set, $prob) = @components; 708 my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args(); 709 my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args(); 710 my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args(); 711 my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args(); 712 my $scoring = "$root/$courseName/instructor/scoring/?" . $self->url_authen_args(); 713 my $statsRoot = "$root/$courseName/instructor/stats"; 714 my $stats = $statsRoot. '/?'.$self->url_authen_args(); 715 my $fileXfer = "$root/$courseName/instructor/files/?" . $self->url_authen_args(); 716 717 718 # Add direct links to sets e.g. 3:4 for set3 problem 4 719 my $setURL = (defined $set) 720 ? "$root/$courseName/instructor/sets/$set/?" . $self->url_authen_args() 721 : ''; 722 my $probURL = (defined $set && defined $prob) 723 ? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" . $self->url_authen_args() 724 : ''; 725 726 my ($setLink, $problemLink) = ("", ""); 727 if ($setURL) { 728 $setLink = " " 729 . CGI::a({-href=>$setURL}, "Set $set") 730 . CGI::br(); 731 if ($probURL) { 732 $problemLink = " " 733 . CGI::a({-href=>$probURL}, "Problem $prob") 734 . CGI::br(); 735 } 736 } 737 738 #my $setProb = ($setURL) 739 # ? CGI::a({-href=>$setURL}, $set) 740 # : ''; 741 #$setProb .= ':' . CGI::a({-href=>$probURL},$prob) if $setProb && $probURL; 742 743 return join("", 744 CGI::hr(), 745 CGI::div( {style=>'font-size:larger'}, 746 CGI::a({-href=>$instructor}, "Instructor Tools") 747 ), 748 ' ',CGI::a({-href=>$users}, "User List"), CGI::br(), 749 ' ',CGI::a({-href=>$sets}, "Set List"), CGI::br(), 750 $setLink, 751 $problemLink, 752 ' ',CGI::a({-href=>$email}, "Mail Merge"), CGI::br(), 753 ' ',CGI::a({-href=>$scoring}, "Scoring"), CGI::br(), 754 ' ',CGI::a({-href=>$stats}, "Statistics"), CGI::br(), 755 (defined($set)) 756 ? ' '.CGI::a({-href=>"$statsRoot/set/$set/?".$self->url_authen_args}, "$set").CGI::br() 757 : '', 758 (defined($userName)) 759 ? ' '.CGI::a({-href=>"$statsRoot/student/$userName/?".$self->url_authen_args}, "$userName").CGI::br() 760 : '', 761 ' ',CGI::a({-href=>$fileXfer}, "File Transfer"), CGI::br(), 762 ); 763 } 764 765 =item loginstatus 766 767 A notification message announcing the current real user and effective user, a 768 link to stop acting as the effective user, and a logout link. Defined in 769 WeBWorK::ContentGenerator by default. 770 771 =cut 772 773 sub loginstatus { 774 my $self = shift; 775 my $r = $self->{r}; 776 my $ce = $self->{ce}; 777 778 my $user = $r->param("user"); 779 my $eUser = $r->param("effectiveUser"); 780 my $key = $r->param("key"); 781 782 return "" unless $key; 783 784 my $exitURL = $r->uri() . "?user=$user&key=$key"; 785 786 my $root = $ce->{webworkURLs}->{root}; 787 my $courseID = $ce->{courseName}; 788 my $logout = "$root/$courseID/logout/?" . $self->url_authen_args(); 789 790 print CGI::small("User:", "$user"); 791 792 if ($user ne $eUser) { 793 print CGI::br(), CGI::font({-color=>'red'}, 794 CGI::small("Acting as:", "$eUser") 795 ), 796 CGI::br(), CGI::a({-href=>$exitURL}, 797 CGI::small("Stop Acting") 798 ); 799 } 800 801 print CGI::br(), CGI::a({-href=>$logout}, CGI::small("Log Out")); 802 803 return ""; 804 } 805 806 =item nav 807 808 Links to the previous, next, and parent objects. Not defined by default. 809 810 style => text|image 811 imageprefix => prefix to prepend to base image URL 812 imagesuffix => suffix to append to base image URL 813 separator => HTML to place in between links 814 815 =item options 816 817 A place for an options form, like the problem display options. Not defined by 818 default. 819 820 =item path 821 822 "Breadcrubs" from the current page to the root of the virtual hierarchy. Defined 823 in WeBWorK::ContentGenerator to pull information from the WeBWorK::URLPath. 824 825 style => type of separator: text|image 826 image => URL of separator image 827 text => text of texual separator (also used for image alt text) 828 textonly => suppress links 829 830 =cut 831 832 sub path { 833 my ($self, $args) = @_; 834 my $r = $self->{r}; 835 836 my @path; 837 838 my $urlpath = $r->urlpath; 839 do { 840 unshift @path, $urlpath->name, $r->location . $urlpath->path; 841 } while ($urlpath = $urlpath->parent); 842 843 $path[$#path] = ""; # we don't want the last path element to be a link 844 845 return $self->pathMacro($args, @path); 846 } 847 848 =item siblings 849 850 Links to siblings of the current object. Not defined by default. 851 852 =item submiterror 853 854 Any error messages resulting from the last form submission. Defined in 855 WeBWorK::ContentGenerator by default. 856 857 =cut 858 859 sub submiterror { 860 my ($self) = @_; 861 if (exists $self->{submitError}) { 862 return $self->{submitError}; 863 } else { 864 return ""; 865 } 866 } 867 868 =item title 869 870 The title of the current page. Defined in WeBWorK::ContentGenerator to pull 871 information from the WeBWorK::URLPath. 872 873 =cut 874 875 sub title { 876 my ($self, $args) = @_; 877 my $r = $self->{r}; 878 879 return $r->urlpath->name; 880 } 881 882 =item warnings 883 884 Any warnings. Not defined by default. 885 886 =cut 887 888 sub warnings { 889 my ($self) = @_; 890 my $r = $self->{r}; 891 if ($r->notes("warnings")) { 892 return $self->warningOutput($r->notes("warnings")); 893 } else { 894 return ""; 895 } 896 } 897 898 =back 899 900 =head CONDITIONAL PREDICATES 901 902 Conditional predicate methods are invoked when the 903 C< <!--#if predicate="value"--> > construct is encountered in the template. If a 904 method named C<if_predicate> is defined in here or in a particular subclass, it 905 is invoked. 906 907 The following predicates are currently defined: 908 909 =over 910 911 =item if_can 912 913 will return 1 if the current object->can("do $_[1]") 914 915 =cut 916 917 sub if_can ($$) { 918 my ($self, $arg) = (@_); 919 920 if ($self->can("$arg")) { 921 return 1; 922 } else { 923 return 0; 924 } 925 } 926 927 =item if_loggedin 928 929 Every content generator is logged in unless it overrides this method to say 930 otherwise. 931 932 =cut 933 934 sub if_loggedin($$) { 935 my ($self, $arg) = (@_); 936 937 return $arg; 938 } 939 940 =item if_submiterror 941 942 =cut 943 944 sub if_submiterror($$) { 945 my ($self, $arg) = @_; 946 if (exists $self->{submitError}) { 947 return $arg; 948 } else { 949 return !$arg; 950 } 951 } 952 953 =item if_warnings 954 955 sub if_warnings($$) { 956 my ($self, $arg) = @_; 957 return $self->{r}->notes("warnings") ? $arg : !$arg; 958 } 959 960 =back 961 962 =cut 963 964 1; 965 966 __END__ 967 968 =head1 AUTHOR 969 970 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu 971 and Sam Hathaway, sh002i (at) math.rochester.edu. 972 973 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |