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

View of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6944 - (download) (as text) (annotate)
Mon Jul 18 20:09:53 2011 UTC (22 months, 1 week ago) by gage
File size: 59552 byte(s)
commit merge with trunk (localization files)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9