View of /trunk/webwork2/lib/WeBWorK/ContentGenerator.pm

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