View of /branches/rel-2-1-patches/webwork2/lib/WeBWorK/ContentGenerator.pm

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