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