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