Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-2-dev'.
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.161 2005/12/19 20:18:55 sh002i 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 WeBWorK::ContentGenerator provides the framework for generating page content. 35 "Content generators" are subclasses of this class which provide content for 36 particular parts of the system. 37 38 Default versions of methods used by the templating system are provided. Several 39 useful methods are provided for rendering common output idioms and some 40 miscellaneous utilities are provided. 41 42 =cut 43 44 use strict; 45 use warnings; 46 use Apache::Constants qw(:response); 47 use Carp; 48 use CGI qw(*ul *li escapeHTML); 49 use Date::Format; 50 use URI::Escape; 51 use WeBWorK::Debug; 52 use WeBWorK::PG; 53 use WeBWorK::Template qw(template); 54 55 ############################################################################### 56 57 =head1 CONSTRUCTOR 58 59 =over 60 61 =item new($r) 62 63 Creates a new instance of a content generator. Supply a WeBWorK::Request object 64 $r. 65 66 =cut 67 68 sub new { 69 my ($invocant, $r) = @_; 70 my $class = ref($invocant) || $invocant; 71 my $self = { 72 r => $r, # this is now a WeBWorK::Request 73 ce => $r->ce(), # these three are here for 74 db => $r->db(), # backward-compatability 75 authz => $r->authz(), # with unconverted CGs 76 noContent => undef, # FIXME this should get clobbered at some point 77 }; 78 bless $self, $class; 79 return $self; 80 } 81 82 =back 83 84 =cut 85 86 ################################################################################ 87 88 =head1 INVOCATION 89 90 =over 91 92 =item go() 93 94 Generates a page, using methods from the particular subclass of ContentGenerator 95 that is instantiated. Generatoion is broken up into several steps, to give 96 subclasses ample control over the process. 97 98 =over 99 100 =item 1 101 102 go() will attempt to call the method pre_header_initialize(). This method may be 103 implemented in subclasses which must do processing before the HTTP header is 104 emitted. 105 106 =item 2 107 108 go() will attempt to call the method header(). This method emits the HTTP 109 header. It is defined in this class (see below), but may be overridden in 110 subclasses which need to send different header information. For some reason, the 111 return value of header() will be used as the result of this function, if it is 112 defined. 113 114 FIXME: figure out what the deal is with the return value of header(). If we sent 115 a header, it's too late to set the status by returning. If we didn't, header() 116 didn't perform its function! 117 118 =item 3 119 120 At this point, go() will terminate if the request is a HEAD request or if the 121 field $self->{noContent} contains a true value. 122 123 FIXME: I don't think we'll need noContent after reply_with_redirect() is 124 adopted by all modules. 125 126 =item 4 127 128 go() then attempts to call the method initialize(). This method may be 129 implemented in subclasses which must do processing after the HTTP header is sent 130 but before any content is sent. 131 132 =item 6 133 134 The method content() is called to send the page content to client. 135 136 =back 137 138 =cut 139 140 sub go { 141 my ($self) = @_; 142 my $r = $self->r; 143 my $ce = $r->ce; 144 145 my $returnValue = OK; 146 147 # We only write to the activity log if it has been defined and if 148 # we are in a specific course. The latter check is to prevent attempts 149 # to write to a course log file when viewing the top-level list of 150 # courses page. 151 WeBWorK::Utils::writeCourseLog($ce, 'activity_log', 152 $self->prepare_activity_entry) if ( $r->urlpath->arg("courseID") and 153 $r->ce->{courseFiles}->{logs}->{activity_log}); 154 155 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 156 157 # send a file instead of a normal reply (reply_with_file() sets this field) 158 defined $self->{reply_with_file} and do { 159 return $self->do_reply_with_file($self->{reply_with_file}); 160 }; 161 162 # send a Location: header instead of a normal reply (reply_with_redirect() sets this field) 163 defined $self->{reply_with_redirect} and do { 164 return $self->do_reply_with_redirect($self->{reply_with_redirect}); 165 }; 166 167 my $headerReturn = $self->header(@_); 168 $returnValue = $headerReturn if defined $headerReturn; 169 # FIXME: we won't need noContent after reply_with_redirect() is adopted 170 return $returnValue if $r->header_only or $self->{noContent}; 171 172 $self->initialize() if $self->can("initialize"); 173 174 $self->content(); 175 176 return $returnValue; 177 } 178 179 =item r() 180 181 Returns a reference to the WeBWorK::Request object associated with this 182 instance. 183 184 =cut 185 186 sub r { 187 my ($self) = @_; 188 189 return $self->{r}; 190 } 191 192 =item do_reply_with_file($fileHash) 193 194 Handler for reply_with_file(), used by go(). DO NOT CALL THIS METHOD DIRECTLY. 195 196 =cut 197 198 sub do_reply_with_file { 199 my ($self, $fileHash) = @_; 200 my $r = $self->r; 201 202 my $type = $fileHash->{type}; 203 my $source = $fileHash->{source}; 204 my $name = $fileHash->{name}; 205 my $delete_after = $fileHash->{delete_after}; 206 207 # if there was a problem, we return here and let go() worry about sending the reply 208 return NOT_FOUND unless -e $source; 209 return FORBIDDEN unless -r $source; 210 211 # open the file now, so we can send the proper error status is we fail 212 open my $fh, "<", $source or return SERVER_ERROR; 213 214 # send our custom HTTP header 215 $r->content_type($type); 216 $r->header_out("Content-Disposition" => "attachment; filename=\"$name\""); 217 $r->send_http_header; 218 219 # send the file 220 $r->send_fd($fh); 221 222 # close the file and go home 223 close $fh; 224 225 if ($delete_after) { 226 unlink $source or warn "failed to unlink $source after sending: $!"; 227 } 228 } 229 230 =item do_reply_with_redirect($url) 231 232 Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTLY. 233 234 =cut 235 236 sub do_reply_with_redirect { 237 my ($self, $url) = @_; 238 my $r = $self->r; 239 240 $r->status(REDIRECT); 241 $r->header_out(Location => $url); 242 $r->send_http_header(); 243 } 244 245 =back 246 247 =cut 248 249 ################################################################################ 250 251 =head1 DATA MODIFIERS 252 253 Modifiers allow the caller to register a piece of data for later retrieval in a 254 standard way. 255 256 =over 257 258 =item reply_with_file($type, $source, $name, $delete_after) 259 260 Enables file sending mode, causing go() to send the file specified by $source to 261 the client after calling pre_header_initialize(). The content type sent is 262 $type, and the suggested client-side file name is $name. If $delete_after is 263 true, $source is deleted after it is sent. 264 265 Must be called before the HTTP header is sent. Usually called from 266 pre_header_initialize(). 267 268 =cut 269 270 sub reply_with_file { 271 my ($self, $type, $source, $name, $delete_after) = @_; 272 $delete_after ||= ""; 273 274 $self->{reply_with_file} = { 275 type => $type, 276 source => $source, 277 name => $name, 278 delete_after => $delete_after, 279 }; 280 } 281 282 =item reply_with_redirect($url) 283 284 Enables redirect mode, causing go() to redirect to the given URL after calling 285 pre_header_initialize(). 286 287 Must be called before the HTTP header is sent. Usually called from 288 pre_header_initialize(). 289 290 =cut 291 292 sub reply_with_redirect { 293 my ($self, $url) = @_; 294 295 $self->{reply_with_redirect} = $url; 296 } 297 298 =item addmessage($message) 299 300 Adds a message to the list of messages to be printed by the message() template 301 escape handler. 302 303 Must be called before the message() template escape is invoked. 304 305 =cut 306 307 308 309 sub addmessage { 310 my ($self, $message) = @_; 311 $self->{status_message} .= $message; 312 } 313 314 =item addgoodmessage($message) 315 316 Adds a success message to the list of messages to be printed by the 317 message() template escape handler. 318 319 =cut 320 321 322 sub addgoodmessage { 323 my ($self, $message) = @_; 324 $self->addmessage(CGI::div({class=>"ResultsWithoutError"}, $message)); 325 } 326 327 =item addbadmessage($message) 328 329 Adds a failure message to the list of messages to be printed by the 330 message() template escape handler. 331 332 =cut 333 334 335 sub addbadmessage { 336 my ($self, $message) = @_; 337 $self->addmessage(CGI::div({class=>"ResultsWithError"}, $message)); 338 } 339 340 =item prepare_activity_entry() 341 342 Prepare a string to be sent to the activity log, if it is turned on. 343 This can be overriden by different modules. 344 345 =cut 346 347 348 sub prepare_activity_entry { 349 my $self = shift; 350 my $r = $self->r; 351 my $string = $r->urlpath->path . " ---> ". 352 join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ ." => " . $r->param($_) } $r->param())); 353 $string =~ s/\t+/\t/g; 354 return($string); 355 } 356 357 =back 358 359 =cut 360 361 ################################################################################ 362 363 =head1 STANDARD METHODS 364 365 The following are the standard content generator methods. Some are defined here, 366 but may be overridden in a subclass. Others are not defined unless they are 367 defined in a subclass. 368 369 =over 370 371 =item pre_header_initialize() 372 373 Not defined in this package. 374 375 May be defined by a subclass to perform any processing that must occur before 376 the HTTP header is sent. 377 378 =cut 379 380 #sub pre_header_initialize { } 381 382 =item header() 383 384 Defined in this package. 385 386 Generates and sends a default HTTP header, specifying the "text/html" content 387 type. 388 389 =cut 390 391 sub header { 392 my $self = shift; 393 my $r = $self->r; 394 395 $r->content_type("text/html"); 396 $r->send_http_header(); 397 return OK; 398 } 399 400 =item initialize() 401 402 Not defined in this package. 403 404 May be defined by a subclass to perform any processing that must occur after the 405 HTTP header is sent but before any content is sent. 406 407 =cut 408 409 #sub initialize { } 410 411 =item content() 412 413 Defined in this package. 414 415 Print the content of the generated page. 416 417 The implementation in this package uses WeBWorK::Template to define the content 418 of the page. See WeBWorK::Template for details. 419 420 If a method named templateName() exists, it it called to determine the name of 421 the template to use. If not, the default template, "system", is used. The 422 location of the template is looked up in the course environment. 423 424 =cut 425 426 sub content { 427 my ($self) = @_; 428 my $r = $self->r; 429 my $ce = $r->ce; 430 431 my $themesDir = $ce->{webworkDirs}{templates}; 432 my $theme = $r->param("theme") || $ce->{defaultTheme}; 433 $theme = $ce->{defaultTheme} if $theme =~ m!(?:^|/)\.\.(?:/|$)!; 434 my $template = $self->can("templateName") ? $self->templateName : $ce->{defaultThemeTemplate}; 435 my $templateFile = "$themesDir/$theme/$template.template"; 436 437 template($templateFile, $self); 438 } 439 440 =back 441 442 =cut 443 444 # ------------------------------------------------------------------------------ 445 446 =head2 Template escape handlers 447 448 Template escape handlers are invoked when the template processor encounters a 449 matching escape sequence in the template. The escapse sequence's arguments are 450 passed to the methods as a reference to a hash. 451 452 For more information, refer to WeBWorK::Template. 453 454 The following template escapes handlers are defined here or may be defined in 455 subclasses. For methods that are not defined in this package, the documentation 456 defines the interface and behavior that any subclass implementation must follow. 457 458 =over 459 460 =item head() 461 462 Not defined in this package. 463 464 Any tags that should appear in the HEAD of the document. 465 466 =cut 467 468 #sub head { } 469 470 =item info() 471 472 Not defined in this package. 473 474 Auxiliary information related to the content displayed in the C<body>. 475 476 =cut 477 478 #sub info { } 479 480 =item links() 481 482 Defined in this package. 483 484 Links that should appear on every page. 485 486 =cut 487 488 sub links { 489 my ($self) = @_; 490 my $r = $self->r; 491 my $ce = $r->ce; 492 my $db = $r->db; 493 my $authen = $r->authen; 494 my $authz = $r->authz; 495 my $urlpath = $r->urlpath; 496 497 # we don't currently have any links to display if the user's not logged in. this may change, though. 498 #return "" unless $authen->was_verified; 499 500 # grab some interesting data from the request 501 my $courseID = $urlpath->arg("courseID"); 502 my $userID = $r->param('user'); 503 my $eUserID = $r->param("effectiveUser"); 504 my $setID = $urlpath->arg("setID"); 505 my $problemID = $urlpath->arg("problemID"); 506 507 # it's possible that the setID and the problemID are invalid, since they're just taken from the URL path info 508 if ($authen->was_verified) { 509 if (defined $setID and $db->getUserSet($eUserID, $setID)) { 510 if (defined $problemID and $db->getUserProblem($eUserID, $setID, $problemID)) { 511 # both set and poblem exist -- do nothing 512 } else { 513 $problemID = undef; 514 } 515 } else { 516 $setID = undef; 517 $problemID = undef; 518 } 519 } 520 521 # old method -- get rid of this after a while 522 #$setID = "" if (defined $setID && !(grep /$setID/, $db->listUserSets($eUserID))); 523 #$problemID = "" if (defined $problemID && !(grep /$problemID/, $db->listUserProblems($eUserID, $setID))); 524 525 # experimental subroutine for generating links, to clean up the rest of the 526 # code. ignore for now. (this is a closure over $self.) 527 my $makelink = sub { 528 my ($module, %options) = @_; 529 530 my $urlpath_args = $options{urlpath_args} || {}; 531 my $systemlink_args = $options{systemlink_args} || {}; 532 my $text = $options{text}; 533 my $active = $options{active}; 534 535 my $new_urlpath = $self->r->urlpath->newFromModule($module, %$urlpath_args); 536 my $new_systemlink = $self->systemLink($new_urlpath, %$systemlink_args); 537 538 defined $text or $text = $new_urlpath->name; 539 $text = sp2nbsp($text); # ugly hack to prevent text from wrapping 540 541 # try to set $active automatically by comparing 542 if (not defined $active) { 543 if ($urlpath->module eq $new_urlpath->module) { 544 my @args = sort keys %{{$urlpath->args}}; 545 my @new_args = sort keys %{{$new_urlpath->args}}; 546 if (@args == @new_args) { 547 foreach my $i (0 .. $#args) { 548 $active = 0; 549 last if $args[$i] ne $new_args[$i]; 550 $active = 1; 551 } 552 } else { 553 $active = 0; 554 } 555 } else { 556 $active = 0; 557 } 558 } 559 560 my $new_anchor; 561 if ($active) { 562 # add <strong> for old browsers 563 $new_anchor = CGI::strong(CGI::a({href=>$new_systemlink, class=>"active"}, $text)); 564 } else { 565 $new_anchor = CGI::a({href=>$new_systemlink}, $text); 566 } 567 568 return $new_anchor; 569 }; 570 571 # to make things more concise 572 my $pfx = "WeBWorK::ContentGenerator::"; 573 my %args = ( courseID => $courseID ); 574 575 # we'd like to preserve displayMode and showOldAnswers between pages, and we 576 # don't have a general way of preserving non-authen params between requests, 577 # so here is the hack: 578 my %params; 579 $params{displayMode} = $r->param("displayMode") if defined $r->param("displayMode"); 580 $params{showOldAnswers} = $r->param("showOldAnswers") if defined $r->param("showOldAnswers"); 581 # in the past, we were checking $self->{displayMode} and $self->{will}->{showOldAnswers} 582 # to set these args, but I don't wanna do that anymore, since it relies on 583 # fields specific to Problem.pm (pretty sure). The only differences in this 584 # approach are: 585 # (a) displayMode will not be set if it wasn't set in the current request, 586 # but this is ok since the resulting page will just use the default value 587 # (b) showOldAnswers will get set to the value specified in the current 588 # request, regardless of whether it is allowed, but this is OK since we 589 # always this value before using it. 590 my %systemlink_args; 591 $systemlink_args{params} = \%params if %params; 592 593 print CGI::start_ul(); 594 print CGI::start_li(); # Courses 595 print &$makelink("${pfx}Home", text=>"Courses", systemlink_args=>{authen=>0}); 596 597 if (defined $courseID) { 598 #print CGI::start_ul(); 599 #print CGI::start_li(); # $courseID 600 #print CGI::strong(CGI::span({class=>"active"}, $courseID)); 601 602 if ($authen->was_verified) { 603 print CGI::start_ul(); 604 print CGI::start_li(); # Homework Sets 605 print &$makelink("${pfx}ProblemSets", text=>"Homework Sets", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 606 607 if (defined $setID) { 608 print CGI::start_ul(); 609 print CGI::start_li(); # $setID 610 print &$makelink("${pfx}ProblemSet", text=>"$setID", urlpath_args=>{%args,setID=>$setID}, systemlink_args=>\%systemlink_args); 611 # FIXME i think we only want this if the problem set is not a gateway quiz 612 if (defined $problemID) { 613 print CGI::start_ul(); 614 print CGI::start_li(); # $problemID 615 print &$makelink("${pfx}Problem", text=>"Problem $problemID", urlpath_args=>{%args,setID=>$setID,problemID=>$problemID}, systemlink_args=>\%systemlink_args); 616 617 print CGI::end_li(); # end $problemID 618 print CGI::end_ul(); 619 } 620 print CGI::end_li(); # end $setID 621 print CGI::end_ul(); 622 } 623 print CGI::end_li(); # end Homework Sets 624 625 if ($authz->hasPermissions($userID, "change_password") or $authz->hasPermissions($userID, "change_email_address")) { 626 print CGI::li(&$makelink("${pfx}Options", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 627 } 628 629 print CGI::li(&$makelink("${pfx}Grades", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 630 631 if ($authz->hasPermissions($userID, "access_instructor_tools")) { 632 $pfx .= "Instructor::"; 633 634 print CGI::start_li(); # Instructor Tools 635 print &$makelink("${pfx}Index", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 636 print CGI::start_ul(); 637 638 print CGI::li(&$makelink("${pfx}UserList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 639 640 print CGI::start_li(); # Homework Set Editor 641 print &$makelink("${pfx}ProblemSetList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 642 if (defined $setID) { 643 print CGI::start_ul(); 644 print CGI::start_li(); # $setID 645 print &$makelink("${pfx}ProblemSetDetail", text=>"$setID", urlpath_args=>{%args,setID=>$setID}, systemlink_args=>\%systemlink_args); 646 647 if (defined $problemID) { 648 print CGI::start_ul(); 649 print CGI::li(&$makelink("${pfx}PGProblemEditor", text=>"$problemID", urlpath_args=>{%args,setID=>$setID,problemID=>$problemID}, systemlink_args=>\%systemlink_args)); 650 print CGI::end_ul(); 651 } 652 653 print CGI::end_li(); # end $setID 654 print CGI::end_ul(); 655 } 656 print CGI::end_li(); # end Homework Set Editor 657 658 print CGI::li(&$makelink("${pfx}SetMaker", text=>"Library Browser", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 659 660 print CGI::start_li(); # Stats 661 print &$makelink("${pfx}Stats", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 662 if ($userID ne $eUserID or defined $setID) { 663 print CGI::start_ul(); 664 if ($userID ne $eUserID) { 665 print CGI::li(&$makelink("${pfx}Stats", text=>"$eUserID", urlpath_args=>{%args,statType=>"student",userID=>$eUserID}, systemlink_args=>\%systemlink_args)); 666 } 667 if (defined $setID) { 668 print CGI::li(&$makelink("${pfx}Stats", text=>"$setID", urlpath_args=>{%args,statType=>"set",setID=>$setID}, systemlink_args=>\%systemlink_args)); 669 } 670 print CGI::end_ul(); 671 } 672 print CGI::end_li(); # end Stats 673 674 print CGI::start_li(); # Student Progress 675 print &$makelink("${pfx}StudentProgress", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 676 if ($userID ne $eUserID or defined $setID) { 677 print CGI::start_ul(); 678 if ($userID ne $eUserID) { 679 print CGI::li(&$makelink("${pfx}StudentProgress", text=>"$eUserID", urlpath_args=>{%args,statType=>"student",userID=>$eUserID}, systemlink_args=>\%systemlink_args)); 680 } 681 if (defined $setID) { 682 print CGI::li(&$makelink("${pfx}StudentProgress", text=>"$setID", urlpath_args=>{%args,statType=>"set",setID=>$setID}, systemlink_args=>\%systemlink_args)); 683 } 684 print CGI::end_ul(); 685 } 686 print CGI::end_li(); # end Student Progress 687 688 if ($authz->hasPermissions($userID, "score_sets")) { 689 print CGI::li(&$makelink("${pfx}Scoring", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 690 } 691 692 if ($authz->hasPermissions($userID, "send_mail")) { 693 print CGI::li(&$makelink("${pfx}SendMail", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 694 } 695 696 if ($authz->hasPermissions($userID, "manage_course_files")) { 697 print CGI::li(&$makelink("${pfx}FileManager", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 698 } 699 700 if ($authz->hasPermissions($userID, "manage_course_files")) { 701 print CGI::li(&$makelink("${pfx}Config", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 702 } 703 print CGI::li( $self->helpMacro('instructor_links','Help'),$self->help() ); 704 print CGI::end_ul(); 705 print CGI::end_li(); # end Instructor Tools 706 } # /* access_instructor_tools */ 707 708 print CGI::end_ul(); 709 } # /* was_verified */ 710 711 #print CGI::end_li(); # end $courseID 712 #print CGI::end_ul(); 713 } # /* defined $courseID */ 714 715 print CGI::end_li(); # end Courses 716 print CGI::end_ul(); 717 718 719 print CGI::start_ul(); 720 if (exists $ce->{webworkURLs}{bugReporter} and $ce->{webworkURLs}{bugReporter} ne "" 721 and $authz->hasPermissions($userID, "report_bugs")) { 722 print CGI::li(CGI::a({style=>'font-size:larger', href=>$ce->{webworkURLs}{bugReporter}}, "Report bugs")); 723 } 724 725 print CGI::end_ul(); 726 727 728 return ""; 729 } 730 731 =item loginstatus() 732 733 Defined in this package. 734 735 Print a notification message announcing the current real user and effective 736 user, a link to stop acting as the effective user, and a link to logout. 737 738 =cut 739 740 sub loginstatus { 741 my ($self) = @_; 742 my $r = $self->r; 743 my $authen = $r->authen; 744 my $urlpath = $r->urlpath; 745 746 if ($authen and $authen->was_verified) { 747 my $courseID = $urlpath->arg("courseID"); 748 my $userID = $r->param("user"); 749 my $eUserID = $r->param("effectiveUser"); 750 751 my $stopActingURL = $self->systemLink($urlpath, # current path 752 params => { effectiveUser => $userID }, 753 ); 754 my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID)); 755 756 if ($eUserID eq $userID) { 757 print "Logged in as $userID. " . CGI::br() . CGI::a({href=>$logoutURL}, "Log Out"); 758 } else { 759 print "Logged in as $userID. " . CGI::a({href=>$logoutURL}, "Log Out") . CGI::br(); 760 print "Acting as $eUserID. " . CGI::a({href=>$stopActingURL}, "Stop Acting"); 761 } 762 } else { 763 print "Not logged in."; 764 } 765 766 return ""; 767 } 768 769 =item nav($args) 770 771 Not defined in this package. 772 773 Links to the previous, next, and parent objects. 774 775 $args is a reference to a hash containing the following fields: 776 777 style => text|image 778 imageprefix => prefix to prepend to base image URL 779 imagesuffix => suffix to append to base image URL 780 separator => HTML to place in between links 781 782 If C<style> is "image", image URLs are constructed by prepending C<imageprefix> 783 and postpending C<imagesuffix> to the image base names defined by the 784 implementor. (Examples of base names include "Prev", "Next", "ProbSet", and 785 "Up"). Each concatenated string should form an absolute URL to an image file. 786 For example: 787 788 <!--#nav style="images" imageprefix="/webwork2_files/images/nav" 789 imagesuffix=".gif" separator=" "--> 790 791 =cut 792 793 #sub nav { } 794 795 =item options() 796 797 Not defined in this package. 798 799 View options related to the content displayed in the body or info areas. See also 800 optionsMacro(). 801 802 =cut 803 804 #sub options { } 805 806 =item path($args) 807 808 Defined in this package. 809 810 Print "breadcrubs" from the root of the virtual hierarchy to the current page. 811 $args is a reference to a hash containing the following fields: 812 813 style => type of separator: text|image 814 image => if style=image, URL of image to use as path separator 815 text => if style=text, text to use as path separator 816 if style=image, the ALT text of each separator image 817 textonly => suppress all HTML, return only plain text 818 819 The implementation in this package takes information from the WeBWorK::URLPath 820 associated with the current request. 821 822 =cut 823 824 sub path { 825 my ($self, $args) = @_; 826 my $r = $self->r; 827 828 my @path; 829 830 my $urlpath = $r->urlpath; 831 do { 832 unshift @path, $urlpath->name, $r->location . $urlpath->path; 833 } while ($urlpath = $urlpath->parent); 834 835 $path[$#path] = ""; # we don't want the last path element to be a link 836 837 #print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n"; 838 print $self->pathMacro($args, @path); 839 #print "<!-- END " . __PACKAGE__ . "::path -->\n"; 840 841 return ""; 842 } 843 844 =item siblings() 845 846 Not defined in this package. 847 848 Print links to siblings of the current object. 849 850 =cut 851 852 #sub siblings { } 853 854 =item timestamp() 855 856 Defined in this package. 857 858 Display the current time and date using default format "3:37pm on Jan 7, 2004". 859 The display format can be adjusted by giving a style in the template. 860 For example, 861 862 <!--#timestamp style="%m/%d/%y at %I:%M%P"--> 863 864 will give standard WeBWorK time format. Wording and other formatting 865 can be done in the template itself. 866 =cut 867 868 sub timestamp { 869 my ($self, $args) = @_; 870 my $formatstring = "%l:%M%P on %b %e, %Y"; 871 $formatstring = $args->{style} if(defined($args->{style})); 872 return(Date::Format::time2str($formatstring, time())); 873 } 874 875 =item message() 876 877 Defined in this package. 878 879 Print any messages (error or non-error) resulting from the last form submission. 880 This could be used to give Sucess and Failure messages after an action is performed by a module. 881 882 The implementation in this package prints the value of the field 883 $self->{status_message}, if it is present. 884 885 =cut 886 887 sub message { 888 my ($self) = @_; 889 890 print "\n<!-- BEGIN " . __PACKAGE__ . "::message -->\n"; 891 print $self->{status_message} if exists $self->{status_message}; 892 893 print "<!-- END " . __PACKAGE__ . "::message -->\n"; 894 895 return ""; 896 } 897 898 =item title() 899 900 Defined in this package. 901 902 Print the title of the current page. 903 904 The implementation in this package takes information from the WeBWorK::URLPath 905 associated with the current request. 906 907 =cut 908 909 sub title { 910 my ($self, $args) = @_; 911 my $r = $self->r; 912 913 #print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n"; 914 print underscore2nbsp($r->urlpath->name); 915 #print "<!-- END " . __PACKAGE__ . "::title -->\n"; 916 917 return ""; 918 } 919 920 =item warnings() 921 922 Defined in this package. 923 924 Print accumulated warnings. 925 926 The implementation in this package checks for a note in the request named 927 "warnings". If present, its contents are formatted and returned. 928 929 =cut 930 931 sub warnings { 932 my ($self) = @_; 933 my $r = $self->r; 934 935 print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n"; 936 print $self->warningOutput($r->notes("warnings")) if $r->notes("warnings"); 937 print "<!-- END " . __PACKAGE__ . "::warnings -->\n"; 938 939 return ""; 940 } 941 942 =item help() 943 944 Display a link to context-sensitive help. If the argument C<name> is defined, 945 the link will be to the help document for that name. Otherwise the module of the 946 WeBWorK::URLPath node for the current system location will be used. 947 948 =cut 949 950 sub help { 951 my $self = shift; 952 my $args = shift; 953 my $name = $args->{name}; 954 955 # old naming scheme 956 #$name = lc($self->r->urlpath->name) unless defined($name); 957 #$name =~ s/\s/_/g; 958 959 $name = $self->r->urlpath->module unless defined($name); 960 $name =~ s/WeBWorK::ContentGenerator:://; 961 $name =~ s/://g; 962 963 $self->helpMacro($name); 964 } 965 966 =item url($args) 967 968 Defined in this package. 969 970 Returns the specified URL from either %webworkURLs or %courseURLs in the course 971 environment. $args is a reference to a hash containing the following fields: 972 973 type => type of URL: webwork|course 974 name => name of URL (key in URL hash) 975 976 =cut 977 978 sub url { 979 my ($self, $args) = @_; 980 my $ce = $self->r->ce; 981 my $type = $args->{type}; 982 my $name = $args->{name}; 983 984 if ($type eq "webwork") { 985 return $ce->{webworkURLs}->{$name}; 986 } elsif ($type eq "course") { 987 return $ce->{courseURLs}->{$name}; 988 } else { 989 warn __PACKAGE__."::url: unrecognized type '$type'.\n"; 990 } 991 } 992 993 =back 994 995 =cut 996 997 # ------------------------------------------------------------------------------ 998 999 =head2 Conditional predicates 1000 1001 Conditional predicate methods are invoked when the C<#if> escape sequence is 1002 encountered in the template. If a method named C<if_predicate> is defined in 1003 here or in the instantiated subclass, it is invoked. 1004 1005 The following predicates are currently defined: 1006 1007 =over 1008 1009 =item if_can($function) 1010 1011 If a function named $function is present in the current content generator (or 1012 any superclass), a true value is returned. Otherwise, a false value is returned. 1013 1014 The implementation in this package uses the method UNIVERSAL->can(function) to 1015 arrive at the result. 1016 1017 A subclass could redefine this method to, for example, "hide" a method from the 1018 template: 1019 1020 sub if_can { 1021 my ($self, $arg) = @_; 1022 1023 if ($arg eq "floobar") { 1024 return 0; 1025 } else { 1026 return $self->SUPER::if_can($arg); 1027 } 1028 } 1029 1030 =cut 1031 1032 sub if_can { 1033 my ($self, $arg) = @_; 1034 1035 return $self->can($arg) ? 1 : 0; 1036 } 1037 1038 =item if_loggedin($arg) 1039 1040 If the user is currently logged in, $arg is returned. Otherwise, the inverse of 1041 $arg is returned. 1042 1043 #The implementation in this package always returns $arg, since most content 1044 #generators are only reachable when the user is authenticated. It is up to 1045 #classes that can be reached without logging in to override this method and 1046 #provide the correct behavior. 1047 # 1048 #This is suboptimal, and may change in the future. 1049 1050 The implementation in this package uses WeBWorK::Authen::was_verified() to 1051 retrieve the result of the last call to WeBWorK::Authen::verify(). 1052 1053 =cut 1054 1055 sub if_loggedin { 1056 my ($self, $arg) = @_; 1057 1058 #return $arg; 1059 return 0 unless $self->r->authen; 1060 return $self->r->authen->was_verified() ? $arg : !$arg; 1061 } 1062 1063 =item if_message($arg) 1064 1065 If the last form submission generated a message, $arg is returned. Otherwise, the 1066 inverse of $arg is returned. 1067 1068 The implementation in this package checks for the field $self->{status_message} to 1069 determine if a message is present. 1070 1071 If a subclass uses some other method to classify submission results, this method could be 1072 redefined to handle that variance: 1073 1074 sub if_message { 1075 my ($self, $arg) = @_; 1076 1077 my $status = $self->{processReturnValue}; 1078 if ($status != 0) { 1079 return $arg; 1080 } else { 1081 return !$arg; 1082 } 1083 } 1084 1085 =cut 1086 1087 sub if_message { 1088 my ($self, $arg) = @_; 1089 1090 if (exists $self->{status_message}) { 1091 return $arg; 1092 } else { 1093 return !$arg; 1094 } 1095 } 1096 1097 =item if_warnings 1098 1099 If warnings have been emitted while handling this request, $arg is returned. 1100 Otherwise, the inverse of $arg is returned. 1101 1102 The implementation in this package checks for a note in the request named 1103 "warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is 1104 handled. 1105 1106 =cut 1107 1108 sub if_warnings { 1109 my ($self, $arg) = @_; 1110 my $r = $self->r; 1111 1112 if ($r->notes("warnings")) { 1113 return $arg; 1114 } else { 1115 !$arg; 1116 } 1117 } 1118 1119 =back 1120 1121 =cut 1122 1123 ################################################################################ 1124 1125 =head1 HTML MACROS 1126 1127 Various routines are defined in this package for rendering common WeBWorK 1128 idioms. 1129 1130 FIXME: some of these should be moved to WeBWorK::HTML:: modules! 1131 1132 # ------------------------------------------------------------------------------ 1133 1134 =head2 Template escape handler macros 1135 1136 These methods are used by implementations of the escape sequence handlers to 1137 maintain a consistent style. 1138 1139 =over 1140 1141 =item pathMacro($args, @path) 1142 1143 Helper macro for the C<#path> escape sequence: $args is a hash reference 1144 containing the "style", "image", "text", and "textonly" arguments to the escape. 1145 @path consists of ordered key-value pairs of the form: 1146 1147 "Page Name" => URL 1148 1149 If the page should not have a link associated with it, the URL should be left 1150 empty. Authentication data is added to each URL so you don't have to. A fully- 1151 formed path line is returned, suitable for returning by a function implementing 1152 the C<#path> escape. 1153 1154 FIXME: authentication data probably shouldn't be added here any more, now that 1155 we have systemLink(). 1156 1157 =cut 1158 1159 sub pathMacro { 1160 my ($self, $args, @path) = @_; 1161 my %args = %$args; 1162 $args{style} = "text" if $args{textonly}; 1163 1164 my $auth = $self->url_authen_args; 1165 my $sep; 1166 if ($args{style} eq "image") { 1167 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 1168 } else { 1169 $sep = $args{text}; 1170 } 1171 1172 my @result; 1173 while (@path) { 1174 my $name = shift @path; 1175 my $url = shift @path; 1176 if ($url and not $args{textonly}) { 1177 push @result, CGI::a({-href=>"$url?$auth"}, $name); 1178 } else { 1179 push @result, $name; 1180 } 1181 } 1182 1183 return join($sep, @result), "\n"; 1184 } 1185 1186 =item siblingsMacro(@siblings) 1187 1188 Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered 1189 key-value pairs of the form: 1190 1191 "Sibling Name" => URL 1192 1193 If the sibling should not have a link associated with it, the URL should be left 1194 empty. Authentication data is added to each URL so you don't have to. A fully- 1195 formed siblings block is returned, suitable for returning by a function 1196 implementing the C<#siblings> escape. 1197 1198 FIXME: authentication data probably shouldn't be added here any more, now that 1199 we have systemLink(). 1200 1201 =cut 1202 1203 sub siblingsMacro { 1204 my ($self, @siblings) = @_; 1205 1206 my $auth = $self->url_authen_args; 1207 my $sep = CGI::br(); 1208 1209 my @result; 1210 while (@siblings) { 1211 my $name = shift @siblings; 1212 my $url = shift @siblings; 1213 push @result, $url 1214 ? CGI::a({-href=>"$url?$auth"}, $name) 1215 : $name; 1216 } 1217 1218 return join($sep, @result) . "\n"; 1219 } 1220 1221 1222 1223 =item navMacro($args, $tail, @links) 1224 1225 Helper macro for the C<#nav> escape sequence: $args is a hash reference 1226 containing the "style", "imageprefix", "imagesuffix", and "separator" arguments 1227 to the escape. @siblings consists of ordered tuples of the form: 1228 1229 "Link Name", URL, ImageBaseName 1230 1231 If the sibling should not have a link associated with it, the URL should be left 1232 empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>. 1233 Authentication data is added to each URL so you don't have to. $tail is appended 1234 to each URL, after the authentication information. A fully-formed nav line is 1235 returned, suitable for returning by a function implementing the C<#nav> escape. 1236 1237 =cut 1238 1239 sub navMacro { 1240 my ($self, $args, $tail, @links) = @_; 1241 my $r = $self->r; 1242 my $ce = $r->ce; 1243 my %args = %$args; 1244 1245 my $auth = $self->url_authen_args; 1246 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 1247 1248 my @result; 1249 while (@links) { 1250 my $name = shift @links; 1251 my $url = shift @links; 1252 my $img = shift @links; 1253 my $html = 1254 ($img && $args{style} eq "images") 1255 ? CGI::img( 1256 {src=>($prefix."/".$img.$args{imagesuffix}), 1257 border=>"", 1258 alt=>"$name"}) 1259 : $name; 1260 unless($img && !$url) { 1261 push @result, $url 1262 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 1263 : $html; 1264 } 1265 } 1266 1267 return join($args{separator}, @result) . "\n"; 1268 } 1269 1270 =item helpMacro($name) 1271 1272 This escape is represented by a question mark which links to an html page in the 1273 helpFiles directory. Currently the link is made to the file $name.html 1274 1275 =cut 1276 1277 sub helpMacro { 1278 my $self = shift; 1279 my $name = shift; 1280 my $label = shift; #optional 1281 my $ce = $self->r->ce; 1282 my $basePath = $ce->{webworkDirs}->{local_help}; 1283 $name = 'no_help' unless -e "$basePath/$name.html"; 1284 my $path = "$basePath/$name.html"; 1285 my $url = $ce->{webworkURLs}->{local_help}."/$name.html"; 1286 my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/question_mark.png"; 1287 $label = CGI::img({src=>$imageURL, alt=>" ? "}) unless defined $label; 1288 return CGI::a({href => $url, 1289 target => 'ww_help', 1290 onclick => "window.open(this.href,this.target,'width=550,height=350,scrollbars=yes,resizable=yes')"}, 1291 $label); 1292 } 1293 1294 =item optionsMacro(options_to_show => \@options_to_show, extra_params => \@extra_params) 1295 1296 Helper macro for displaying the View Options panel. 1297 1298 @options_to_show lists the options to show, from among this list "displayMode", 1299 "showOldAnswers", "showHints", "showSolutions". If no options are given, 1300 "displayMode" is assumed. 1301 1302 @extraParams is dereferenced and passed to the hidden_fields() method. Use this 1303 to preserve state from the content generator calling optionsMacro(). 1304 1305 This macro is intended to be called from an implementation of the options() 1306 method. The simplest way to to this is: 1307 1308 sub options { shift->optionsMacro } 1309 1310 =cut 1311 1312 sub optionsMacro { 1313 my ($self, %options) = @_; 1314 1315 my @options_to_show = @{$options{options_to_show}} if exists $options{options_to_show}; 1316 @options_to_show = "displayMode" unless @options_to_show; 1317 my %options_to_show; @options_to_show{@options_to_show} = (); # make hash for easy lookups 1318 my @extra_params = @{$options{extra_params}} if exists $options{extra_params}; 1319 1320 my $result = CGI::start_form("POST", $self->r->uri); 1321 $result .= $self->hidden_authen_fields; 1322 $result .= $self->hidden_fields(@extra_params) if @extra_params; 1323 $result .= CGI::start_div({class=>"viewOptions"}); 1324 1325 if (exists $options_to_show{displayMode}) { 1326 my $curr_displayMode = $self->r->param("displayMode") || $self->r->ce->{pg}->{options}->{displayMode}; 1327 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1328 my @active_modes = grep { exists $display_modes{$_} } @{$self->r->ce->{pg}->{displayModes}}; 1329 if (@active_modes > 1) { 1330 $result .= "View equations as: "; 1331 $result .= CGI::br(); 1332 $result .= CGI::radio_group( 1333 -name => "displayMode", 1334 -values => \@active_modes, 1335 -default => $curr_displayMode, 1336 -linebreak=>'true', 1337 ); 1338 $result .= CGI::br(); 1339 } 1340 } 1341 1342 if (exists $options_to_show{showOldAnswers}) { 1343 # Note, 0 is a legal value, so we can't use || in setting this 1344 my $curr_showOldAnswers = defined($self->r->param("showOldAnswers")) ? 1345 $self->r->param("showOldAnswers") : $self->r->ce->{pg}->{options}->{showOldAnswers}; 1346 $result .= "Show saved answers?"; 1347 $result .= CGI::br(); 1348 $result .= CGI::radio_group( 1349 -name => "showOldAnswers", 1350 -values => [1,0], 1351 -default => $curr_showOldAnswers, 1352 -labels => { 0=>'No', 1=>'Yes' }, 1353 ); 1354 $result .= CGI::br(); 1355 } 1356 1357 $result .= CGI::submit(-name=>"redisplay", -label=>"Apply Options"); 1358 $result .= CGI::end_div(); 1359 $result .= CGI::end_form(); 1360 1361 return $result; 1362 } 1363 1364 =item feedbackMacro(%params) 1365 1366 Helper macro for displaying the feedback form. Returns a button named "Email 1367 Instructor". %params contains the request parameters accepted by the Feedback 1368 module and their values. 1369 1370 =cut 1371 1372 sub feedbackMacro { 1373 my ($self, %params) = @_; 1374 my $r = $self->r; 1375 my $userID = $r->param("user"); 1376 my $authz = $r->authz; 1377 my $urlpath = $r->urlpath; 1378 my $courseID = $urlpath->arg("courseID"); 1379 1380 # don't do anything unless the user has permission to 1381 return "" unless $authz->hasPermissions($userID, "submit_feedback"); 1382 1383 # feedback form url 1384 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", courseID => $courseID); 1385 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action 1386 1387 my $result = CGI::start_form(-method=>"POST", -action=>$feedbackURL) . "\n"; 1388 $result .= $self->hidden_authen_fields . "\n"; 1389 1390 while (my ($key, $value) = each %params) { 1391 $result .= CGI::hidden($key, $value) . "\n"; 1392 } 1393 1394 $result .= CGI::p({-align=>"left"}, CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")); 1395 $result .= CGI::endform() . "\n"; 1396 1397 return $result; 1398 } 1399 1400 =back 1401 1402 =cut 1403 1404 # ------------------------------------------------------------------------------ 1405 1406 =head2 Parameter management 1407 1408 Methods for formatting request parameters as hidden form fields or query string 1409 fragments. 1410 1411 =over 1412 1413 =item hidden_fields(@fields) 1414 1415 Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if 1416 list is empty), taking data from the current request. 1417 1418 =cut 1419 1420 sub hidden_fields { 1421 my ($self, @fields) = @_; 1422 my $r = $self->r; 1423 1424 @fields = $r->param unless @fields; 1425 1426 my $html = ""; 1427 foreach my $param (@fields) { 1428 my @values = $r->param($param); 1429 $html .= CGI::hidden($param, @values); 1430 } 1431 return $html; 1432 } 1433 1434 =item hidden_authen_fields() 1435 1436 Use hidden_fields to return hidden <INPUT> tags for request fields used in 1437 authentication. 1438 1439 =cut 1440 1441 sub hidden_authen_fields { 1442 my ($self) = @_; 1443 1444 return $self->hidden_fields("user", "effectiveUser", "key"); 1445 } 1446 1447 =item hidden_proctor_authen_fields() 1448 1449 Use hidden_fields to return hidden <INPUT> tags for request fields used in 1450 proctor authentication. 1451 1452 =cut 1453 1454 sub hidden_proctor_authen_fields { 1455 my $self = shift; 1456 if ( $self->r->param('proctor_user') ) { 1457 return $self->hidden_fields("proctor_user", "proctor_key"); 1458 } else { 1459 return ''; 1460 } 1461 } 1462 1463 =item hidden_state_fields() 1464 1465 Use hidden_fields to return hidden <INPUT> tags for request fields used to 1466 maintain state. Currently includes authentication fields and display option 1467 fields. 1468 1469 =cut 1470 1471 sub hidden_state_fields { 1472 my ($self) = @_; 1473 1474 return $self->hidden_authen_fields(); 1475 1476 # other things that may be state data: 1477 #$self->hidden_fields("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); 1478 } 1479 1480 =item url_args(@fields) 1481 1482 Return a URL query string (without the leading `?') containing values for each 1483 field mentioned in @fields, or all fields if list is empty. Data is taken from 1484 the current request. 1485 1486 =cut 1487 1488 sub url_args { 1489 my ($self, @fields) = @_; 1490 my $r = $self->r; 1491 1492 @fields = $r->param unless @fields; 1493 1494 my @pairs; 1495 foreach my $param (@fields) { 1496 my @values = $r->param($param); 1497 foreach my $value (@values) { 1498 push @pairs, uri_escape($param) . "=" . uri_escape($value); 1499 } 1500 } 1501 1502 return join("&", @pairs); 1503 } 1504 1505 =item url_authen_args() 1506 1507 Use url_args to return a URL query string for request fields used in 1508 authentication. 1509 1510 =cut 1511 1512 sub url_authen_args { 1513 my ($self) = @_; 1514 1515 return $self->url_args("user", "effectiveUser", "key"); 1516 } 1517 1518 =item url_state_args() 1519 1520 Use url_args to return a URL query string for request fields used to maintain 1521 state. Currently includes authentication fields and display option fields. 1522 1523 =cut 1524 1525 sub url_state_args { 1526 my ($self) = @_; 1527 1528 return $self->url_authen_args; 1529 1530 # other things that may be state data: 1531 #$self->url_args("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); 1532 } 1533 1534 # This method is not used anywhere! --sam(1-Aug-05) 1535 # 1536 #=item url_display_args() 1537 # 1538 #Use url_args to return a URL query string for request fields used in 1539 #authentication. 1540 # 1541 #=cut 1542 # 1543 #sub url_display_args { 1544 # my ($self) = @_; 1545 # 1546 # return $self->url_args("displayMode", "showOldAnswer"); 1547 #} 1548 1549 # This method is not used anywhere! --sam(1-Aug-05) 1550 # 1551 #=item print_form_data($begin, $middle, $end, $omit) 1552 # 1553 #Return a string containing every request field not matched by the quoted reguar 1554 #expression $omit, placing $begin before each field name, $middle between each 1555 #field name and its value, and $end after each value. Values are taken from the 1556 #current request. 1557 # 1558 #=cut 1559 # 1560 #sub print_form_data { 1561 # my ($self, $begin, $middle, $end, $qr_omit) = @_; 1562 # my $r=$self->r; 1563 # my @form_data = $r->param; 1564 # 1565 # my $return_string = ""; 1566 # foreach my $name (@form_data) { 1567 # next if ($qr_omit and $name =~ /$qr_omit/); 1568 # my @values = $r->param($name); 1569 # foreach my $variable (qw(begin name middle value end)) { 1570 # # FIXME: can this loop be moved out of the enclosing loop? 1571 # no strict 'refs'; 1572 # ${$variable} = "" unless defined ${$variable}; 1573 # } 1574 # foreach my $value (@values) { 1575 # $return_string .= "$begin$name$middle$value$end"; 1576 # } 1577 # } 1578 # 1579 # return $return_string; 1580 #} 1581 1582 =back 1583 1584 =cut 1585 1586 # ------------------------------------------------------------------------------ 1587 1588 =head2 Utilities 1589 1590 =over 1591 1592 =item systemLink($urlpath, %options) 1593 1594 Generate a link to another part of the system. $urlpath is WeBWorK::URLPath 1595 object from which the base path will be taken. %options can consist of: 1596 1597 =over 1598 1599 =item params 1600 1601 Can be either a reference to an array or a reference to a hash. 1602 1603 If it is a reference to a hash, it maps parmaeter names to values. These 1604 parameters will be included in the generated link. If a value is an arrayref, 1605 the values of the array referenced will be used. If a value is undefined, the 1606 value from the current request will be used. 1607 1608 If C<params> is an arrayref, it is interpreted as a list of parameter names. 1609 These parameters will be included in the generated link, using the values from 1610 the current request. 1611 1612 Unless C<authen> is false (see below), the authentication parameters (C<user>, 1613 C<effectiveUser>, and C<key>) are included with their default values. 1614 1615 =item authen 1616 1617 If set to a false value, the authentication parameters (C<user>, 1618 C<effectiveUser>, and C<key>) are included in the the generated link unless 1619 explicitly listed in C<params>. 1620 1621 =back 1622 1623 =cut 1624 1625 # FIXME: there should probably be an option for prepending "http://hostname:port" 1626 sub systemLink { 1627 my ($self, $urlpath, %options) = @_; 1628 my $r = $self->r; 1629 1630 my %params = (); 1631 if (exists $options{params}) { 1632 if (ref $options{params} eq "HASH") { 1633 %params = %{ $options{params} }; 1634 } elsif (ref $options{params} eq "ARRAY") { 1635 my @names = @{ $options{params} }; 1636 @params{@names} = (); 1637 } else { 1638 croak "option 'params' is not a hashref or an arrayref"; 1639 } 1640 } 1641 1642 my $authen = exists $options{authen} ? $options{authen} : 1; 1643 if ($authen) { 1644 $params{user} = undef unless exists $params{user}; 1645 $params{effectiveUser} = undef unless exists $params{effectiveUser}; 1646 $params{key} = undef unless exists $params{key}; 1647 } 1648 1649 my $url = $r->location . $urlpath->path; 1650 my $first = 1; 1651 1652 foreach my $name (keys %params) { 1653 my $value = $params{$name}; 1654 1655 my @values; 1656 if (defined $value) { 1657 if (ref $value eq "ARRAY") { 1658 @values = @$value; 1659 } else { 1660 @values = $value; 1661 } 1662 } elsif (defined $r->param($name)) { 1663 @values = $r->param($name); 1664 } 1665 #FIXME -- evntually we'd like to catch where this happens 1666 if ($name eq 'user' and @values >1 ) { 1667 warn "internal error -- user has been multiply defined! You may need to logout and log back in to correct this."; 1668 my $user = $r->param("user"); 1669 $r->param(user => $user); 1670 @values = ($user); 1671 warn "requesting page is ", $r->headers_in->{'Referer'}; 1672 warn "Parameters are ", join("|",$r->param()); 1673 1674 } 1675 1676 if (@values) { 1677 if ($first) { 1678 $url .= "?"; 1679 $first = 0; 1680 } else { 1681 $url .= "&"; 1682 } 1683 $url .= join "&", map { "$name=$_" } @values; 1684 } 1685 } 1686 1687 return $url; 1688 } 1689 1690 =item nbsp($string) 1691 1692 If string consists of only whitespace, the HTML entity C< > is returned. 1693 Otherwise $string is returned. 1694 1695 =cut 1696 1697 sub nbsp { 1698 my ($self, $str) = @_; 1699 return (defined $str && $str =~/\S/) ? $str : " "; 1700 } 1701 1702 =item sp2nbsp($string) 1703 1704 A copy of $string is returned with each space character replaced by the 1705 C< > entity. 1706 1707 =cut 1708 1709 sub sp2nbsp { 1710 my ($str) = @_; 1711 return unless defined $str; 1712 $str =~ s/\s/ /g; 1713 return $str; 1714 } 1715 1716 =item underscore2nbsp($string) 1717 1718 A copy of $string is returned with each underscore character replaced by the 1719 C< > entity. 1720 1721 =cut 1722 1723 sub underscore2nbsp { 1724 my ($str) = @_; 1725 return unless defined $str; 1726 $str =~ s/_/ /g; 1727 return $str; 1728 } 1729 1730 =item errorOutput($error, $details) 1731 1732 Used by Problem, ProblemSet, and Hardcopy to report errors encountered during 1733 problem rendering. 1734 1735 =cut 1736 1737 sub errorOutput($$$) { 1738 my ($self, $error, $details) = @_; 1739 my $r = $self->{r}; 1740 1741 my $time = time2str("%a %b %d %H:%M:%S %Y", time); 1742 my $method = $r->method; 1743 my $uri = $r->uri; 1744 my $headers = do { 1745 my %headers = $r->headers_in; 1746 join("", map { CGI::Tr(CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); 1747 }; 1748 1749 # if it is a long report pass details by reference rather than by value 1750 # for consistency we automatically convert all forms of $details into 1751 # a reference to an array. 1752 1753 if (ref($details) =~ /SCALAR/i) { 1754 $details = [$$details]; 1755 } elsif (ref($details) =~/ARRAY/i) { 1756 # no change needed 1757 } else { 1758 $details = [$details]; 1759 } 1760 return 1761 CGI::h2("WeBWorK Error"), 1762 CGI::p(<<EOF), 1763 WeBWorK has encountered a software error while attempting to process this 1764 problem. It is likely that there is an error in the problem itself. If you are a 1765 student, report this error message to your professor to have it corrected. If 1766 you are a professor, please consult the error output below for more information. 1767 EOF 1768 CGI::h3("Error messages"), 1769 1770 CGI::p(CGI::code($error)), 1771 CGI::h3("Error details"), 1772 1773 CGI::start_code(), CGI::start_p(), 1774 @{ $details }, 1775 #CGI::code(CGI::p(@expandedDetails)), 1776 # not using inclusive CGI calls here saves about 30Meg of memory! 1777 CGI::end_p(),CGI::end_code(), 1778 1779 CGI::h3("Request information"), 1780 CGI::table({border=>"1"}, 1781 CGI::Tr(CGI::td("Time"), CGI::td($time)), 1782 CGI::Tr(CGI::td("Method"), CGI::td($method)), 1783 CGI::Tr(CGI::td("URI"), CGI::td($uri)), 1784 CGI::Tr(CGI::td("HTTP Headers"), CGI::td( 1785 CGI::table($headers), 1786 )), 1787 ), 1788 ; 1789 1790 } 1791 1792 =item warningOutput($warnings) 1793 1794 Used by warnings() in this class to report warnings caught during dispatching 1795 and content generation. 1796 1797 =cut 1798 1799 sub warningOutput($$) { 1800 my ($self, $warnings) = @_; 1801 my $r = $self->{r}; 1802 1803 my @warnings = split m/\n+/, $warnings; 1804 foreach my $warning (@warnings) { 1805 #$warning = escapeHTML($warning); # this would prevent using tables in output from answer evaluators 1806 $warning = CGI::li(CGI::code($warning)); 1807 } 1808 $warnings = join("", @warnings); 1809 1810 my $time = time2str("%a %b %d %H:%M:%S %Y", time); 1811 my $method = $r->method; 1812 my $uri = $r->uri; 1813 #my $headers = do { 1814 # my %headers = $r->headers_in; 1815 # join("", map { CGI::Tr(CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); 1816 #}; 1817 1818 return 1819 CGI::h2("WeBWorK Warnings"), 1820 CGI::p(<<EOF), 1821 WeBWorK has encountered warnings while processing your request. If this occured 1822 when viewing a problem, it was likely caused by an error or ambiguity in that 1823 problem. Otherwise, it may indicate a problem with the WeBWorK system itself. If 1824 you are a student, report these warnings to your professor to have them 1825 corrected. If you are a professor, please consult the warning output below for 1826 more information. 1827 EOF 1828 CGI::h3("Warning messages"), 1829 CGI::ul($warnings), 1830 CGI::h3("Request information"), 1831 CGI::table({border=>"1"}, 1832 CGI::Tr(CGI::td("Time"), CGI::td($time)), 1833 CGI::Tr(CGI::td("Method"), CGI::td($method)), 1834 CGI::Tr(CGI::td("URI"), CGI::td($uri)), 1835 #CGI::Tr(CGI::td("HTTP Headers"), CGI::td( 1836 # CGI::table($headers), 1837 #)), 1838 ); 1839 } 1840 1841 =item $dateTime = parseDateTime($string, $display_tz) 1842 1843 Parses $string as a datetime. If $display_tz is given, $string is assumed to be 1844 in that timezone. Otherwise, the timezone defined in the course environment 1845 variable $siteDefaults{timezone} is used. The result, $dateTime, is an integer 1846 UNIX datetime (epoch) in the server's timezone. 1847 1848 =cut 1849 1850 sub parseDateTime { 1851 my ($self, $string, $display_tz) = @_; 1852 my $ce = $self->r->ce; 1853 $display_tz ||= $ce->{siteDefaults}{timezone}; 1854 return WeBWorK::Utils::parseDateTime($string, $display_tz); 1855 }; 1856 1857 =item $string = formatDateTime($dateTime, $display_tz) 1858 1859 Formats the UNIX datetime $dateTime in the standard WeBWorK datetime format. 1860 $dateTime is assumed to be in the server's time zone. If $display_tz is given, 1861 the datetime is converted from the server's timezone to the timezone specified. 1862 Otherwise, the timezone defined in the course environment variable 1863 $siteDefaults{timezone} is used. 1864 1865 =cut 1866 1867 sub formatDateTime { 1868 my ($self, $dateTime, $display_tz) = @_; 1869 my $ce = $self->r->ce; 1870 $display_tz ||= $ce->{siteDefaults}{timezone}; 1871 return WeBWorK::Utils::formatDateTime($dateTime, $display_tz); 1872 } 1873 1874 =back 1875 1876 =head1 AUTHOR 1877 1878 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway, 1879 sh002i (at) math.rochester.edu. 1880 1881 =cut 1882 1883 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |