Parent Directory
|
Revision Log
commit merge with trunk (localization files)
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::start_ul(); 655 print CGI::start_li(); # Courses 656 print &$makelink("${pfx}Home", text=>$r->maketext("Courses"), systemlink_args=>{authen=>0}); 657 658 if (defined $courseID) { 659 #print CGI::start_ul(); 660 #print CGI::start_li(); # $courseID 661 #print CGI::strong(CGI::span({class=>"active"}, $courseID)); 662 663 if ($authen->was_verified) { 664 print CGI::start_ul(); 665 print CGI::start_li(); # Homework Sets 666 print &$makelink("${pfx}ProblemSets", text=>$r->maketext("Homework Sets"), urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 667 668 if (defined $setID) { 669 print CGI::start_ul(); 670 print CGI::start_li(); # $setID 671 # show a link if we're displaying a homework set, or a version 672 # of a gateway assignment; to know if it's a gateway 673 # assignment, we have to get the set record. 674 my ($globalSetID) = ( $setID =~ /(.+?)(,v\d+)?$/ ); 675 my $setRecord = $db->getGlobalSet( $globalSetID ); 676 if ( $setRecord->assignment_type !~ /gateway/ ) { 677 print &$makelink("${pfx}ProblemSet", text=>"$prettySetID", urlpath_args=>{%args,setID=>$setID}, systemlink_args=>\%systemlink_args); 678 } elsif ($setID =~ /,v(\d)+$/) { 679 print &$makelink("${pfx}GatewayQuiz", text=>"$prettySetID", urlpath_args=>{%args,setID=>$setID}, systemlink_args=>\%systemlink_args); 680 } 681 682 if (defined $problemID) { 683 print CGI::start_ul(); 684 print CGI::start_li(); # $problemID 685 print &$makelink("${pfx}Problem", text=>$r->maketext("Problem [_1]", $problemID), urlpath_args=>{%args,setID=>$setID,problemID=>$problemID}, systemlink_args=>\%systemlink_args); 686 687 print CGI::end_li(); # end $problemID 688 print CGI::end_ul(); 689 } 690 print CGI::end_li(); # end $setID 691 print CGI::end_ul(); 692 } 693 print CGI::end_li(); # end Homework Sets 694 695 if ($authz->hasPermissions($userID, "change_password") or $authz->hasPermissions($userID, "change_email_address")) { 696 print CGI::li(&$makelink("${pfx}Options", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 697 } 698 699 print CGI::li(&$makelink("${pfx}Grades", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 700 701 if ($authz->hasPermissions($userID, "access_instructor_tools")) { 702 $pfx .= "Instructor::"; 703 704 print CGI::start_li(); # Instructor Tools 705 print &$makelink("${pfx}Index", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 706 print CGI::start_ul(); 707 708 print CGI::li(&$makelink("${pfx}UserList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 709 710 print CGI::start_li(); # Homework Set Editor 711 print &$makelink("${pfx}ProblemSetList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 712 ## only show editor link for non-versioned sets 713 if (defined $setID && $setID !~ /,v\d+$/ ) { 714 print CGI::start_ul(); 715 print CGI::start_li(); # $setID 716 print &$makelink("${pfx}ProblemSetDetail", text=>"$prettySetID", urlpath_args=>{%args,setID=>$setID}, systemlink_args=>\%systemlink_args); 717 718 if (defined $problemID) { 719 print CGI::start_ul(); 720 print CGI::li(&$makelink("${pfx}PGProblemEditor", text=>"$problemID", urlpath_args=>{%args,setID=>$setID,problemID=>$problemID}, systemlink_args=>\%systemlink_args, target=>"WW_Editor")); 721 print CGI::end_ul(); 722 } 723 724 print CGI::end_li(); # end $setID 725 print CGI::end_ul(); 726 } 727 print CGI::end_li(); # end Homework Set Editor 728 729 print CGI::li(&$makelink("${pfx}SetMaker", text=>$r->maketext("Library Browser"), urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 730 731 print CGI::start_li(); # Stats 732 print &$makelink("${pfx}Stats", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 733 if ($userID ne $eUserID or defined $setID) { 734 print CGI::start_ul(); 735 if ($userID ne $eUserID) { 736 print CGI::li(&$makelink("${pfx}Stats", text=>"$eUserID", urlpath_args=>{%args,statType=>"student",userID=>$eUserID}, systemlink_args=>\%systemlink_args)); 737 } 738 if (defined $setID) { 739 # make sure we don't try to send a versioned 740 # set id in to the stats link 741 my ( $nvSetID ) = ( $setID =~ /(.+?)(,v\d+)?$/ ); 742 my ( $nvPretty ) = ( $prettySetID =~ /(.+?)(,v\d+)?$/ ); 743 print CGI::li(&$makelink("${pfx}Stats", text=>"$nvPretty", urlpath_args=>{%args,statType=>"set",setID=>$nvSetID}, systemlink_args=>\%systemlink_args)); 744 } 745 print CGI::end_ul(); 746 } 747 print CGI::end_li(); # end Stats 748 749 print CGI::start_li(); # Student Progress 750 print &$makelink("${pfx}StudentProgress", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); 751 if ($userID ne $eUserID or defined $setID) { 752 print CGI::start_ul(); 753 if ($userID ne $eUserID) { 754 print CGI::li(&$makelink("${pfx}StudentProgress", text=>"$eUserID", urlpath_args=>{%args,statType=>"student",userID=>$eUserID}, systemlink_args=>\%systemlink_args)); 755 } 756 if (defined $setID) { 757 # make sure we don't try to send a versioned 758 # set id in to the stats link 759 my ( $nvSetID ) = ( $setID =~ /(.+?)(,v\d+)?$/ ); 760 my ( $nvPretty ) = ( $prettySetID =~ /(.+?)(,v\d+)?$/ ); 761 print CGI::li(&$makelink("${pfx}StudentProgress", text=>"$nvPretty", urlpath_args=>{%args,statType=>"set",setID=>$nvSetID}, systemlink_args=>\%systemlink_args)); 762 } 763 print CGI::end_ul(); 764 } 765 print CGI::end_li(); # end Student Progress 766 767 if ($authz->hasPermissions($userID, "score_sets")) { 768 print CGI::li(&$makelink("${pfx}Scoring", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 769 } 770 771 if ($authz->hasPermissions($userID, "send_mail")) { 772 print CGI::li(&$makelink("${pfx}SendMail", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 773 } 774 775 if ($authz->hasPermissions($userID, "manage_course_files")) { 776 print CGI::li(&$makelink("${pfx}FileManager", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 777 } 778 779 if ($authz->hasPermissions($userID, "manage_course_files")) { 780 print CGI::li(&$makelink("${pfx}Config", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); 781 } 782 print CGI::li({}, $self->helpMacro('instructor_links','Help'),$self->help() ); 783 if ($authz->hasPermissions($userID, "manage_course_files") # show this only on the FileManager page 784 && $r->urlpath->module eq "WeBWorK::ContentGenerator::Instructor::FileManager") { 785 my %augmentedSystemLinks = %systemlink_args; 786 $augmentedSystemLinks{params}->{archiveCourse}=1; 787 print CGI::li(&$makelink("${pfx}FileManager", text=>"Archive this Course",urlpath_args=>{%args}, systemlink_args=>\%augmentedSystemLinks)); 788 } 789 print CGI::end_ul(); 790 print CGI::end_li(); # end Instructor Tools 791 } # /* access_instructor_tools */ 792 793 print CGI::end_ul(); 794 795 print CGI::start_ul(); 796 if (exists $ce->{webworkURLs}{bugReporter} and $ce->{webworkURLs}{bugReporter} ne "" 797 and $authz->hasPermissions($userID, "report_bugs")) { 798 print CGI::li(CGI::a({style=>'font-size:larger', href=>$ce->{webworkURLs}{bugReporter}}, $r->maketext("Report bugs"))); 799 } 800 801 print CGI::end_ul(); 802 803 } # /* authentication was_verified */ 804 805 #print CGI::end_li(); # end $courseID 806 #print CGI::end_ul(); 807 } # /* defined $courseID */ 808 809 print CGI::end_li(); # end Courses 810 print CGI::end_ul(); 811 812 813 814 815 return ""; 816 } 817 818 =item loginstatus() 819 820 Defined in this package. 821 822 Print a notification message announcing the current real user and effective 823 user, a link to stop acting as the effective user, and a link to logout. 824 825 =cut 826 827 sub loginstatus { 828 my ($self) = @_; 829 my $r = $self->r; 830 my $authen = $r->authen; 831 my $urlpath = $r->urlpath; 832 833 if ($authen and $authen->was_verified) { 834 my $courseID = $urlpath->arg("courseID"); 835 my $userID = $r->param("user"); 836 my $eUserID = $r->param("effectiveUser"); 837 838 my $stopActingURL = $self->systemLink($urlpath, # current path 839 params => { effectiveUser => $userID }, 840 ); 841 my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", $r, courseID => $courseID)); 842 843 if ($eUserID eq $userID) { 844 print $r->maketext("Logged in as [_1]. ", $userID) . CGI::br() . CGI::a({href=>$logoutURL}, $r->maketext("Log Out")); 845 } else { 846 print $r->maketext("Logged in as [_1]. ", $userID) . CGI::a({href=>$logoutURL}, $r->maketext("Log Out")) . CGI::br(); 847 print $r->maketext("Acting as [_1]. ", $eUserID) . CGI::a({href=>$stopActingURL}, $r->maketext("Stop Acting")); 848 } 849 } else { 850 print $r->maketext("Not logged in."); 851 } 852 853 return ""; 854 } 855 856 =item nav($args) 857 858 Not defined in this package. 859 860 Links to the previous, next, and parent objects. 861 862 $args is a reference to a hash containing the following fields: 863 864 style => text|image 865 imageprefix => prefix to prepend to base image URL 866 imagesuffix => suffix to append to base image URL 867 separator => HTML to place in between links 868 869 If C<style> is "image", image URLs are constructed by prepending C<imageprefix> 870 and postpending C<imagesuffix> to the image base names defined by the 871 implementor. (Examples of base names include "Prev", "Next", "ProbSet", and 872 "Up"). Each concatenated string should form an absolute URL to an image file. 873 For example: 874 875 <!--#nav style="images" imageprefix="/webwork2_files/images/nav" 876 imagesuffix=".gif" separator=" "--> 877 878 =cut 879 880 #sub nav { } 881 882 =item options() 883 884 Not defined in this package. 885 886 View options related to the content displayed in the body or info areas. See also 887 optionsMacro(). 888 889 =cut 890 891 #sub options { } 892 893 =item path($args) 894 895 Defined in this package. 896 897 Print "breadcrubs" from the root of the virtual hierarchy to the current page. 898 $args is a reference to a hash containing the following fields: 899 900 style => type of separator: text|image 901 image => if style=image, URL of image to use as path separator 902 text => if style=text, text to use as path separator 903 if style=image, the ALT text of each separator image 904 textonly => suppress all HTML, return only plain text 905 906 The implementation in this package takes information from the WeBWorK::URLPath 907 associated with the current request. 908 909 =cut 910 911 sub path { 912 my ($self, $args) = @_; 913 my $r = $self->r; 914 915 my @path; 916 917 my $urlpath = $r->urlpath; 918 do { 919 unshift @path, $urlpath->name, $r->location . $urlpath->path; 920 } while ($urlpath = $urlpath->parent); 921 922 $path[$#path] = ""; # we don't want the last path element to be a link 923 924 #print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n"; 925 print $self->pathMacro($args, @path); 926 #print "<!-- END " . __PACKAGE__ . "::path -->\n"; 927 928 return ""; 929 } 930 931 =item siblings() 932 933 Not defined in this package. 934 935 Print links to siblings of the current object. 936 937 =cut 938 939 #sub siblings { } 940 941 =item timestamp() 942 943 Defined in this package. 944 945 Display the current time and date using default format "3:37pm on Jan 7, 2004". 946 The display format can be adjusted by giving a style in the template. 947 For example, 948 949 <!--#timestamp style="%m/%d/%y at %I:%M%P"--> 950 951 will give standard WeBWorK time format. Wording and other formatting 952 can be done in the template itself. 953 =cut 954 955 # sub timestamp { 956 # my ($self, $args) = @_; 957 # my $formatstring = "%l:%M%P on %b %e, %Y"; 958 # $formatstring = $args->{style} if(defined($args->{style})); 959 # return(Date::Format::time2str($formatstring, time())); 960 # } 961 sub timestamp { 962 my ($self, $args) = @_; 963 # my $r = $self->r; 964 # my $ce = $r->ce; 965 # my $tz = $ce->{siteDefaults}{timezone}; 966 # warn "testing", $r, $ce, $tz; 967 # need to use the formatDateTime in this file (some subclasses access Util's version. 968 return( $self->formatDateTime( time() ) ); 969 } 970 =item message() 971 972 Defined in this package. 973 974 Print any messages (error or non-error) resulting from the last form submission. 975 This could be used to give Sucess and Failure messages after an action is performed by a module. 976 977 The implementation in this package prints the value of the field 978 $self->{status_message}, if it is present. 979 980 =cut 981 982 sub message { 983 my ($self) = @_; 984 985 print "\n<!-- BEGIN " . __PACKAGE__ . "::message -->\n"; 986 print $self->{status_message} if exists $self->{status_message}; 987 988 print "<!-- END " . __PACKAGE__ . "::message -->\n"; 989 990 return ""; 991 } 992 993 =item title() 994 995 Defined in this package. 996 997 Print the title of the current page. 998 999 The implementation in this package takes information from the WeBWorK::URLPath 1000 associated with the current request. 1001 1002 =cut 1003 1004 sub title { 1005 my ($self, $args) = @_; 1006 my $r = $self->r; 1007 1008 #print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n"; 1009 #print underscore2nbsp($r->urlpath->name); 1010 my $name = $r->urlpath->name; 1011 $name =~ s/_/ /g; 1012 print $name; 1013 #print "<!-- END " . __PACKAGE__ . "::title -->\n"; 1014 1015 return ""; 1016 } 1017 1018 =item warnings() 1019 1020 Defined in this package. 1021 1022 Print accumulated warnings. 1023 1024 The implementation in this package checks for a note in the request named 1025 "warnings". If present, its contents are formatted and returned. 1026 1027 =cut 1028 1029 sub warnings { 1030 my ($self) = @_; 1031 my $r = $self->r; 1032 1033 print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n"; 1034 my $warnings = MP2 ? $r->notes->get("warnings") : $r->notes("warnings"); 1035 print $self->warningOutput($warnings) if $warnings; 1036 print "<!-- END " . __PACKAGE__ . "::warnings -->\n"; 1037 1038 return ""; 1039 } 1040 1041 =item help() 1042 1043 Display a link to context-sensitive help. If the argument C<name> is defined, 1044 the link will be to the help document for that name. Otherwise the module of the 1045 WeBWorK::URLPath node for the current system location will be used. 1046 1047 =cut 1048 1049 sub help { 1050 my $self = shift; 1051 my $args = shift; 1052 my $name = $args->{name}; 1053 1054 # old naming scheme 1055 #$name = lc($self->r->urlpath->name) unless defined($name); 1056 #$name =~ s/\s/_/g; 1057 1058 $name = $self->r->urlpath->module unless defined($name); 1059 $name =~ s/WeBWorK::ContentGenerator:://; 1060 $name =~ s/://g; 1061 1062 $self->helpMacro($name); 1063 } 1064 1065 =item url($args) 1066 1067 Defined in this package. 1068 1069 Returns the specified URL from either %webworkURLs or %courseURLs in the course 1070 environment. $args is a reference to a hash containing the following fields: 1071 1072 type => type of URL: webwork|course 1073 name => name of URL (key in URL hash) 1074 1075 =cut 1076 1077 sub url { 1078 my ($self, $args) = @_; 1079 my $ce = $self->r->ce; 1080 my $type = $args->{type}; 1081 my $name = $args->{name}; 1082 1083 if ($type eq "webwork") { 1084 return $ce->{webworkURLs}->{$name}; 1085 } elsif ($type eq "course") { 1086 return $ce->{courseURLs}->{$name}; 1087 } else { 1088 warn __PACKAGE__."::url: unrecognized type '$type'.\n"; 1089 } 1090 } 1091 1092 =back 1093 1094 =cut 1095 1096 # ------------------------------------------------------------------------------ 1097 1098 =head2 Conditional predicates 1099 1100 Conditional predicate methods are invoked when the C<#if> escape sequence is 1101 encountered in the template. If a method named C<if_predicate> is defined in 1102 here or in the instantiated subclass, it is invoked. 1103 1104 The following predicates are currently defined: 1105 1106 =over 1107 1108 =item if_can($function) 1109 1110 If a function named $function is present in the current content generator (or 1111 any superclass), a true value is returned. Otherwise, a false value is returned. 1112 1113 The implementation in this package uses the method UNIVERSAL->can(function) to 1114 arrive at the result. 1115 1116 A subclass could redefine this method to, for example, "hide" a method from the 1117 template: 1118 1119 sub if_can { 1120 my ($self, $arg) = @_; 1121 1122 if ($arg eq "floobar") { 1123 return 0; 1124 } else { 1125 return $self->SUPER::if_can($arg); 1126 } 1127 } 1128 1129 =cut 1130 1131 sub if_can { 1132 my ($self, $arg) = @_; 1133 1134 return $self->can($arg) ? 1 : 0; 1135 } 1136 1137 =item if_loggedin($arg) 1138 1139 If the user is currently logged in, $arg is returned. Otherwise, the inverse of 1140 $arg is returned. 1141 1142 #The implementation in this package always returns $arg, since most content 1143 #generators are only reachable when the user is authenticated. It is up to 1144 #classes that can be reached without logging in to override this method and 1145 #provide the correct behavior. 1146 # 1147 #This is suboptimal, and may change in the future. 1148 1149 The implementation in this package uses WeBWorK::Authen::was_verified() to 1150 retrieve the result of the last call to WeBWorK::Authen::verify(). 1151 1152 =cut 1153 1154 sub if_loggedin { 1155 my ($self, $arg) = @_; 1156 1157 #return $arg; 1158 return 0 unless $self->r->authen; 1159 return $self->r->authen->was_verified() ? $arg : !$arg; 1160 } 1161 1162 =item if_message($arg) 1163 1164 If the last form submission generated a message, $arg is returned. Otherwise, the 1165 inverse of $arg is returned. 1166 1167 The implementation in this package checks for the field $self->{status_message} to 1168 determine if a message is present. 1169 1170 If a subclass uses some other method to classify submission results, this method could be 1171 redefined to handle that variance: 1172 1173 sub if_message { 1174 my ($self, $arg) = @_; 1175 1176 my $status = $self->{processReturnValue}; 1177 if ($status != 0) { 1178 return $arg; 1179 } else { 1180 return !$arg; 1181 } 1182 } 1183 1184 =cut 1185 1186 sub if_message { 1187 my ($self, $arg) = @_; 1188 1189 if (exists $self->{status_message}) { 1190 return $arg; 1191 } else { 1192 return !$arg; 1193 } 1194 } 1195 1196 =item if_warnings 1197 1198 If warnings have been emitted while handling this request, $arg is returned. 1199 Otherwise, the inverse of $arg is returned. 1200 1201 The implementation in this package checks for a note in the request named 1202 "warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is 1203 handled. 1204 1205 =cut 1206 1207 sub if_warnings { 1208 my ($self, $arg) = @_; 1209 my $r = $self->r; 1210 1211 if (MP2 ? $r->notes->get("warnings") : $r->notes("warnings")) { 1212 return $arg; 1213 } else { 1214 !$arg; 1215 } 1216 } 1217 1218 =back 1219 1220 =cut 1221 1222 ################################################################################ 1223 1224 =head1 HTML MACROS 1225 1226 Various routines are defined in this package for rendering common WeBWorK 1227 idioms. 1228 1229 FIXME: some of these should be moved to WeBWorK::HTML:: modules! 1230 1231 # ------------------------------------------------------------------------------ 1232 1233 =head2 Template escape handler macros 1234 1235 These methods are used by implementations of the escape sequence handlers to 1236 maintain a consistent style. 1237 1238 =over 1239 1240 =item pathMacro($args, @path) 1241 1242 Helper macro for the C<#path> escape sequence: $args is a hash reference 1243 containing the "style", "image", "text", and "textonly" arguments to the escape. 1244 @path consists of ordered key-value pairs of the form: 1245 1246 "Page Name" => URL 1247 1248 If the page should not have a link associated with it, the URL should be left 1249 empty. Authentication data is added to each URL so you don't have to. A fully- 1250 formed path line is returned, suitable for returning by a function implementing 1251 the C<#path> escape. 1252 1253 FIXME: authentication data probably shouldn't be added here any more, now that 1254 we have systemLink(). 1255 1256 =cut 1257 1258 sub pathMacro { 1259 my ($self, $args, @path) = @_; 1260 my %args = %$args; 1261 $args{style} = "text" if $args{textonly}; 1262 1263 my $auth = $self->url_authen_args; 1264 my $sep; 1265 if ($args{style} eq "image") { 1266 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 1267 } else { 1268 $sep = $args{text}; 1269 } 1270 1271 my @result; 1272 while (@path) { 1273 my $name = shift @path; 1274 my $url = shift @path; 1275 if ($url and not $args{textonly}) { 1276 push @result, CGI::a({-href=>"$url?$auth"}, $name); 1277 } else { 1278 push @result, $name; 1279 } 1280 } 1281 1282 return join($sep, @result), "\n"; 1283 } 1284 1285 =item siblingsMacro(@siblings) 1286 1287 Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered 1288 key-value pairs of the form: 1289 1290 "Sibling Name" => URL 1291 1292 If the sibling should not have a link associated with it, the URL should be left 1293 empty. Authentication data is added to each URL so you don't have to. A fully- 1294 formed siblings block is returned, suitable for returning by a function 1295 implementing the C<#siblings> escape. 1296 1297 FIXME: authentication data probably shouldn't be added here any more, now that 1298 we have systemLink(). 1299 1300 =cut 1301 1302 sub siblingsMacro { 1303 my ($self, @siblings) = @_; 1304 1305 my $auth = $self->url_authen_args; 1306 my $sep = CGI::br(); 1307 1308 my @result; 1309 while (@siblings) { 1310 my $name = shift @siblings; 1311 my $url = shift @siblings; 1312 my $id = $name; 1313 $id =~ s/\W/\_/g; 1314 push @result, $url 1315 ? CGI::span( {id=>$id}, CGI::a({-href=>"$url?$auth"}, $name) ) 1316 : CGI::span( {id=>$id},$name ); 1317 } 1318 1319 return join($sep, @result) . "\n"; 1320 } 1321 1322 1323 1324 =item navMacro($args, $tail, @links) 1325 1326 Helper macro for the C<#nav> escape sequence: $args is a hash reference 1327 containing the "style", "imageprefix", "imagesuffix", and "separator" arguments 1328 to the escape. @siblings consists of ordered tuples of the form: 1329 1330 "Link Name", URL, ImageBaseName 1331 1332 If the sibling should not have a link associated with it, the URL should be left 1333 empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>. 1334 Authentication data is added to each URL so you don't have to. $tail is appended 1335 to each URL, after the authentication information. A fully-formed nav line is 1336 returned, suitable for returning by a function implementing the C<#nav> escape. 1337 1338 =cut 1339 1340 sub navMacro { 1341 my ($self, $args, $tail, @links) = @_; 1342 my $r = $self->r; 1343 my $ce = $r->ce; 1344 my %args = %$args; 1345 1346 my $auth = $self->url_authen_args; 1347 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 1348 1349 my @result; 1350 while (@links) { 1351 my $name = shift @links; 1352 my $url = shift @links; 1353 my $img = shift @links; 1354 my $html = 1355 ($img && $args{style} eq "images") 1356 ? CGI::img( 1357 {src=>($prefix."/".$img.$args{imagesuffix}), 1358 border=>"", 1359 alt=>"$name"}) 1360 : $name; 1361 # unless($img && !$url) { ## these are now "disabled" versions in grey -- DPVC 1362 push @result, $url 1363 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 1364 : $html; 1365 # } 1366 } 1367 1368 return join($args{separator}, @result) . "\n"; 1369 } 1370 1371 =item helpMacro($name) 1372 1373 This escape is represented by a question mark which links to an html page in the 1374 helpFiles directory. Currently the link is made to the file $name.html 1375 1376 =cut 1377 1378 sub helpMacro { 1379 my $self = shift; 1380 my $name = shift; 1381 my $label = shift; #optional 1382 my $ce = $self->r->ce; 1383 my $basePath = $ce->{webworkDirs}->{local_help}; 1384 $name = 'no_help' unless -e "$basePath/$name.html"; 1385 my $path = "$basePath/$name.html"; 1386 my $url = $ce->{webworkURLs}->{local_help}."/$name.html"; 1387 my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/question_mark.png"; 1388 $label = CGI::img({src=>$imageURL, alt=>" ? "}) unless defined $label; 1389 return CGI::a({href => $url, 1390 target => 'ww_help', 1391 onclick => "window.open(this.href,this.target,'width=550,height=350,scrollbars=yes,resizable=yes')"}, 1392 $label); 1393 } 1394 1395 =item optionsMacro(options_to_show => \@options_to_show, extra_params => \@extra_params) 1396 1397 Helper macro for displaying the View Options panel. 1398 1399 @options_to_show lists the options to show, from among this list "displayMode", 1400 "showOldAnswers", "showHints", "showSolutions". If no options are given, 1401 "displayMode" is assumed. 1402 1403 @extraParams is dereferenced and passed to the hidden_fields() method. Use this 1404 to preserve state from the content generator calling optionsMacro(). 1405 1406 This macro is intended to be called from an implementation of the options() 1407 method. The simplest way to to this is: 1408 1409 sub options { shift->optionsMacro } 1410 1411 =cut 1412 1413 sub optionsMacro { 1414 my ($self, %options) = @_; 1415 1416 my @options_to_show = @{$options{options_to_show}} if exists $options{options_to_show}; 1417 @options_to_show = "displayMode" unless @options_to_show; #FIXME -- I don't understant this -- type seems wrong 1418 my %options_to_show; @options_to_show{@options_to_show} = (); # make hash for easy lookups 1419 my @extra_params = @{$options{extra_params}} if exists $options{extra_params}; 1420 1421 my $result = CGI::start_form("POST", $self->r->uri); 1422 $result .= $self->hidden_authen_fields; 1423 $result .= $self->hidden_fields(@extra_params) if @extra_params; 1424 $result .= CGI::start_div({class=>"viewOptions"}); 1425 1426 if (exists $options_to_show{displayMode}) { 1427 my $curr_displayMode = $self->r->param("displayMode") || $self->r->ce->{pg}->{options}->{displayMode}; 1428 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1429 my @active_modes = grep { exists $display_modes{$_} } @{$self->r->ce->{pg}->{displayModes}}; 1430 if (@active_modes > 1) { 1431 $result .= "View equations as: "; 1432 $result .= CGI::br(); 1433 $result .= CGI::radio_group( 1434 -name => "displayMode", 1435 -values => \@active_modes, 1436 -default => $curr_displayMode, 1437 -linebreak=>'true', 1438 ); 1439 $result .= CGI::br(); 1440 } 1441 } 1442 1443 if (exists $options_to_show{showOldAnswers}) { 1444 # Note, 0 is a legal value, so we can't use || in setting this 1445 my $curr_showOldAnswers = defined($self->r->param("showOldAnswers")) ? 1446 $self->r->param("showOldAnswers") : $self->r->ce->{pg}->{options}->{showOldAnswers}; 1447 $result .= "Show saved answers?"; 1448 $result .= CGI::br(); 1449 $result .= CGI::radio_group( 1450 -name => "showOldAnswers", 1451 -values => [1,0], 1452 -default => $curr_showOldAnswers, 1453 -labels => { 0=>'No', 1=>'Yes' }, 1454 ); 1455 $result .= CGI::br(); 1456 } 1457 1458 $result .= CGI::submit(-name=>"redisplay", -label=>"Apply Options"); 1459 $result .= CGI::end_div(); 1460 $result .= CGI::end_form(); 1461 1462 return $result; 1463 } 1464 1465 =item feedbackMacro(%params) 1466 1467 Helper macro for displaying the feedback form. Returns a button named "Email 1468 Instructor". %params contains the request parameters accepted by the Feedback 1469 module and their values. 1470 1471 =cut 1472 1473 sub feedbackMacro { 1474 my ($self, %params) = @_; 1475 my $r = $self->r; 1476 my $authz = $r->authz; 1477 my $userID = $r->param("user"); 1478 1479 # don't do anything unless the user has permission to 1480 return "" unless $authz->hasPermissions($userID, "submit_feedback"); 1481 1482 my $feedbackURL = $r->ce->{courseURLs}{feedbackURL}; 1483 my $feedbackFormURL = $r->ce->{courseURLs}{feedbackFormURL}; 1484 if (defined $feedbackURL and $feedbackURL ne "") { 1485 return $self->feedbackMacro_url($feedbackURL); 1486 } elsif (defined $feedbackFormURL and $feedbackFormURL ne "") { 1487 return $self->feedbackMacro_form($feedbackFormURL,%params); 1488 } else { 1489 return $self->feedbackMacro_email(%params); 1490 } 1491 } 1492 1493 sub feedbackMacro_email { 1494 my ($self, %params) = @_; 1495 my $r = $self->r; 1496 my $ce = $r->ce; 1497 my $urlpath = $r->urlpath; 1498 my $courseID = $urlpath->arg("courseID"); 1499 1500 # feedback form url 1501 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", $r, courseID => $courseID); 1502 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action 1503 my $feedbackName = $ce->{feedback_button_name} || $r->maketext("Email instructor"); 1504 1505 my $result = CGI::start_form(-method=>"POST", -action=>$feedbackURL) . "\n"; 1506 $result .= $self->hidden_authen_fields . "\n"; 1507 1508 while (my ($key, $value) = each %params) { 1509 next if $key eq 'pg_object'; # not used in internal feedback mechanism 1510 $result .= CGI::hidden($key, $value) . "\n"; 1511 } 1512 $result .= CGI::p({-align=>"left"}, CGI::submit(-name=>"feedbackForm", -label=>$feedbackName)); 1513 $result .= CGI::endform() . "\n"; 1514 1515 return $result; 1516 } 1517 1518 sub feedbackMacro_form { 1519 my ($self, $feedbackFormURL, %params) = @_; 1520 my $r = $self->r; 1521 my $ce = $r->ce; 1522 my $urlpath = $r->urlpath; 1523 my $courseID = $urlpath->arg("courseID"); 1524 1525 # feedback form url 1526 my $feedbackName = $ce->{feedback_button_name} || $r->maketext("Email instructor"); 1527 1528 my $result = CGI::start_form(-method=>"POST", -action=>$feedbackFormURL,-target=>"WW_info") . "\n"; 1529 $result .= $self->hidden_authen_fields . "\n"; 1530 1531 while (my ($key, $value) = each %params) { 1532 if ($key eq 'pg_object') { 1533 my $tmp = $value->{body_text}; 1534 $tmp .= CGI::p(CGI::b("Note: "). CGI::i($value->{result}->{msg})) if $value->{result}->{msg} ; 1535 $result .= CGI::hidden($key, encode_base64($tmp, "") ); 1536 } else { 1537 $result .= CGI::hidden($key, $value) . "\n"; 1538 } 1539 } 1540 $result .= CGI::p({-align=>"left"}, CGI::submit(-name=>"feedbackForm", -label=>$feedbackName)); 1541 $result .= CGI::endform() . "\n"; 1542 1543 return $result; 1544 } 1545 1546 sub feedbackMacro_url { 1547 my ($self, $url) = @_; 1548 my $r = $self->r; 1549 my $feedbackName = $r->ce->{feedback_button_name} || $r->maketext("Email instructor"); 1550 return CGI::a({-href=>$url}, $feedbackName); 1551 } 1552 1553 =back 1554 1555 =cut 1556 1557 # ------------------------------------------------------------------------------ 1558 1559 =head2 Parameter management 1560 1561 Methods for formatting request parameters as hidden form fields or query string 1562 fragments. 1563 1564 =over 1565 1566 =item hidden_fields(@fields) 1567 1568 Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if 1569 list is empty), taking data from the current request. 1570 1571 =cut 1572 1573 sub hidden_fields { 1574 my ($self, @fields) = @_; 1575 my $r = $self->r; 1576 1577 @fields = $r->param unless @fields; 1578 1579 my $html = ""; 1580 foreach my $param (@fields) { 1581 # my @values = $r->param($param); 1582 # $html .= CGI::hidden($param, @values); #MEG 1583 # warn "$param ", join(" ", @values) if @values >1; #this should never happen!!! 1584 my $value = $r->param($param); 1585 $html .= CGI::hidden($param, $value); # (can't name these items when using real CGI) 1586 } 1587 return $html; 1588 } 1589 1590 =item hidden_authen_fields() 1591 1592 Use hidden_fields to return hidden <INPUT> tags for request fields used in 1593 authentication. 1594 1595 =cut 1596 1597 sub hidden_authen_fields { 1598 my ($self) = @_; 1599 1600 return $self->hidden_fields("user", "effectiveUser", "key", "theme"); 1601 } 1602 1603 =item hidden_proctor_authen_fields() 1604 1605 Use hidden_fields to return hidden <INPUT> tags for request fields used in 1606 proctor authentication. 1607 1608 =cut 1609 1610 sub hidden_proctor_authen_fields { 1611 my $self = shift; 1612 if ( $self->r->param('proctor_user') ) { 1613 return $self->hidden_fields("proctor_user", "proctor_key"); 1614 } else { 1615 return ''; 1616 } 1617 } 1618 1619 =item hidden_state_fields() 1620 1621 Use hidden_fields to return hidden <INPUT> tags for request fields used to 1622 maintain state. Currently includes authentication fields and display option 1623 fields. 1624 1625 =cut 1626 1627 sub hidden_state_fields { 1628 my ($self) = @_; 1629 1630 return $self->hidden_authen_fields(); 1631 1632 # other things that may be state data: 1633 #$self->hidden_fields("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); 1634 } 1635 1636 =item url_args(@fields) 1637 1638 Return a URL query string (without the leading `?') containing values for each 1639 field mentioned in @fields, or all fields if list is empty. Data is taken from 1640 the current request. 1641 1642 =cut 1643 1644 sub url_args { 1645 my ($self, @fields) = @_; 1646 my $r = $self->r; 1647 1648 @fields = $r->param unless @fields; 1649 1650 my @pairs; 1651 foreach my $param (@fields) { 1652 my @values = $r->param($param); 1653 foreach my $value (@values) { 1654 push @pairs, uri_escape($param) . "=" . uri_escape($value); 1655 } 1656 } 1657 1658 return join("&", @pairs); 1659 } 1660 1661 =item url_authen_args() 1662 1663 Use url_args to return a URL query string for request fields used in 1664 authentication. 1665 1666 =cut 1667 1668 sub url_authen_args { 1669 my ($self) = @_; 1670 1671 return $self->url_args("user", "effectiveUser", "key", "theme"); 1672 } 1673 1674 =item url_state_args() 1675 1676 Use url_args to return a URL query string for request fields used to maintain 1677 state. Currently includes authentication fields and display option fields. 1678 1679 =cut 1680 1681 sub url_state_args { 1682 my ($self) = @_; 1683 1684 return $self->url_authen_args; 1685 1686 # other things that may be state data: 1687 #$self->url_args("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); 1688 } 1689 1690 # This method is not used anywhere! --sam(1-Aug-05) 1691 # 1692 #=item url_display_args() 1693 # 1694 #Use url_args to return a URL query string for request fields used in 1695 #authentication. 1696 # 1697 #=cut 1698 # 1699 #sub url_display_args { 1700 # my ($self) = @_; 1701 # 1702 # return $self->url_args("displayMode", "showOldAnswer"); 1703 #} 1704 1705 # This method is not used anywhere! --sam(1-Aug-05) 1706 # 1707 #=item print_form_data($begin, $middle, $end, $omit) 1708 # 1709 #Return a string containing every request field not matched by the quoted reguar 1710 #expression $omit, placing $begin before each field name, $middle between each 1711 #field name and its value, and $end after each value. Values are taken from the 1712 #current request. 1713 # 1714 #=cut 1715 # 1716 #sub print_form_data { 1717 # my ($self, $begin, $middle, $end, $qr_omit) = @_; 1718 # my $r=$self->r; 1719 # my @form_data = $r->param; 1720 # 1721 # my $return_string = ""; 1722 # foreach my $name (@form_data) { 1723 # next if ($qr_omit and $name =~ /$qr_omit/); 1724 # my @values = $r->param($name); 1725 # foreach my $variable (qw(begin name middle value end)) { 1726 # # FIXME: can this loop be moved out of the enclosing loop? 1727 # no strict 'refs'; 1728 # ${$variable} = "" unless defined ${$variable}; 1729 # } 1730 # foreach my $value (@values) { 1731 # $return_string .= "$begin$name$middle$value$end"; 1732 # } 1733 # } 1734 # 1735 # return $return_string; 1736 #} 1737 1738 =back 1739 1740 =cut 1741 1742 # ------------------------------------------------------------------------------ 1743 1744 =head2 Utilities 1745 1746 =over 1747 1748 =item systemLink($urlpath, %options) 1749 1750 Generate a link to another part of the system. $urlpath is WeBWorK::URLPath 1751 object from which the base path will be taken. %options can consist of: 1752 1753 =over 1754 1755 =item params 1756 1757 Can be either a reference to an array or a reference to a hash. 1758 1759 If it is a reference to a hash, it maps parmaeter names to values. These 1760 parameters will be included in the generated link. If a value is an arrayref, 1761 the values of the array referenced will be used. If a value is undefined, the 1762 value from the current request will be used. 1763 1764 If C<params> is an arrayref, it is interpreted as a list of parameter names. 1765 These parameters will be included in the generated link, using the values from 1766 the current request. 1767 1768 Unless C<authen> is false (see below), the authentication parameters (C<user>, 1769 C<effectiveUser>, and C<key>) are included with their default values. 1770 1771 =item authen 1772 1773 If set to a false value, the authentication parameters (C<user>, 1774 C<effectiveUser>, and C<key>) are included in the the generated link unless 1775 explicitly listed in C<params>. 1776 1777 =item use_abs_url 1778 1779 If set to a true value, the scheme, host, and port are prepended to the URL. 1780 This is useful for links which must be usable on their own, such as those sent 1781 via email. 1782 1783 =back 1784 1785 =cut 1786 1787 # FIXME: there should probably be an option for prepending "http://hostname:port" 1788 sub systemLink { 1789 my ($self, $urlpath, %options) = @_; 1790 my $r = $self->r; 1791 1792 my %params = (); 1793 if (exists $options{params}) { 1794 if (ref $options{params} eq "HASH") { 1795 %params = %{ $options{params} }; 1796 } elsif (ref $options{params} eq "ARRAY") { 1797 my @names = @{ $options{params} }; 1798 @params{@names} = (); 1799 } else { 1800 croak "option 'params' is not a hashref or an arrayref"; 1801 } 1802 } 1803 1804 my $authen = exists $options{authen} ? $options{authen} : 1; 1805 if ($authen) { 1806 $params{user} = undef unless exists $params{user}; 1807 $params{effectiveUser} = undef unless exists $params{effectiveUser}; 1808 $params{key} = undef unless exists $params{key}; 1809 $params{theme} = undef unless exists $params{theme}; 1810 } 1811 1812 my $url; 1813 1814 $url = $r->ce->{apache_root_url} if $options{use_abs_url}; 1815 $url .= $r->location . $urlpath->path; 1816 my $first = 1; 1817 1818 foreach my $name (keys %params) { 1819 my $value = $params{$name}; 1820 1821 my @values; 1822 if (defined $value) { 1823 if (ref $value eq "ARRAY") { 1824 @values = @$value; 1825 } else { 1826 @values = $value; 1827 } 1828 } elsif (defined $r->param($name)) { 1829 @values = $r->param($name); 1830 } 1831 #FIXME -- evntually we'd like to catch where this happens 1832 if ($name eq 'user' and @values >1 ) { 1833 warn "internal error -- user has been multiply defined! You may need to logout and log back in to correct this."; 1834 my $user = $r->param("user"); 1835 $r->param(user => $user); 1836 @values = ($user); 1837 warn "requesting page is ", $r->headers_in->{'Referer'}; 1838 warn "Parameters are ", join("|",$r->param()); 1839 1840 } 1841 1842 if (@values) { 1843 if ($first) { 1844 $url .= "?"; 1845 $first = 0; 1846 } else { 1847 $url .= "&"; 1848 } 1849 $url .= join "&", map { "$name=$_" } @values; 1850 } 1851 } 1852 1853 return $url; 1854 } 1855 1856 =item nbsp($string) 1857 1858 If string consists of only whitespace, the HTML entity C< > is returned. 1859 Otherwise $string is returned. 1860 1861 =cut 1862 1863 sub nbsp { 1864 my ($self, $str) = @_; 1865 return (defined $str && $str =~/\S/) ? $str : " "; 1866 } 1867 1868 =item sp2nbsp($string) 1869 1870 A copy of $string is returned with each space character replaced by the 1871 C< > entity. 1872 1873 =cut 1874 1875 sub sp2nbsp { 1876 my ($str) = @_; 1877 return unless defined $str; 1878 $str =~ s/\s/ /g; 1879 return $str; 1880 } 1881 1882 =item underscore2nbsp($string) 1883 1884 A copy of $string is returned with each underscore character replaced by the 1885 C< > entity. 1886 1887 =cut 1888 1889 sub underscore2nbsp { 1890 my ($str) = @_; 1891 return unless defined $str; 1892 $str =~ s/_/ /g; 1893 return $str; 1894 } 1895 1896 =item errorOutput($error, $details) 1897 1898 Used by Problem, ProblemSet, and Hardcopy to report errors encountered during 1899 problem rendering. 1900 1901 =cut 1902 1903 sub errorOutput($$$) { 1904 my ($self, $error, $details) = @_; 1905 my $r = $self->{r}; 1906 1907 my $time = time2str("%a %b %d %H:%M:%S %Y", time); 1908 my $method = $r->method; 1909 my $uri = $r->uri; 1910 my $headers = do { 1911 my %headers = %{$r->headers_in}; 1912 join("", map { CGI::Tr({},CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); 1913 }; 1914 1915 # if it is a long report pass details by reference rather than by value 1916 # for consistency we automatically convert all forms of $details into 1917 # a reference to an array. 1918 1919 if (ref($details) =~ /SCALAR/i) { 1920 $details = [$$details]; 1921 } elsif (ref($details) =~/ARRAY/i) { 1922 # no change needed 1923 } else { 1924 $details = [$details]; 1925 } 1926 return 1927 CGI::h2("WeBWorK Error"), 1928 CGI::p($r->maketext("_REQUEST_ERROR")), 1929 1930 CGI::h3("Error messages"), 1931 1932 CGI::p(CGI::code($error)), 1933 CGI::h3("Error details"), 1934 1935 CGI::start_code(), CGI::start_p(), 1936 @{ $details }, 1937 #CGI::code(CGI::p(@expandedDetails)), 1938 # not using inclusive CGI calls here saves about 30Meg of memory! 1939 CGI::end_p(),CGI::end_code(), 1940 1941 CGI::h3("Request information"), 1942 CGI::table({border=>"1"}, 1943 CGI::Tr({},CGI::td("Time"), CGI::td($time)), 1944 CGI::Tr({},CGI::td("Method"), CGI::td($method)), 1945 CGI::Tr({},CGI::td("URI"), CGI::td($uri)), 1946 CGI::Tr({},CGI::td("HTTP Headers"), CGI::td( 1947 CGI::table($headers), 1948 )), 1949 ), 1950 ; 1951 1952 } 1953 1954 =item warningOutput($warnings) 1955 1956 Used by warnings() in this class to report warnings caught during dispatching 1957 and content generation. 1958 1959 =cut 1960 1961 sub warningOutput($$) { 1962 my ($self, $warnings) = @_; 1963 my $r = $self->{r}; 1964 1965 my @warnings = split m/\n+/, $warnings; 1966 foreach my $warning (@warnings) { 1967 #$warning = escapeHTML($warning); # this would prevent using tables in output from answer evaluators 1968 $warning = CGI::li(CGI::code($warning)); 1969 } 1970 $warnings = join("", @warnings); 1971 1972 my $time = time2str("%a %b %d %H:%M:%S %Y", time); 1973 my $method = $r->method; 1974 my $uri = $r->uri; 1975 #my $headers = do { 1976 # my %headers = $r->headers_in; 1977 # join("", map { CGI::Tr(CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); 1978 #}; 1979 1980 return 1981 CGI::h2("WeBWorK Warnings"), 1982 CGI::p(<<EOF), 1983 WeBWorK has encountered warnings while processing your request. If this occured 1984 when viewing a problem, it was likely caused by an error or ambiguity in that 1985 problem. Otherwise, it may indicate a problem with the WeBWorK system itself. If 1986 you are a student, report these warnings to your professor to have them 1987 corrected. If you are a professor, please consult the warning output below for 1988 more information. 1989 EOF 1990 CGI::h3("Warning messages"), 1991 CGI::ul($warnings), 1992 CGI::h3("Request information"), 1993 CGI::table({border=>"1"}, 1994 CGI::Tr({},CGI::td("Time"), CGI::td($time)), 1995 CGI::Tr({},CGI::td("Method"), CGI::td($method)), 1996 CGI::Tr({},CGI::td("URI"), CGI::td($uri)), 1997 #CGI::Tr(CGI::td("HTTP Headers"), CGI::td( 1998 # CGI::table($headers), 1999 #)), 2000 ); 2001 } 2002 2003 =item $dateTime = parseDateTime($string, $display_tz) 2004 2005 Parses $string as a datetime. If $display_tz is given, $string is assumed to be 2006 in that timezone. Otherwise, the timezone defined in the course environment 2007 variable $siteDefaults{timezone} is used. The result, $dateTime, is an integer 2008 UNIX datetime (epoch) in the server's timezone. 2009 2010 =cut 2011 2012 sub parseDateTime { 2013 my ($self, $string, $display_tz) = @_; 2014 my $ce = $self->r->ce; 2015 $display_tz ||= $ce->{siteDefaults}{timezone}; 2016 return WeBWorK::Utils::parseDateTime($string, $display_tz); 2017 }; 2018 2019 =item $string = formatDateTime($dateTime, $display_tz) 2020 2021 Formats the UNIX datetime $dateTime in the standard WeBWorK datetime format. 2022 $dateTime is assumed to be in the server's time zone. If $display_tz is given, 2023 the datetime is converted from the server's timezone to the timezone specified. 2024 Otherwise, the timezone defined in the course environment variable 2025 $siteDefaults{timezone} is used. 2026 2027 =cut 2028 2029 sub formatDateTime { 2030 my ($self, $dateTime, $display_tz) = @_; 2031 my $ce = $self->r->ce; 2032 $display_tz ||= $ce->{siteDefaults}{timezone}; 2033 return WeBWorK::Utils::formatDateTime($dateTime, $display_tz); 2034 } 2035 2036 =item read_scoring_file($fileName) 2037 2038 Wrapper for WeBWorK::File::Scoring that no-ops if $fileName is "None" and 2039 prepends the path to the scoring directory. 2040 2041 =cut 2042 2043 sub read_scoring_file { 2044 my ($self, $fileName) = @_; 2045 return {} if $fileName eq "None"; # callers expect a hashref in all cases 2046 return parse_scoring_file($self->r->ce->{courseDirs}{scoring}."/$fileName"); 2047 } 2048 2049 =back 2050 2051 =head1 AUTHOR 2052 2053 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway, 2054 sh002i (at) math.rochester.edu. 2055 2056 =cut 2057 2058 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |