Parent Directory
| 
Revision Log
added formatDateTime and parseDateTime methods that use the timezone from the course environment if one is not specified and call the "real" functions in WeBWorK::Utils.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator.pm,v 1.113 2004/08/16 11:35:15 dpvc 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::Pretty qw(*ul *li); 49 use URI::Escape; 50 use WeBWorK::Template qw(template); 51 52 ################################################################################ 53 54 use constant PROBLEM_SETS => "Homework Sets"; 55 use constant OPTIONS => "Password/Email"; 56 use constant GRADES => "Grades"; 57 use constant LOG_OUT => "Logout"; 58 59 use constant ADD_USERS => "Add Users"; 60 use constant USER_LIST => "Class List Editor"; 61 use constant SET_LIST => "Hmwk Sets Editor"; 62 use constant SET_MAKER => "Library Browser"; 63 use constant ASSIGNER => "Set Assigner"; 64 use constant MAIL => "Email"; 65 use constant SCORING => "Scoring Tools"; 66 use constant STATS => "Statistics"; 67 use constant PROGRESS =>"Student Progress"; 68 use constant FILE_TRANSFER => "File Transfer"; 69 70 # Note: Perl 5.6 doesn't seem to allow multiple definitions of constants. 71 72 ############################################################################### 73 74 =head1 CONSTRUCTOR 75 76 =over 77 78 =item new($r) 79 80 Creates a new instance of a content generator. Supply a WeBWorK::Request object 81 $r. 82 83 =cut 84 85 sub new { 86 my ($invocant, $r) = @_; 87 my $class = ref($invocant) || $invocant; 88 my $self = { 89 r => $r, # this is now a WeBWorK::Request 90 ce => $r->ce(), # these three are here for 91 db => $r->db(), # backward-compatability 92 authz => $r->authz(), # with unconverted CGs 93 noContent => undef, # this should get clobbered at some point 94 }; 95 bless $self, $class; 96 return $self; 97 } 98 99 =back 100 101 =cut 102 103 ################################################################################ 104 105 =head1 INVOCATION 106 107 =over 108 109 =item go() 110 111 Generates a page, using methods from the particular subclass of ContentGenerator 112 that is instantiated. Generatoion is broken up into several steps, to give 113 subclasses ample control over the process. 114 115 =over 116 117 =item 1 118 119 go() will attempt to call the method pre_header_initialize(). This method may be 120 implemented in subclasses which must do processing before the HTTP header is 121 emitted. 122 123 =item 2 124 125 go() will attempt to call the method header(). This method emits the HTTP 126 header. It is defined in this class (see below), but may be overridden in 127 subclasses which need to send different header information. For some reason, the 128 return value of header() will be used as the result of this function, if it is 129 defined. 130 131 FIXME: figure out what the deal is with the return value of header(). If we sent 132 a header, it's too late to set the status by returning. If we didn't, header() 133 didn't perform its function! 134 135 =item 3 136 137 At this point, go() will terminate if the request is a HEAD request or if the 138 field $self->{noContent} contains a true value. 139 140 FIXME: I don't think we'll need noContent after reply_with_redirect() is 141 adopted by all modules. 142 143 =item 4 144 145 go() then attempts to call the method initialize(). This method may be 146 implemented in subclasses which must do processing after the HTTP header is sent 147 but before any content is sent. 148 149 =item 6 150 151 The method content() is called to send the page content to client. 152 153 =back 154 155 =cut 156 157 sub go { 158 my ($self) = @_; 159 my $r = $self->r; 160 my $ce = $r->ce; 161 162 my $returnValue = OK; 163 164 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 165 166 # send a file instead of a normal reply (reply_with_file() sets this field) 167 defined $self->{reply_with_file} and do { 168 return $self->do_reply_with_file($self->{reply_with_file}); 169 }; 170 171 # send a Location: header instead of a normal reply (reply_with_redirect() sets this field) 172 defined $self->{reply_with_redirect} and do { 173 return $self->do_reply_with_redirect($self->{reply_with_redirect}); 174 }; 175 176 my $headerReturn = $self->header(@_); 177 $returnValue = $headerReturn if defined $headerReturn; 178 # FIXME: we won't need noContent after reply_with_redirect() is adopted 179 return $returnValue if $r->header_only or $self->{noContent}; 180 181 $self->initialize() if $self->can("initialize"); 182 183 $self->content(); 184 185 return $returnValue; 186 } 187 188 =item r() 189 190 Returns a reference to the WeBWorK::Request object associated with this 191 instance. 192 193 =cut 194 195 sub r { 196 my ($self) = @_; 197 198 return $self->{r}; 199 } 200 201 =item do_reply_with_file($fileHash) 202 203 Handler for reply_with_file(), used by go(). DO NOT CALL THIS METHOD DIRECTLY. 204 205 =cut 206 207 sub do_reply_with_file { 208 my ($self, $fileHash) = @_; 209 my $r = $self->r; 210 211 my $type = $fileHash->{type}; 212 my $source = $fileHash->{source}; 213 my $name = $fileHash->{name}; 214 my $delete_after = $fileHash->{delete_after}; 215 216 # if there was a problem, we return here and let go() worry about sending the reply 217 return NOT_FOUND unless -e $source; 218 return FORBIDDEN unless -r $source; 219 220 # open the file now, so we can send the proper error status is we fail 221 open my $fh, "<", $source or return SERVER_ERROR; 222 223 # send our custom HTTP header 224 $r->content_type($type); 225 $r->header_out("Content-Disposition" => "attachment; filename=\"$name\""); 226 $r->send_http_header; 227 228 # send the file 229 $r->send_fd($fh); 230 231 # close the file and go home 232 close $fh; 233 234 if ($delete_after) { 235 unlink $source or warn "failed to unlink $source after sending: $!"; 236 } 237 } 238 239 =item do_reply_with_redirect($url) 240 241 Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTLY. 242 243 =cut 244 245 sub do_reply_with_redirect { 246 my ($self, $url) = @_; 247 my $r = $self->r; 248 249 $r->status(REDIRECT); 250 $r->header_out(Location => $url); 251 $r->send_http_header(); 252 } 253 254 =back 255 256 =cut 257 258 ################################################################################ 259 260 =head1 DATA MODIFIERS 261 262 Modifiers allow the caller to register a piece of data for later retrieval in a 263 standard way. 264 265 =over 266 267 =item reply_with_file($type, $source, $name, $delete_after) 268 269 Enables file sending mode, causing go() to send the file specified by $source to 270 the client after calling pre_header_initialize(). The content type sent is 271 $type, and the suggested client-side file name is $name. If $delete_after is 272 true, $source is deleted after it is sent. 273 274 Must be called before the HTTP header is sent. Usually called from 275 pre_header_initialize(). 276 277 =cut 278 279 sub reply_with_file { 280 my ($self, $type, $source, $name, $delete_after) = @_; 281 $delete_after ||= ""; 282 283 $self->{reply_with_file} = { 284 type => $type, 285 source => $source, 286 name => $name, 287 delete_after => $delete_after, 288 }; 289 } 290 291 =item reply_with_redirect($url) 292 293 Enables redirect mode, causing go() to redirect to the given URL after calling 294 pre_header_initialize(). 295 296 Must be called before the HTTP header is sent. Usually called from 297 pre_header_initialize(). 298 299 =cut 300 301 sub reply_with_redirect { 302 my ($self, $url) = @_; 303 304 $self->{reply_with_redirect} = $url; 305 } 306 307 =item addmessage($message) 308 309 Adds a message to the list of messages to be printed by the message() template 310 escape handler. 311 312 Must be called before the message() template escape is invoked. 313 314 =cut 315 316 # FIXME: we should probably 317 318 sub addmessage { 319 my ($self, $message) = @_; 320 $self->{status_message} .= $message; 321 } 322 323 =item addgoodmessage($message) 324 325 Adds a success message to the list of messages to be printed by the 326 message() template escape handler. 327 328 =cut 329 330 331 sub addgoodmessage { 332 my ($self, $message) = @_; 333 $self->addmessage(CGI::div({class=>"ResultsWithoutError"}, $message)); 334 } 335 336 =item addbadmessage($message) 337 338 Adds a failure message to the list of messages to be printed by the 339 message() template escape handler. 340 341 =cut 342 343 344 sub addbadmessage { 345 my ($self, $message) = @_; 346 $self->addmessage(CGI::div({class=>"ResultsWithError"}, $message)); 347 } 348 349 =back 350 351 =cut 352 353 ################################################################################ 354 355 =head1 STANDARD METHODS 356 357 The following are the standard content generator methods. Some are defined here, 358 but may be overridden in a subclass. Others are not defined unless they are 359 defined in a subclass. 360 361 =over 362 363 =item pre_header_initialize() 364 365 Not defined in this package. 366 367 May be defined by a subclass to perform any processing that must occur before 368 the HTTP header is sent. 369 370 =cut 371 372 #sub pre_header_initialize { } 373 374 =item header() 375 376 Defined in this package. 377 378 Generates and sends a default HTTP header, specifying the "text/html" content 379 type. 380 381 =cut 382 383 sub header { 384 my $self = shift; 385 my $r = $self->r; 386 387 $r->content_type("text/html"); 388 $r->send_http_header(); 389 return OK; 390 } 391 392 =item initialize() 393 394 Not defined in this package. 395 396 May be defined by a subclass to perform any processing that must occur after the 397 HTTP header is sent but before any content is sent. 398 399 =cut 400 401 #sub initialize { } 402 403 =item content() 404 405 Defined in this package. 406 407 Print the content of the generated page. 408 409 The implementation in this package uses WeBWorK::Template to define the content 410 of the page. See WeBWorK::Template for details. 411 412 If a method named templateName() exists, it it called to determine the name of 413 the template to use. If not, the default template, "system", is used. The 414 location of the template is looked up in the course environment. 415 416 =cut 417 418 sub content { 419 my ($self) = @_; 420 my $ce = $self->r->ce; 421 422 # if the content generator specifies a custom template name, use that 423 # field in the $ce->{templates} hash instead of "system" if it exists. 424 my $templateName; 425 if ($self->can("templateName")) { 426 $templateName = $self->templateName; 427 } else { 428 $templateName = "system"; 429 } 430 $templateName = "system" unless exists $ce->{templates}->{$templateName}; 431 template($ce->{templates}->{$templateName}, $self); 432 } 433 434 =back 435 436 =cut 437 438 # ------------------------------------------------------------------------------ 439 440 =head2 Template escape handlers 441 442 Template escape handlers are invoked when the template processor encounters a 443 matching escape sequence in the template. The escapse sequence's arguments are 444 passed to the methods as a reference to a hash. 445 446 For more information, refer to WeBWorK::Template. 447 448 The following template escapes handlers are defined here or may be defined in 449 subclasses. For methods that are not defined in this package, the documentation 450 defines the interface and behavior that any subclass implementation must follow. 451 452 =over 453 454 =item head() 455 456 Not defined in this package. 457 458 Any tags that should appear in the HEAD of the document. 459 460 =cut 461 462 #sub head { } 463 464 =item info() 465 466 Not defined in this package. 467 468 Auxiliary information related to the content displayed in the C<body>. 469 470 =cut 471 472 #sub info { } 473 474 =item links() 475 476 Defined in this package. 477 478 Links that should appear on every page. 479 480 =cut 481 482 sub links { 483 my ($self) = @_; 484 my $r = $self->r; 485 my $db = $r->db; 486 my $authz = $r->authz; 487 my $ce = $r->ce; 488 my $urlpath = $r->urlpath; 489 my $user = $r->param('user'); 490 491 # we're linking to other places in the same course, so grab the courseID from the current path 492 my $courseID = $urlpath->arg("courseID"); 493 494 # to make things more concise 495 my %args = ( courseID => $courseID ); 496 my $pfx = "WeBWorK::ContentGenerator::"; 497 498 my $sets = $urlpath->newFromModule("${pfx}ProblemSets", %args); 499 my $options = $urlpath->newFromModule("${pfx}Options", %args); 500 my $grades = $urlpath->newFromModule("${pfx}Grades", %args); 501 my $logout = $urlpath->newFromModule("${pfx}Logout", %args); 502 503 print "\n<!-- BEGIN " . __PACKAGE__ . "::links -->\n"; 504 # only users with appropriate permissions can report bugs 505 print CGI::p(CGI::a({style=>"font-size:larger", href=>$ce->{webworkURLs}{bugReporter}}, "Report bugs")),CGI::hr() if $authz->hasPermissions($user, "report_bugs"); 506 507 print CGI::start_ul({class=>"LinksMenu"}); 508 print CGI::li(CGI::span({style=>"font-size:larger"}, 509 CGI::a({href=>$self->systemLink($sets)}, PROBLEM_SETS))); 510 print CGI::li(CGI::a({href=>$self->systemLink($options)}, OPTIONS)); 511 print CGI::li(CGI::a({href=>$self->systemLink($grades)}, GRADES)); 512 print CGI::li(CGI::a({href=>$self->systemLink($logout)}, LOG_OUT)); 513 514 if ($authz->hasPermissions($user, "access_instructor_tools")) { 515 my $ipfx = "${pfx}Instructor::"; 516 517 my $userID = $r->param("effectiveUser"); 518 my $setID = $urlpath->arg("setID"); 519 $setID = "" if (defined $setID && !(grep /$setID/, $db->listUserSets($userID))); 520 my $problemID = $urlpath->arg("problemID"); 521 $problemID = "" if (defined $problemID && !(grep /$problemID/, $db->listUserProblems($userID, $setID))); 522 523 my $instr = $urlpath->newFromModule("${ipfx}Index", %args); 524 my $addUsers = $urlpath->newFromModule("${ipfx}AddUsers", %args); 525 my $userList = $urlpath->newFromModule("${ipfx}UserList", %args); 526 527 # set list links 528 my $setList = $urlpath->newFromModule("${ipfx}ProblemSetList", %args); 529 my $setDetail = $urlpath->newFromModule("${ipfx}ProblemSetEditor", %args, setID => $setID); 530 my $problemEditor = $urlpath->newFromModule("${ipfx}PGProblemEditor", %args, setID => $setID, problemID => $problemID); 531 532 my $maker = $urlpath->newFromModule("${ipfx}SetMaker", %args); 533 my $assigner = $urlpath->newFromModule("${ipfx}Assigner", %args); 534 my $mail = $urlpath->newFromModule("${ipfx}SendMail", %args); 535 my $scoring = $urlpath->newFromModule("${ipfx}Scoring", %args); 536 537 # statistics links 538 my $stats = $urlpath->newFromModule("${ipfx}Stats", %args); 539 my $userStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "student", userID => $userID); 540 my $setStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "set", setID => $setID); 541 542 # progress links 543 my $progress = $urlpath->newFromModule("${ipfx}StudentProgress", %args); 544 my $userProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "student", userID => $userID); 545 my $setProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "set", setID => $setID); 546 547 548 my $files = $urlpath->newFromModule("${ipfx}FileXfer", %args); 549 550 print CGI::hr(); 551 print CGI::start_li(); 552 print CGI::span({style=>"font-size:larger"}, 553 CGI::a({href=>$self->systemLink($instr)}, space2nbsp($instr->name)) 554 ); 555 print CGI::start_ul(); 556 #print CGI::li(CGI::a({href=>$self->systemLink($addUsers)}, ADD_USERS)) if $authz->hasPermissions($user, "modify_student_data"); 557 print CGI::li(CGI::a({href=>$self->systemLink($userList)}, USER_LIST)); 558 print CGI::start_li(); 559 print CGI::a({href=>$self->systemLink($setList)}, SET_LIST); 560 if (defined $setID and $setID ne "") { 561 print CGI::start_ul(); 562 print CGI::start_li(); 563 print CGI::a({href=>$self->systemLink($setDetail)}, $setID); 564 if (defined $problemID and $problemID ne "") { 565 print CGI::ul( 566 CGI::li(CGI::a({href=>$self->systemLink($problemEditor)}, $problemID)) 567 ); 568 } 569 print CGI::end_li(); 570 print CGI::end_ul(); 571 } 572 print CGI::end_li(); 573 print CGI::li(CGI::a({href=>$self->systemLink($maker)}, SET_MAKER)) if $authz->hasPermissions($user, "modify_problem_sets"); 574 print CGI::li(CGI::a({href=>$self->systemLink($assigner)}, ASSIGNER)) if $authz->hasPermissions($user, "assign_problem_sets"); 575 576 print CGI::li(CGI::a({href=>$self->systemLink($stats)}, STATS)); 577 # print CGI::start_li(); 578 # if (defined $userID and $userID ne "") { 579 # print CGI::ul( 580 # CGI::li(CGI::a({href=>$self->systemLink($userStats)}, $userID)) 581 # ); 582 # } 583 # if (defined $setID and $setID ne "") { 584 # print CGI::ul( 585 # CGI::li(CGI::a({href=>$self->systemLink($setStats)}, space2nbsp($setID))) 586 # ); 587 # } 588 # print CGI::end_li(); 589 590 ## Added Link for Student Progress 591 print CGI::li(CGI::a({href=>$self->systemLink($progress)}, PROGRESS)); 592 print CGI::start_li(); 593 if (defined $userID and $userID ne "") { 594 print CGI::ul( 595 CGI::li(CGI::a({href=>$self->systemLink($userProgress)}, $userID)) 596 ); 597 } 598 if (defined $setID and $setID ne "") { 599 print CGI::ul( 600 CGI::li(CGI::a({href=>$self->systemLink($setProgress)}, space2nbsp($setID))) 601 ); 602 } 603 print CGI::end_li(); 604 605 print CGI::li(CGI::a({href=>$self->systemLink($scoring)}, SCORING)) if $authz->hasPermissions($user, "score_sets"); 606 print CGI::li(CGI::a({href=>$self->systemLink($mail)}, MAIL)) if $authz->hasPermissions($user, "send_mail"); 607 print CGI::li(CGI::a({href=>$self->systemLink($files)}, FILE_TRANSFER)); 608 print CGI::li( $self->helpMacro('instructor_links')); 609 print CGI::end_ul(); 610 611 } 612 613 print CGI::end_ul(); 614 print "<!-- end " . __PACKAGE__ . "::links -->\n"; 615 616 return ""; 617 } 618 619 =item loginstatus() 620 621 Defined in this package. 622 623 Print a notification message announcing the current real user and effective 624 user, a link to stop acting as the effective user, and a link to logout. 625 626 =cut 627 628 sub loginstatus { 629 my ($self) = @_; 630 my $r = $self->r; 631 my $urlpath = $r->urlpath; 632 633 my $key = $r->param("key"); 634 635 if ($key) { 636 my $courseID = $urlpath->arg("courseID"); 637 my $userID = $r->param("user"); 638 my $eUserID = $r->param("effectiveUser"); 639 640 my $stopActingURL = $self->systemLink($urlpath, # current path 641 params => { effectiveUser => $userID }, 642 ); 643 my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID)); 644 645 print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n"; 646 647 print "Logged in as $userID. ", CGI::br(); 648 print CGI::a({href=>$logoutURL}, "Log Out"); 649 650 if ($eUserID ne $userID) { 651 print " | Acting as $eUserID. "; 652 print CGI::a({href=>$stopActingURL}, "Stop Acting"); 653 } 654 655 print "<!-- END " . __PACKAGE__ . "::loginstatus -->\n"; 656 } 657 658 return ""; 659 } 660 661 =item nav($args) 662 663 Not defined in this package. 664 665 Links to the previous, next, and parent objects. 666 667 $args is a reference to a hash containing the following fields: 668 669 style => text|image 670 imageprefix => prefix to prepend to base image URL 671 imagesuffix => suffix to append to base image URL 672 separator => HTML to place in between links 673 674 If C<style> is "image", image URLs are constructed by prepending C<imageprefix> 675 and postpending C<imagesuffix> to the image base names defined by the 676 implementor. (Examples of base names include "Prev", "Next", "ProbSet", and 677 "Up"). Each concatenated string should form an absolute URL to an image file. 678 For example: 679 680 <!--#nav style="images" imageprefix="/webwork2_files/images/nav" 681 imagesuffix=".gif" separator=" "--> 682 683 =cut 684 685 #sub nav { } 686 687 =item options() 688 689 Not defined in this package. 690 691 Print an auxiliary options form, related to the content displayed in the 692 C<body>. 693 694 =item path($args) 695 696 Defined in this package. 697 698 Print "breadcrubs" from the root of the virtual hierarchy to the current page. 699 $args is a reference to a hash containing the following fields: 700 701 style => type of separator: text|image 702 image => if style=image, URL of image to use as path separator 703 text => if style=text, text to use as path separator 704 if style=image, the ALT text of each separator image 705 textonly => suppress all HTML, return only plain text 706 707 The implementation in this package takes information from the WeBWorK::URLPath 708 associated with the current request. 709 710 =cut 711 712 sub path { 713 my ($self, $args) = @_; 714 my $r = $self->r; 715 716 my @path; 717 718 my $urlpath = $r->urlpath; 719 do { 720 unshift @path, $urlpath->name, $r->location . $urlpath->path; 721 } while ($urlpath = $urlpath->parent); 722 723 $path[$#path] = ""; # we don't want the last path element to be a link 724 725 #print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n"; 726 print $self->pathMacro($args, @path); 727 #print "<!-- END " . __PACKAGE__ . "::path -->\n"; 728 729 return ""; 730 } 731 732 =item siblings() 733 734 Not defined in this package. 735 736 Print links to siblings of the current object. 737 738 =cut 739 740 #sub siblings { } 741 742 =item timestamp() 743 744 Defined in this package. 745 746 Display the current time and date using default format "3:37pm on Jan 7, 2004". 747 The display format can be adjusted by giving a style in the template. 748 For example, 749 750 <!--#timestamp style="%m/%d/%y at %I:%M%P"--> 751 752 will give standard WeBWorK time format. Wording and other formatting 753 can be done in the template itself. 754 =cut 755 756 sub timestamp { 757 my ($self, $args) = @_; 758 my $formatstring = "%l:%M%P on %b %e, %Y"; 759 $formatstring = $args->{style} if(defined($args->{style})); 760 return(Date::Format::time2str($formatstring, time())); 761 } 762 763 =item submiterror() 764 765 Defined in this package. 766 767 Print any error messages resulting from the last form submission. 768 769 This method is deprecated -- use message() instead 770 771 The implementation in this package prints the value of the field 772 $self->{submitError}, if it is present. 773 774 =cut 775 776 sub submiterror { 777 my ($self) = @_; 778 779 print "\n<!-- BEGIN " . __PACKAGE__ . "::submiterror -->\n"; 780 print $self->{submitError} if exists $self->{submitError}; 781 print "<!-- END " . __PACKAGE__ . "::submiterror -->\n"; 782 783 return ""; 784 } 785 786 =item message() 787 788 Defined in this package. 789 790 Print any messages (error or non-error) resulting from the last form submission. 791 This could be used to give Sucess and Failure messages after an action is performed by a module. 792 793 The implementation in this package prints the value of the field 794 $self->{status_message}, if it is present. 795 796 =cut 797 798 sub message { 799 my ($self) = @_; 800 801 print "\n<!-- BEGIN " . __PACKAGE__ . "::message -->\n"; 802 print $self->{status_message} if exists $self->{status_message}; 803 print "<!-- END " . __PACKAGE__ . "::message -->\n"; 804 805 return ""; 806 } 807 808 =item title() 809 810 Defined in this package. 811 812 Print the title of the current page. 813 814 The implementation in this package takes information from the WeBWorK::URLPath 815 associated with the current request. 816 817 =cut 818 819 sub title { 820 my ($self, $args) = @_; 821 my $r = $self->r; 822 823 824 #print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n"; 825 print $r->urlpath->name; 826 #print "<!-- END " . __PACKAGE__ . "::title -->\n"; 827 828 return ""; 829 } 830 831 =item warnings() 832 833 Defined in this package. 834 835 Print accumulated warnings. 836 837 The implementation in this package checks for a note in the request named 838 "warnings". If present, its contents are formatted and returned. 839 840 =cut 841 842 sub warnings { 843 my ($self) = @_; 844 my $r = $self->r; 845 846 print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n"; 847 print $self->warningOutput($r->notes("warnings")) if $r->notes("warnings"); 848 print "<!-- END " . __PACKAGE__ . "::warnings -->\n"; 849 850 return ""; 851 } 852 853 =item help() 854 855 Display a link to context-sensitive help. If the argument C<name> is defined, 856 the link will be to the help document for that name. Otherwise the name of the 857 WeBWorK::URLPath node for the current system location will be used. 858 859 =cut 860 861 sub help { 862 my $self = shift; 863 my $args = shift; 864 my $name = $args->{name}; 865 $name = lc($self->r->urlpath->name) unless defined($name); 866 $name =~ s/\s/_/g; 867 $self->helpMacro($name); 868 } 869 870 =back 871 872 =cut 873 874 # ------------------------------------------------------------------------------ 875 876 =head2 Conditional predicates 877 878 Conditional predicate methods are invoked when the C<#if> escape sequence is 879 encountered in the template. If a method named C<if_predicate> is defined in 880 here or in the instantiated subclass, it is invoked. 881 882 The following predicates are currently defined: 883 884 =over 885 886 =item if_can($function) 887 888 If a function named $function is present in the current content generator (or 889 any superclass), a true value is returned. Otherwise, a false value is returned. 890 891 The implementation in this package uses the method UNIVERSAL->can(function) to 892 arrive at the result. 893 894 A subclass could redefine this method to, for example, "hide" a method from the 895 template: 896 897 sub if_can { 898 my ($self, $arg) = @_; 899 900 if ($arg eq "floobar") { 901 return 0; 902 } else { 903 return $self->SUPER::if_can($arg); 904 } 905 } 906 907 =cut 908 909 sub if_can { 910 my ($self, $arg) = @_; 911 912 return $self->can($arg) ? 1 : 0; 913 } 914 915 =item if_loggedin($arg) 916 917 If the user is currently logged in, $arg is returned. Otherwise, the inverse of 918 $arg is returned. 919 920 The implementation in this package always returns $arg, since most content 921 generators are only reachable when the user is authenticated. It is up to 922 classes that can be reached without logging in to override this method and 923 provide the correct behavior. 924 925 This is suboptimal, and may change in the future. 926 927 =cut 928 929 sub if_loggedin { 930 my ($self, $arg) = @_; 931 932 return $arg; 933 } 934 935 =item if_submiterror($arg) 936 937 If the last form submission generated an error, $arg is returned. Otherwise, the 938 inverse of $arg is returned. 939 940 The implementation in this package checks for the field $self->{submitError} to 941 determine if an error condition is present. 942 943 If a subclass uses some other method to classify submission results, this method could be 944 redefined to handle that variance: 945 946 sub if_submiterror { 947 my ($self, $arg) = @_; 948 949 my $status = $self->{processReturnValue}; 950 if ($status != 0) { 951 return $arg; 952 } else { 953 return !$arg; 954 } 955 } 956 957 =cut 958 959 sub if_submiterror { 960 my ($self, $arg) = @_; 961 962 if (exists $self->{submitError}) { 963 return $arg; 964 } else { 965 return !$arg; 966 } 967 } 968 969 =item if_message($arg) 970 971 If the last form submission generated a message, $arg is returned. Otherwise, the 972 inverse of $arg is returned. 973 974 The implementation in this package checks for the field $self->{status_message} to 975 determine if a message is present. 976 977 If a subclass uses some other method to classify submission results, this method could be 978 redefined to handle that variance: 979 980 sub if_message { 981 my ($self, $arg) = @_; 982 983 my $status = $self->{processReturnValue}; 984 if ($status != 0) { 985 return $arg; 986 } else { 987 return !$arg; 988 } 989 } 990 991 =cut 992 993 sub if_message { 994 my ($self, $arg) = @_; 995 996 if (exists $self->{status_message}) { 997 return $arg; 998 } else { 999 return !$arg; 1000 } 1001 } 1002 1003 =item if_warnings 1004 1005 If warnings have been emitted while handling this request, $arg is returned. 1006 Otherwise, the inverse of $arg is returned. 1007 1008 The implementation in this package checks for a note in the request named 1009 "warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is 1010 handled. 1011 1012 =cut 1013 1014 sub if_warnings { 1015 my ($self, $arg) = @_; 1016 my $r = $self->r; 1017 1018 if ($r->notes("warnings")) { 1019 return $arg; 1020 } else { 1021 !$arg; 1022 } 1023 } 1024 1025 =back 1026 1027 =cut 1028 1029 ################################################################################ 1030 1031 =head1 HTML MACROS 1032 1033 Various routines are defined in this package for rendering common WeBWorK 1034 idioms. 1035 1036 FIXME: some of these should be moved to WeBWorK::HTML:: modules! 1037 1038 # ------------------------------------------------------------------------------ 1039 1040 =head2 Template escape handler macros 1041 1042 These methods are used by implementations of the escape sequence handlers to 1043 maintain a consistent style. 1044 1045 =over 1046 1047 =item pathMacro($args, @path) 1048 1049 Helper macro for the C<#path> escape sequence: $args is a hash reference 1050 containing the "style", "image", "text", and "textonly" arguments to the escape. 1051 @path consists of ordered key-value pairs of the form: 1052 1053 "Page Name" => URL 1054 1055 If the page should not have a link associated with it, the URL should be left 1056 empty. Authentication data is added to each URL so you don't have to. A fully- 1057 formed path line is returned, suitable for returning by a function implementing 1058 the C<#path> escape. 1059 1060 FIXME: authentication data probably shouldn't be added here any more, now that 1061 we have systemLink(). 1062 1063 =cut 1064 1065 sub pathMacro { 1066 my ($self, $args, @path) = @_; 1067 my %args = %$args; 1068 $args{style} = "text" if $args{textonly}; 1069 1070 my $auth = $self->url_authen_args; 1071 my $sep; 1072 if ($args{style} eq "image") { 1073 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 1074 } else { 1075 $sep = $args{text}; 1076 } 1077 1078 my @result; 1079 while (@path) { 1080 my $name = shift @path; 1081 my $url = shift @path; 1082 if ($url and not $args{textonly}) { 1083 push @result, CGI::a({-href=>"$url?$auth"}, $name); 1084 } else { 1085 push @result, $name; 1086 } 1087 } 1088 1089 return join($sep, @result), "\n"; 1090 } 1091 1092 =item siblingsMacro(@siblings) 1093 1094 Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered 1095 key-value pairs of the form: 1096 1097 "Sibling Name" => URL 1098 1099 If the sibling should not have a link associated with it, the URL should be left 1100 empty. Authentication data is added to each URL so you don't have to. A fully- 1101 formed siblings block is returned, suitable for returning by a function 1102 implementing the C<#siblings> escape. 1103 1104 FIXME: authentication data probably shouldn't be added here any more, now that 1105 we have systemLink(). 1106 1107 =cut 1108 1109 sub siblingsMacro { 1110 my ($self, @siblings) = @_; 1111 1112 my $auth = $self->url_authen_args; 1113 my $sep = CGI::br(); 1114 1115 my @result; 1116 while (@siblings) { 1117 my $name = shift @siblings; 1118 my $url = shift @siblings; 1119 push @result, $url 1120 ? CGI::a({-href=>"$url?$auth"}, $name) 1121 : $name; 1122 } 1123 1124 return join($sep, @result) . "\n"; 1125 } 1126 1127 1128 1129 =item navMacro($args, $tail, @links) 1130 1131 Helper macro for the C<#nav> escape sequence: $args is a hash reference 1132 containing the "style", "imageprefix", "imagesuffix", and "separator" arguments 1133 to the escape. @siblings consists of ordered tuples of the form: 1134 1135 "Link Name", URL, ImageBaseName 1136 1137 If the sibling should not have a link associated with it, the URL should be left 1138 empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>. 1139 Authentication data is added to each URL so you don't have to. $tail is appended 1140 to each URL, after the authentication information. A fully-formed nav line is 1141 returned, suitable for returning by a function implementing the C<#nav> escape. 1142 1143 =cut 1144 1145 sub navMacro { 1146 my ($self, $args, $tail, @links) = @_; 1147 my $r = $self->r; 1148 my $ce = $r->ce; 1149 my %args = %$args; 1150 1151 my $auth = $self->url_authen_args; 1152 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 1153 1154 my @result; 1155 while (@links) { 1156 my $name = shift @links; 1157 my $url = shift @links; 1158 my $img = shift @links; 1159 my $html = 1160 ($img && $args{style} eq "images") 1161 ? CGI::img( 1162 {src=>($prefix."/".$img.$args{imagesuffix}), 1163 border=>"", 1164 alt=>"$name"}) 1165 : $name; 1166 unless($img && !$url) { 1167 push @result, $url 1168 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 1169 : $html; 1170 } 1171 } 1172 1173 return join($args{separator}, @result) . "\n"; 1174 } 1175 1176 =item helpMacro($name) 1177 1178 This escape is represented by a question mark which links to an html page in the 1179 helpFiles directory. Currently the link is made to the file $name.html 1180 1181 =cut 1182 1183 sub helpMacro { 1184 my $self = shift; 1185 my $name = shift; 1186 my $ce = $self->r->ce; 1187 my $basePath = $ce->{webworkDirs}->{local_help}; 1188 $name = 'no_help' unless -e "$basePath/$name.html"; 1189 my $path = "$basePath/$name.html"; 1190 my $url = $ce->{webworkURLs}->{local_help}."/$name.html"; 1191 my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/question_mark.png"; 1192 return CGI::a({href => $url, 1193 target => 'ww_help', 1194 onclick => "window.open(this.href,this.target,'width=550,height=350,scrollbars=yes,resizable=on')"}, 1195 CGI::img({src=>$imageURL})); 1196 } 1197 1198 =back 1199 1200 =cut 1201 1202 # ------------------------------------------------------------------------------ 1203 1204 =head2 Parameter management 1205 1206 Methods for formatting request parameters as hidden form fields or query string 1207 fragments. 1208 1209 =over 1210 1211 =item hidden_fields(@fields) 1212 1213 Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if 1214 list is empty), taking data from the current request. 1215 1216 =cut 1217 1218 sub hidden_fields { 1219 my ($self, @fields) = @_; 1220 my $r = $self->r; 1221 1222 @fields = $r->param unless @fields; 1223 1224 my $html = ""; 1225 foreach my $param (@fields) { 1226 my @values = $r->param($param); 1227 $html .= CGI::hidden($param, @values); 1228 } 1229 return $html; 1230 } 1231 1232 =item hidden_authen_fields() 1233 1234 Use hidden_fields to return hidden <INPUT> tags for request fields used in 1235 authentication. 1236 1237 =cut 1238 1239 sub hidden_authen_fields { 1240 my ($self) = @_; 1241 1242 return $self->hidden_fields("user", "effectiveUser", "key"); 1243 } 1244 1245 =item url_args(@fields) 1246 1247 Return a URL query string (without the leading `?') containing values for each 1248 field mentioned in @fields, or all fields if list is empty. Data is taken from 1249 the current request. 1250 1251 =cut 1252 1253 sub url_args { 1254 my ($self, @fields) = @_; 1255 my $r = $self->r; 1256 1257 @fields = $r->param unless @fields; 1258 1259 my @pairs; 1260 foreach my $param (@fields) { 1261 my @values = $r->param($param); 1262 foreach my $value (@values) { 1263 push @pairs, uri_escape($param) . "=" . uri_escape($value); 1264 } 1265 } 1266 1267 return join("&", @pairs); 1268 } 1269 1270 =item url_authen_args() 1271 1272 Use url_args to return a URL query string for request fields used in 1273 authentication. 1274 1275 =cut 1276 1277 sub url_authen_args { 1278 my ($self) = @_; 1279 1280 return $self->url_args("user", "effectiveUser", "key"); 1281 } 1282 1283 =item print_form_data($begin, $middle, $end, $omit) 1284 1285 Return a string containing every request field not matched by the quoted reguar 1286 expression $omit, placing $begin before each field name, $middle between each 1287 field name and its value, and $end after each value. Values are taken from the 1288 current request. 1289 1290 =cut 1291 1292 sub print_form_data { 1293 my ($self, $begin, $middle, $end, $qr_omit) = @_; 1294 my $r=$self->r; 1295 my @form_data = $r->param; 1296 1297 my $return_string = ""; 1298 foreach my $name (@form_data) { 1299 next if ($qr_omit and $name =~ /$qr_omit/); 1300 my @values = $r->param($name); 1301 foreach my $variable (qw(begin name middle value end)) { 1302 # FIXME: can this loop be moved out of the enclosing loop? 1303 no strict 'refs'; 1304 ${$variable} = "" unless defined ${$variable}; 1305 } 1306 foreach my $value (@values) { 1307 $return_string .= "$begin$name$middle$value$end"; 1308 } 1309 } 1310 1311 return $return_string; 1312 } 1313 1314 =back 1315 1316 =cut 1317 1318 # ------------------------------------------------------------------------------ 1319 1320 =head2 Utilities 1321 1322 =over 1323 1324 =item systemLink($urlpath, %options) 1325 1326 Generate a link to another part of the system. $urlpath is WeBWorK::URLPath 1327 object from which the base path will be taken. %options can consist of: 1328 1329 =over 1330 1331 =item params 1332 1333 Can be either a reference to an array or a reference to a hash. 1334 1335 If it is a reference to a hash, it maps parmaeter names to values. These 1336 parameters will be included in the generated link. If a value is an arrayref, 1337 the values of the array referenced will be used. If a value is undefined, the 1338 value from the current request will be used. 1339 1340 If C<params> is an arrayref, it is interpreted as a list of parameter names. 1341 These parameters will be included in the generated link, using the values from 1342 the current request. 1343 1344 Unless C<authen> is false (see below), the authentication parameters (C<user>, 1345 C<effectiveUser>, and C<key>) are included with their default values. 1346 1347 =item authen 1348 1349 If set to a false value, the authentication parameters (C<user>, 1350 C<effectiveUser>, and C<key>) are included in the the generated link unless 1351 explicitly listed in C<params>. 1352 1353 =back 1354 1355 =cut 1356 1357 # FIXME: there should probably be an option for prepending "http://hostname:port" 1358 sub systemLink { 1359 my ($self, $urlpath, %options) = @_; 1360 my $r = $self->r; 1361 1362 my %params = (); 1363 if (exists $options{params}) { 1364 if (ref $options{params} eq "HASH") { 1365 %params = %{ $options{params} }; 1366 } elsif (ref $options{params} eq "ARRAY") { 1367 my @names = @{ $options{params} }; 1368 @params{@names} = (); 1369 } else { 1370 croak "option 'params' is not a hashref or an arrayref"; 1371 } 1372 } 1373 1374 my $authen = exists $options{authen} ? $options{authen} : 1; 1375 if ($authen) { 1376 $params{user} = undef unless exists $params{user}; 1377 $params{effectiveUser} = undef unless exists $params{effectiveUser}; 1378 $params{key} = undef unless exists $params{key}; 1379 } 1380 1381 my $url = $r->location . $urlpath->path; 1382 my $first = 1; 1383 1384 foreach my $name (keys %params) { 1385 my $value = $params{$name}; 1386 1387 my @values; 1388 if (defined $value) { 1389 if (ref $value eq "ARRAY") { 1390 @values = @$value; 1391 } else { 1392 @values = $value; 1393 } 1394 } elsif (defined $r->param($name)) { 1395 @values = $r->param($name); 1396 } 1397 1398 if (@values) { 1399 if ($first) { 1400 $url .= "?"; 1401 $first = 0; 1402 } else { 1403 $url .= "&"; 1404 } 1405 $url .= join "&", map { "$name=$_" } @values; 1406 } 1407 } 1408 1409 return $url; 1410 } 1411 1412 =item nbsp($string) 1413 1414 If string consists of only whitespace, the HTML entity C< > is returned. 1415 Otherwise $string is returned. 1416 1417 =cut 1418 1419 sub nbsp { 1420 my $self = shift; 1421 my $str = shift; 1422 (defined $str && $str =~/\S/) ? $str : ' '; 1423 } 1424 1425 =item space2nbsp($string) 1426 1427 Replace spaces in the string with html non-breaking spaces. 1428 1429 =cut 1430 1431 sub space2nbsp { 1432 my $str = shift; 1433 $str =~ s/\s/ /g; 1434 return($str); 1435 } 1436 1437 =item errorOutput($error, $details) 1438 1439 =cut 1440 1441 sub errorOutput($$$) { 1442 my ($self, $error, $details) = @_; 1443 return 1444 CGI::h3("Software Error"), 1445 CGI::p(<<EOF), 1446 WeBWorK has encountered a software error while attempting to process this 1447 problem. It is likely that there is an error in the problem itself. If you are 1448 a student, contact your professor to have the error corrected. If you are a 1449 professor, please consult the error output below for more information. 1450 EOF 1451 # FIXME: this message shouldn't refer the the "problem" since it is for general error reporting 1452 CGI::h3("Error messages"), CGI::p(CGI::tt($error)), 1453 CGI::h3("Error context"), CGI::p(CGI::tt($details)); 1454 } 1455 1456 =item warningOutput($warnings) 1457 1458 =cut 1459 1460 sub warningOutput($$) { 1461 my ($self, $warnings) = @_; 1462 1463 my @warnings = split m/\n+/, $warnings; 1464 1465 return 1466 CGI::h3("Software Warnings"), 1467 CGI::p(<<EOF), 1468 WeBWorK has encountered warnings while attempting to process this problem. It 1469 is likely that this indicates an error or ambiguity in the problem itself. If 1470 you are a student, contact your professor to have the problem corrected. If you 1471 are a professor, please consult the warning output below for more information. 1472 EOF 1473 # FIXME: this message shouldn't refer the the "problem" since it is for general warning reporting 1474 CGI::h3("Warning messages"), 1475 CGI::ul(CGI::li(\@warnings)); 1476 } 1477 1478 =item $dateTime = parseDateTime($string, $display_tz) 1479 1480 Parses $string as a datetime. If $display_tz is given, $string is assumed to be 1481 in that timezone. Otherwise, the timezone defined in the course environment 1482 variable $siteDefaults{timezone} is used. The result, $dateTime, is an integer 1483 UNIX datetime (epoch) in the server's timezone. 1484 1485 =cut 1486 1487 sub parseDateTime { 1488 my ($self, $string, $display_tz) = @_; 1489 my $ce = $self->r->ce; 1490 $display_tz ||= $ce->{siteDefaults}{timezone}; 1491 return WeBWorK::Utils::parseDateTime($string, $display_tz); 1492 }; 1493 1494 =item $string = formatDateTime($dateTime, $display_tz) 1495 1496 Formats the UNIX datetime $dateTime in the standard WeBWorK datetime format. 1497 $dateTime is assumed to be in the server's time zone. If $display_tz is given, 1498 the datetime is converted from the server's timezone to the timezone specified. 1499 Otherwise, the timezone defined in the course environment variable 1500 $siteDefaults{timezone} is used. 1501 1502 =cut 1503 1504 sub formatDateTime { 1505 my ($self, $dateTime, $display_tz) = @_; 1506 my $ce = $self->r->ce; 1507 $display_tz ||= $ce->{siteDefaults}{timezone}; 1508 return WeBWorK::Utils::formatDateTime($dateTime, $display_tz); 1509 } 1510 1511 =back 1512 1513 =head1 AUTHOR 1514 1515 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway, 1516 sh002i (at) math.rochester.edu. 1517 1518 =cut 1519 1520 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |