[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7023 - (download) (as text) (annotate)
Thu Aug 25 13:28:08 2011 UTC (20 months, 4 weeks ago) by gage
File size: 60523 byte(s)
localization updates,
added a fix for Authen.pm which unescapes cookie data.
returned library browser 2 to the lineup



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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9