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