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

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