Return to lonhelper.pm CVS log

Up to [LON-CAPA] / loncom / interface

1. If necessary restrict student selection to those in the
   section for which the user has advanced roles.
2. Revert the switch of &Apache::lonnet::escape -> escape back since
   there was no sub escape defined (yet?).

    1: # The LearningOnline Network with CAPA
    2: # .helper XML handler to implement the LON-CAPA helper
    3: #
    4: # $Id: lonhelper.pm,v 1.153 2006/05/30 21:48:00 foxr Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: 
   29: =pod
   30: 
   31: =head1 NAME
   32: 
   33: lonhelper - implements helper framework
   34: 
   35: =head1 SYNOPSIS
   36: 
   37: lonhelper implements the helper framework for LON-CAPA, and provides
   38:     many generally useful components for that framework.
   39: 
   40: Helpers are little programs which present the user with a sequence of
   41:     simple choices, instead of one monolithic multi-dimensional
   42:     choice. They are also referred to as "wizards", "druids", and
   43:     other potentially trademarked or semantically-loaded words.
   44: 
   45: =head1 OVERVIEWX<lonhelper>
   46: 
   47: Helpers are well-established UI widgets that users
   48: feel comfortable with. It can take a complicated multidimensional problem the
   49: user has and turn it into a series of bite-sized one-dimensional questions.
   50: 
   51: For developers, helpers provide an easy way to bundle little bits of functionality
   52: for the user, without having to write the tedious state-maintenence code.
   53: 
   54: Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers 
   55: directory and having the .helper file extension. For examples, see that directory.
   56: 
   57: All classes are in the Apache::lonhelper namespace.
   58: 
   59: =head1 lonhelper XML file formatX<lonhelper, XML file format>
   60: 
   61: A helper consists of a top-level <helper> tag which contains a series of states.
   62: Each state contains one or more state elements, which are what the user sees, like
   63: messages, resource selections, or date queries.
   64: 
   65: The helper tag is required to have one attribute, "title", which is the name
   66: of the helper itself, such as "Parameter helper". The helper tag may optionally
   67: have a "requiredpriv" attribute, specifying the priviledge a user must have
   68: to use the helper, or get denied access. See loncom/auth/rolesplain.tab for
   69: useful privs. Default is full access, which is often wrong!
   70: 
   71: =head2 State tags
   72: 
   73: State tags are required to have an attribute "name", which is the symbolic
   74: name of the state and will not be directly seen by the user. The helper is
   75: required to have one state named "START", which is the state the helper
   76: will start with. By convention, this state should clearly describe what
   77: the helper will do for the user, and may also include the first information
   78: entry the user needs to do for the helper.
   79: 
   80: State tags are also required to have an attribute "title", which is the
   81: human name of the state, and will be displayed as the header on top of 
   82: the screen for the user.
   83: 
   84: =head2 Example Helper Skeleton
   85: 
   86: An example of the tags so far:
   87: 
   88:  <helper title="Example Helper">
   89:    <state name="START" title="Demonstrating the Example Helper">
   90:      <!-- notice this is the START state the wizard requires -->
   91:      </state>
   92:    <state name="GET_NAME" title="Enter Student Name">
   93:      </state>
   94:    </helper>
   95: 
   96: Of course this does nothing. In order for the wizard to do something, it is
   97: necessary to put actual elements into the wizard. Documentation for each
   98: of these elements follows.
   99: 
  100: =head1 Creating a Helper With Code, Not XML
  101: 
  102: In some situations, such as the printing wizard (see lonprintout.pm), 
  103: writing the helper in XML would be too complicated, because of scope 
  104: issues or the fact that the code actually outweighs the XML. It is
  105: possible to create a helper via code, though it is a little odd.
  106: 
  107: Creating a helper via code is more like issuing commands to create
  108: a helper then normal code writing. For instance, elements will automatically
  109: be added to the last state created, so it's important to create the 
  110: states in the correct order.
  111: 
  112: First, create a new helper:
  113: 
  114:  use Apache::lonhelper;
  115: 
  116:  my $helper = Apache::lonhelper::new->("Helper Title");
  117: 
  118: Next you'll need to manually add states to the helper:
  119: 
  120:  Apache::lonhelper::state->new("STATE_NAME", "State's Human Title");
  121: 
  122: You don't need to save a reference to it because all elements up until
  123: the next state creation will automatically be added to this state.
  124: 
  125: Elements are created by populating the $paramHash in 
  126: Apache::lonhelper::paramhash. To prevent namespace issues, retrieve 
  127: a reference to that has with getParamHash:
  128: 
  129:  my $paramHash = Apache::lonhelper::getParamHash();
  130: 
  131: You will need to do this for each state you create.
  132: 
  133: Populate the $paramHash with the parameters for the element you wish
  134: to add next; the easiest way to find out what those entries are is
  135: to read the code. Some common ones are 'variable' to record the variable
  136: to store the results in, and NEXTSTATE to record a next state transition.
  137: 
  138: Then create your element:
  139: 
  140:  $paramHash->{MESSAGETEXT} = "This is a message.";
  141:  Apache::lonhelper::message->new();
  142: 
  143: The creation will take the $paramHash and bless it into a
  144: Apache::lonhelper::message object. To create the next element, you need
  145: to get a reference to the new, empty $paramHash:
  146: 
  147:  $paramHash = Apache::lonhelper::getParamHash();
  148: 
  149: and you can repeat creating elements that way. You can add states
  150: and elements as needed.
  151: 
  152: See lonprintout.pm, subroutine printHelper for an example of this, where
  153: we dynamically add some states to prevent security problems, for instance.
  154: 
  155: Normally the machinery in the XML format is sufficient; dynamically 
  156: adding states can easily be done by wrapping the state in a <condition>
  157: tag. This should only be used when the code dominates the XML content,
  158: the code is so complicated that it is difficult to get access to
  159: all of the information you need because of scoping issues, or would-be <exec> or 
  160: <eval> blocks using the {DATA} mechanism results in hard-to-read
  161: and -maintain code. (See course.initialization.helper for a borderline
  162: case.)
  163: 
  164: It is possible to do some of the work with an XML fragment parsed by
  165: lonxml; again, see lonprintout.pm for an example. In that case it is 
  166: imperative that you call B<Apache::lonhelper::registerHelperTags()>
  167: before parsing XML fragments and B<Apache::lonhelper::unregisterHelperTags()>
  168: when you are done. See lonprintout.pm for examples of this usage in the
  169: printHelper subroutine.
  170: 
  171: =head2 Localization
  172: 
  173: The helper framework tries to handle as much localization as
  174: possible. The text is always run through
  175: Apache::lonlocal::normalize_string, so be sure to run the keys through
  176: that function for maximum usefulness and robustness.
  177: 
  178: =cut
  179: 
  180: package Apache::lonhelper;
  181: use Apache::Constants qw(:common);
  182: use Apache::File;
  183: use Apache::lonxml;
  184: use Apache::lonlocal;
  185: use Apache::lonnet;
  186: use Apache::longroup;
  187: use Apache::lonselstudent;
  188: use lib '/home/httpd/lib/perl/';
  189: use LONCAPA;
  190: 
  191: # Register all the tags with the helper, so the helper can 
  192: # push and pop them
  193: 
  194: my @helperTags;
  195: 
  196: sub register {
  197:     my ($namespace, @tags) = @_;
  198: 
  199:     for my $tag (@tags) {
  200:         push @helperTags, [$namespace, $tag];
  201:     }
  202: }
  203: 
  204: BEGIN {
  205:     Apache::lonxml::register('Apache::lonhelper', 
  206:                              ('helper'));
  207:       register('Apache::lonhelper', ('state'));
  208: }
  209: 
  210: # Since all helpers are only three levels deep (helper tag, state tag, 
  211: # substate type), it's easier and more readble to explicitly track 
  212: # those three things directly, rather then futz with the tag stack 
  213: # every time.
  214: my $helper;
  215: my $state;
  216: my $substate;
  217: # To collect parameters, the contents of the subtags are collected
  218: # into this paramHash, then passed to the element object when the 
  219: # end of the element tag is located.
  220: my $paramHash; 
  221: 
  222: # Note from Jeremy 5-8-2003: It is *vital* that the real handler be called
  223: # as a subroutine from the handler, or very mysterious things might happen.
  224: # I don't know exactly why, but it seems that the scope where the Apache
  225: # server enters the perl handler is treated differently from the rest of
  226: # the handler. This also seems to manifest itself in the debugger as entering
  227: # the perl handler in seemingly random places (sometimes it starts in the
  228: # compiling phase, sometimes in the handler execution phase where it runs
  229: # the code and stepping into the "1;" the module ends with goes into the handler,
  230: # sometimes starting directly with the handler); I think the cause is related.
  231: # In the debugger, this means that breakpoints are ignored until you step into
  232: # a function and get out of what must be a "faked up scope" in the Apache->
  233: # mod_perl connection. In this code, it was manifesting itself in the existence
  234: # of two separate file-scoped $helper variables, one set to the value of the
  235: # helper in the helper constructor, and one referenced by the handler on the
  236: # "$helper->process()" line. Using the debugger, one could actually
  237: # see the two different $helper variables, as hashes at completely
  238: # different addresses. The second was therefore never set, and was still
  239: # undefined when I tried to call process on it.
  240: # By pushing the "real handler" down into the "real scope", everybody except the 
  241: # actual handler function directly below this comment gets the same $helper and
  242: # everybody is happy.
  243: # The upshot of all of this is that for safety when a handler is  using 
  244: # file-scoped variables in LON-CAPA, the handler should be pushed down one 
  245: # call level, as I do here, to ensure that the top-level handler function does
  246: # not get a different file scope from the rest of the code.
  247: sub handler {
  248:     my $r = shift;
  249:     return real_handler($r);
  250: }
  251: 
  252: # For debugging purposes, one can send a second parameter into this
  253: # function, the 'uri' of the helper you wish to have rendered, and
  254: # call this from other handlers.
  255: sub real_handler {
  256:     my $r = shift;
  257:     my $uri = shift;
  258:     if (!defined($uri)) { $uri = $r->uri(); }
  259:     $env{'request.uri'} = $uri;
  260:     my $filename = '/home/httpd/html' . $uri;
  261:     my $fh = Apache::File->new($filename);
  262:     my $file;
  263:     read $fh, $file, 100000000;
  264: 
  265: 
  266:     # Send header, don't cache this page
  267:     if ($env{'browser.mathml'}) {
  268: 	&Apache::loncommon::content_type($r,'text/xml');
  269:     } else {
  270: 	&Apache::loncommon::content_type($r,'text/html');
  271:     }
  272:     $r->send_http_header;
  273:     return OK if $r->header_only;
  274:     $r->rflush();
  275: 
  276:     # Discard result, we just want the objects that get created by the
  277:     # xml parsing
  278:     &Apache::lonxml::xmlparse($r, 'helper', $file);
  279: 
  280:     my $allowed = $helper->allowedCheck();
  281:     if (!$allowed) {
  282:         $env{'user.error.msg'} = $env{'request.uri'}.':'.$helper->{REQUIRED_PRIV}.
  283:             ":0:0:Permission denied to access this helper.";
  284:         return HTTP_NOT_ACCEPTABLE;
  285:     }
  286: 
  287:     $helper->process();
  288: 
  289:     $r->print($helper->display());
  290:     return OK;
  291: }
  292: 
  293: sub registerHelperTags {
  294:     for my $tagList (@helperTags) {
  295:         Apache::lonxml::register($tagList->[0], $tagList->[1]);
  296:     }
  297: }
  298: 
  299: sub unregisterHelperTags {
  300:     for my $tagList (@helperTags) {
  301:         Apache::lonxml::deregister($tagList->[0], $tagList->[1]);
  302:     }
  303: }
  304: 
  305: sub start_helper {
  306:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  307: 
  308:     if ($target ne 'helper') {
  309:         return '';
  310:     }
  311: 
  312:     registerHelperTags();
  313: 
  314:     Apache::lonhelper::helper->new($token->[2]{'title'}, $token->[2]{'requiredpriv'});
  315:     return '';
  316: }
  317: 
  318: sub end_helper {
  319:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  320:     
  321:     if ($target ne 'helper') {
  322:         return '';
  323:     }
  324: 
  325:     unregisterHelperTags();
  326: 
  327:     return '';
  328: }
  329: 
  330: sub start_state {
  331:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  332: 
  333:     if ($target ne 'helper') {
  334:         return '';
  335:     }
  336: 
  337:     Apache::lonhelper::state->new($token->[2]{'name'},
  338:                                   $token->[2]{'title'});
  339:     return '';
  340: }
  341: 
  342: # Use this to get the param hash from other files.
  343: sub getParamHash {
  344:     return $paramHash;
  345: }
  346: 
  347: # Use this to get the helper, if implementing elements in other files
  348: # (like lonprintout.pm)
  349: sub getHelper {
  350:     return $helper;
  351: }
  352: 
  353: # don't need this, so ignore it
  354: sub end_state {
  355:     return '';
  356: }
  357: 
  358: 1;
  359: 
  360: package Apache::lonhelper::helper;
  361: 
  362: use Digest::MD5 qw(md5_hex);
  363: use HTML::Entities();
  364: use Apache::loncommon;
  365: use Apache::File;
  366: use Apache::lonlocal;
  367: use Apache::lonnet;
  368: 
  369: sub new {
  370:     my $proto = shift;
  371:     my $class = ref($proto) || $proto;
  372:     my $self = {};
  373: 
  374:     $self->{TITLE} = shift;
  375:     $self->{REQUIRED_PRIV} = shift;
  376:     
  377:     # If there is a state from the previous form, use that. If there is no
  378:     # state, use the start state parameter.
  379:     if (defined $env{"form.CURRENT_STATE"})
  380:     {
  381: 	$self->{STATE} = $env{"form.CURRENT_STATE"};
  382:     }
  383:     else
  384:     {
  385: 	$self->{STATE} = "START";
  386:     }
  387: 
  388:     $self->{TOKEN} = $env{'form.TOKEN'};
  389:     # If a token was passed, we load that in. Otherwise, we need to create a 
  390:     # new storage file
  391:     # Tried to use standard Tie'd hashes, but you can't seem to take a 
  392:     # reference to a tied hash and write to it. I'd call that a wart.
  393:     if ($self->{TOKEN}) {
  394:         # Validate the token before trusting it
  395:         if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) {
  396:             # Not legit. Return nothing and let all hell break loose.
  397:             # User shouldn't be doing that!
  398:             return undef;
  399:         }
  400: 
  401:         # Get the hash.
  402:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file
  403:         
  404:         my $file = Apache::File->new($self->{FILENAME});
  405:         my $contents = <$file>;
  406: 
  407:         # Now load in the contents
  408:         for my $value (split (/&/, $contents)) {
  409:             my ($name, $value) = split(/=/, $value);
  410:             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  411:             $self->{VARS}->{$name} = $value;
  412:         }
  413: 
  414:         $file->close();
  415:     } else {
  416:         # Only valid if we're just starting.
  417:         if ($self->{STATE} ne 'START') {
  418:             return undef;
  419:         }
  420:         # Must create the storage
  421:         $self->{TOKEN} = md5_hex($env{'user.name'} . $env{'user.domain'} .
  422:                                  time() . rand());
  423:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN});
  424:     }
  425: 
  426:     # OK, we now have our persistent storage.
  427: 
  428:     if (defined $env{"form.RETURN_PAGE"})
  429:     {
  430: 	$self->{RETURN_PAGE} = $env{"form.RETURN_PAGE"};
  431:     }
  432:     else
  433:     {
  434: 	$self->{RETURN_PAGE} = $ENV{REFERER};
  435:     }
  436: 
  437:     $self->{STATES} = {};
  438:     $self->{DONE} = 0;
  439: 
  440:     # Used by various helpers for various things; see lonparm.helper
  441:     # for an example.
  442:     $self->{DATA} = {};
  443: 
  444:     $helper = $self;
  445: 
  446:     # Establish the $paramHash
  447:     $paramHash = {};
  448: 
  449:     bless($self, $class);
  450:     return $self;
  451: }
  452: 
  453: # Private function; returns a string to construct the hidden fields
  454: # necessary to have the helper track state.
  455: sub _saveVars {
  456:     my $self = shift;
  457:     my $result = "";
  458:     $result .= '<input type="hidden" name="CURRENT_STATE" value="' .
  459:         HTML::Entities::encode($self->{STATE},'<>&"') . "\" />\n";
  460:     $result .= '<input type="hidden" name="TOKEN" value="' .
  461:         $self->{TOKEN} . "\" />\n";
  462:     $result .= '<input type="hidden" name="RETURN_PAGE" value="' .
  463:         HTML::Entities::encode($self->{RETURN_PAGE},'<>&"') . "\" />\n";
  464: 
  465:     return $result;
  466: }
  467: 
  468: # Private function: Create the querystring-like representation of the stored
  469: # data to write to disk.
  470: sub _varsInFile {
  471:     my $self = shift;
  472:     my @vars = ();
  473:     for my $key (keys %{$self->{VARS}}) {
  474:         push @vars, &Apache::lonnet::escape($key) . '=' .
  475:             &Apache::lonnet::escape($self->{VARS}->{$key});
  476:     }
  477:     return join ('&', @vars);
  478: }
  479: 
  480: # Use this to declare variables.
  481: # FIXME: Document this
  482: sub declareVar {
  483:     my $self = shift;
  484:     my $var = shift;
  485: 
  486:     if (!defined($self->{VARS}->{$var})) {
  487:         $self->{VARS}->{$var} = '';
  488:     }
  489: 
  490:     my $envname = 'form.' . $var . '.forminput';
  491:     if (defined($env{$envname})) {
  492:         if (ref($env{$envname})) {
  493:             $self->{VARS}->{$var} = join('|||', @{$env{$envname}});
  494:         } else {
  495:             $self->{VARS}->{$var} = $env{$envname};
  496:         }
  497:     }
  498: }
  499: 
  500: sub allowedCheck {
  501:     my $self = shift;
  502: 
  503:     if (!defined($self->{REQUIRED_PRIV})) { 
  504:         return 1;
  505:     }
  506: 
  507:     return Apache::lonnet::allowed($self->{REQUIRED_PRIV}, $env{'request.course.id'});
  508: }
  509: 
  510: sub changeState {
  511:     my $self = shift;
  512:     $self->{STATE} = shift;
  513: }
  514: 
  515: sub registerState {
  516:     my $self = shift;
  517:     my $state = shift;
  518: 
  519:     my $stateName = $state->name();
  520:     $self->{STATES}{$stateName} = $state;
  521: }
  522: 
  523: sub process {
  524:     my $self = shift;
  525: 
  526:     # Phase 1: Post processing for state of previous screen (which is actually
  527:     # the "current state" in terms of the helper variables), if it wasn't the 
  528:     # beginning state.
  529:     if ($self->{STATE} ne "START" || $env{"form.SUBMIT"} eq &mt("Next ->")) {
  530: 	my $prevState = $self->{STATES}{$self->{STATE}};
  531:         $prevState->postprocess();
  532:     }
  533:     
  534:     # Note, to handle errors in a state's input that a user must correct,
  535:     # do not transition in the postprocess, and force the user to correct
  536:     # the error.
  537: 
  538:     # Phase 2: Preprocess current state
  539:     my $startState = $self->{STATE};
  540:     my $state = $self->{STATES}->{$startState};
  541:     
  542:     # For debugging, print something here to determine if you're going
  543:     # to an undefined state.
  544:     if (!defined($state)) {
  545:         return;
  546:     }
  547:     $state->preprocess();
  548: 
  549:     # Phase 3: While the current state is different from the previous state,
  550:     # keep processing.
  551:     while ( $startState ne $self->{STATE} && 
  552:             defined($self->{STATES}->{$self->{STATE}}) )
  553:     {
  554: 	$startState = $self->{STATE};
  555: 	$state = $self->{STATES}->{$startState};
  556: 	$state->preprocess();
  557:     }
  558: 
  559:     return;
  560: } 
  561: 
  562: # 1: Do the post processing for the previous state.
  563: # 2: Do the preprocessing for the current state.
  564: # 3: Check to see if state changed, if so, postprocess current and move to next.
  565: #    Repeat until state stays stable.
  566: # 4: Render the current state to the screen as an HTML page.
  567: sub display {
  568:     my $self = shift;
  569: 
  570:     my $state = $self->{STATES}{$self->{STATE}};
  571: 
  572:     my $result = "";
  573: 
  574:     if (!defined($state)) {
  575:         $result = "<font color='#ff0000'>Error: state '$state' not defined!</font>";
  576:         return $result;
  577:     }
  578: 
  579:     # Phase 4: Display.
  580:     my $stateTitle=&mt($state->title());
  581:     my $browser_searcher_js = 
  582: 	'<script type="text/javascript">'."\n".
  583: 	&Apache::loncommon::browser_and_searcher_javascript().
  584: 	"\n".'</script>';
  585: 
  586:     $result .= &Apache::loncommon::start_page($self->{TITLE},
  587: 					      $browser_searcher_js);
  588:     
  589:     my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"');
  590:     my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"');
  591:     # FIXME: This should be parameterized, not concatenated - Jeremy
  592: 
  593: 
  594:     if (!$state->overrideForm()) { $result.="<form name='helpform' method='POST'>"; }
  595:     $result .= <<HEADER;
  596:         <table border="0" width='100%'><tr><td>
  597:         <h2><i>$stateTitle</i></h2>
  598: HEADER
  599: 
  600:     $result .= "<table cellpadding='10' width='100%'><tr><td rowspan='2' valign='top'>";
  601: 
  602:     if (!$state->overrideForm()) {
  603:         $result .= $self->_saveVars();
  604:     }
  605:     $result .= $state->render();
  606: 
  607:     $result .= "</td><td valign='top' align='right'>";
  608: 
  609:     # Warning: Copy and pasted from below, because it's too much trouble to 
  610:     # turn this into a subroutine
  611:     if (!$state->overrideForm()) {
  612:         if ($self->{STATE} ne $self->{START_STATE}) {
  613:             #$result .= '<input name="SUBMIT" type="submit" value="&lt;- Previous" />&nbsp;&nbsp;';
  614:         }
  615:         if ($self->{DONE}) {
  616:             my $returnPage = $self->{RETURN_PAGE};
  617:             $result .= "<a href=\"$returnPage\">" . &mt("End Helper") . "</a>";
  618:         }
  619:         else {
  620:             $result .= '<nobr><input name="back" type="button" ';
  621:             $result .= 'value="' . $previous . '" onclick="history.go(-1)" /> ';
  622:             $result .= '<input name="SUBMIT" type="submit" value="' . $next . '" /></nobr>';
  623:         }
  624:     }
  625: 
  626:     $result .= "</td></tr><tr><td valign='bottom' align='right'>";
  627: 
  628:     # Warning: Copy and pasted from above, because it's too much trouble to 
  629:     # turn this into a subroutine
  630:     if (!$state->overrideForm()) {
  631:         if ($self->{STATE} ne $self->{START_STATE}) {
  632:             #$result .= '<input name="SUBMIT" type="submit" value="&lt;- Previous" />&nbsp;&nbsp;';
  633:         }
  634:         if ($self->{DONE}) {
  635:             my $returnPage = $self->{RETURN_PAGE};
  636:             $result .= "<a href=\"$returnPage\">" . &mt('End Helper') . "</a>";
  637:         }
  638:         else {
  639:             $result .= '<nobr><input name="back" type="button" ';
  640:             $result .= 'value="' . $previous . '" onclick="history.go(-1)" /> ';
  641:             $result .= '<input name="SUBMIT" type="submit" value="' . $next . '" /></nobr>';
  642:         }
  643:     }
  644: 
  645:     #foreach my $key (keys %{$self->{VARS}}) {
  646:     #    $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />";
  647:     #}
  648: 
  649:     $result .= "</td></tr></table>";
  650: 
  651:     $result .= <<FOOTER;
  652:               </td>
  653:             </tr>
  654:           </table>
  655:         </form>
  656: FOOTER
  657: 
  658:     $result .= &Apache::loncommon::end_page();
  659:     # Handle writing out the vars to the file
  660:     my $file = Apache::File->new('>'.$self->{FILENAME});
  661:     print $file $self->_varsInFile();
  662: 
  663:     return $result;
  664: }
  665: 
  666: 1;
  667: 
  668: package Apache::lonhelper::state;
  669: 
  670: # States bundle things together and are responsible for compositing the
  671: # various elements together. It is not generally necessary for users to
  672: # use the state object directly, so it is not perldoc'ed.
  673: 
  674: # Basically, all the states do is pass calls to the elements and aggregate
  675: # the results.
  676: 
  677: sub new {
  678:     my $proto = shift;
  679:     my $class = ref($proto) || $proto;
  680:     my $self = {};
  681: 
  682:     $self->{NAME} = shift;
  683:     $self->{TITLE} = shift;
  684:     $self->{ELEMENTS} = [];
  685: 
  686:     bless($self, $class);
  687: 
  688:     $helper->registerState($self);
  689: 
  690:     $state = $self;
  691: 
  692:     return $self;
  693: }
  694: 
  695: sub name {
  696:     my $self = shift;
  697:     return $self->{NAME};
  698: }
  699: 
  700: sub title {
  701:     my $self = shift;
  702:     return $self->{TITLE};
  703: }
  704: 
  705: sub preprocess {
  706:     my $self = shift;
  707:     for my $element (@{$self->{ELEMENTS}}) {
  708:         $element->preprocess();
  709:     }
  710: }
  711: 
  712: # FIXME: Document that all postprocesses must return a true value or
  713: # the state transition will be overridden
  714: sub postprocess {
  715:     my $self = shift;
  716: 
  717:     # Save the state so we can roll it back if we need to.
  718:     my $originalState = $helper->{STATE};
  719:     my $everythingSuccessful = 1;
  720: 
  721:     for my $element (@{$self->{ELEMENTS}}) {
  722:         my $result = $element->postprocess();
  723:         if (!$result) { $everythingSuccessful = 0; }
  724:     }
  725: 
  726:     # If not all the postprocesses were successful, override
  727:     # any state transitions that may have occurred. It is the
  728:     # responsibility of the states to make sure they have 
  729:     # error handling in that case.
  730:     if (!$everythingSuccessful) {
  731:         $helper->{STATE} = $originalState;
  732:     }
  733: }
  734: 
  735: # Override the form if any element wants to.
  736: # two elements overriding the form will make a mess, but that should
  737: # be considered helper author error ;-)
  738: sub overrideForm {
  739:     my $self = shift;
  740:     for my $element (@{$self->{ELEMENTS}}) {
  741:         if ($element->overrideForm()) {
  742:             return 1;
  743:         }
  744:     }
  745:     return 0;
  746: }
  747: 
  748: sub addElement {
  749:     my $self = shift;
  750:     my $element = shift;
  751:     
  752:     push @{$self->{ELEMENTS}}, $element;
  753: }
  754: 
  755: sub render {
  756:     my $self = shift;
  757:     my @results = ();
  758: 
  759:     for my $element (@{$self->{ELEMENTS}}) {
  760:         push @results, $element->render();
  761:     }
  762: 
  763:     return join("\n", @results);
  764: }
  765: 
  766: 1;
  767: 
  768: package Apache::lonhelper::element;
  769: # Support code for elements
  770: 
  771: =pod
  772: 
  773: =head1 Element Base Class
  774: 
  775: The Apache::lonhelper::element base class provides support for elements
  776: and defines some generally useful tags for use in elements.
  777: 
  778: =head2 finalcode tagX<finalcode>
  779: 
  780: Each element can contain a "finalcode" tag that, when the special FINAL
  781: helper state is used, will be executed, surrounded by "sub { my $helper = shift;"
  782: and "}". It is expected to return a string describing what it did, which 
  783: may be an empty string. See course initialization helper for an example. This is
  784: generally intended for helpers like the course initialization helper, which consist
  785: of several panels, each of which is performing some sort of bite-sized functionality.
  786: 
  787: =head2 defaultvalue tagX<defaultvalue>
  788: 
  789: Each element that accepts user input can contain a "defaultvalue" tag that,
  790: when surrounded by "sub { my $helper = shift; my $state = shift; " and "}",
  791: will form a subroutine that when called will provide a default value for
  792: the element. How this value is interpreted by the element is specific to
  793: the element itself, and possibly the settings the element has (such as 
  794: multichoice vs. single choice for <choices> tags). 
  795: 
  796: This is also intended for things like the course initialization wizard, where the
  797: user is setting various parameters. By correctly grabbing current settings 
  798: and including them into the helper, it allows the user to come back to the
  799: helper later and re-execute it, without needing to worry about overwriting
  800: some setting accidentally.
  801: 
  802: Again, see the course initialization helper for examples.
  803: 
  804: =head2 validator tagX<validator>
  805: 
  806: Some elements that accepts user input can contain a "validator" tag that,
  807: when surrounded by "sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift " 
  808: and "}", where "$val" is the value the user entered, will form a subroutine 
  809: that when called will verify whether the given input is valid or not. If it 
  810: is valid, the routine will return a false value. If invalid, the routine 
  811: will return an error message to be displayed for the user.
  812: 
  813: Consult the documentation for each element to see whether it supports this 
  814: tag.
  815: 
  816: =head2 getValue methodX<getValue (helper elements)>
  817: 
  818: If the element stores the name of the variable in a 'variable' member, which
  819: the provided ones all do, you can retreive the value of the variable by calling
  820: this method.
  821: 
  822: =cut
  823: 
  824: BEGIN {
  825:     &Apache::lonhelper::register('Apache::lonhelper::element',
  826:                                  ('nextstate', 'finalcode',
  827:                                   'defaultvalue', 'validator'));
  828: }
  829: 
  830: # Because we use the param hash, this is often a sufficent
  831: # constructor
  832: sub new {
  833:     my $proto = shift;
  834:     my $class = ref($proto) || $proto;
  835:     my $self = $paramHash;
  836:     bless($self, $class);
  837: 
  838:     $self->{PARAMS} = $paramHash;
  839:     $self->{STATE} = $state;
  840:     $state->addElement($self);
  841:     
  842:     # Ensure param hash is not reused
  843:     $paramHash = {};
  844: 
  845:     return $self;
  846: }   
  847: 
  848: sub start_nextstate {
  849:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  850: 
  851:     if ($target ne 'helper') {
  852:         return '';
  853:     }
  854:     
  855:     $paramHash->{NEXTSTATE} = &Apache::lonxml::get_all_text('/nextstate',
  856:                                                              $parser);
  857:     return '';
  858: }
  859: 
  860: sub end_nextstate { return ''; }
  861: 
  862: sub start_finalcode {
  863:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  864: 
  865:     if ($target ne 'helper') {
  866:         return '';
  867:     }
  868:     
  869:     $paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode',
  870:                                                              $parser);
  871:     return '';
  872: }
  873: 
  874: sub end_finalcode { return ''; }
  875: 
  876: sub start_defaultvalue {
  877:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  878: 
  879:     if ($target ne 'helper') {
  880:         return '';
  881:     }
  882:     
  883:     $paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue',
  884:                                                              $parser);
  885:     $paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' .
  886:         $paramHash->{DEFAULT_VALUE} . '}';
  887:     return '';
  888: }
  889: 
  890: sub end_defaultvalue { return ''; }
  891: 
  892: # Validators may need to take language specifications
  893: sub start_validator {
  894:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  895: 
  896:     if ($target ne 'helper') {
  897:         return '';
  898:     }
  899:     
  900:     $paramHash->{VALIDATOR} = &Apache::lonxml::get_all_text('/validator',
  901:                                                              $parser);
  902:     $paramHash->{VALIDATOR} = 'sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift;' .
  903:         $paramHash->{VALIDATOR} . '}';
  904:     return '';
  905: }
  906: 
  907: sub end_validator { return ''; }
  908: 
  909: sub preprocess {
  910:     return 1;
  911: }
  912: 
  913: sub postprocess {
  914:     return 1;
  915: }
  916: 
  917: sub render {
  918:     return '';
  919: }
  920: 
  921: sub overrideForm {
  922:     return 0;
  923: }
  924: 
  925: sub getValue {
  926:     my $self = shift;
  927:     return $helper->{VARS}->{$self->{'variable'}};
  928: }
  929: 
  930: 1;
  931: 
  932: package Apache::lonhelper::message;
  933: 
  934: =pod
  935: 
  936: =head1 Elements
  937: 
  938: =head2 Element: messageX<message, helper element>
  939: 
  940: Message elements display their contents, and
  941: transition directly to the state in the <nextstate> attribute. Example:
  942: 
  943:  <message nextstate='GET_NAME'>
  944:    This is the <b>message</b> the user will see, 
  945:                  <i>HTML allowed</i>.
  946:    </message>
  947: 
  948: This will display the HTML message and transition to the 'nextstate' if
  949: given. The HTML will be directly inserted into the helper, so if you don't
  950: want text to run together, you'll need to manually wrap the message text
  951: in <p> tags, or whatever is appropriate for your HTML.
  952: 
  953: Message tags do not add in whitespace, so if you want it, you'll need to add
  954: it into states. This is done so you can inline some elements, such as 
  955: the <date> element, right between two messages, giving the appearence that 
  956: the <date> element appears inline. (Note the elements can not be embedded
  957: within each other.)
  958: 
  959: This is also a good template for creating your own new states, as it has
  960: very little code beyond the state template.
  961: 
  962: =head3 Localization
  963: 
  964: The contents of the message tag will be run through the
  965: normalize_string function and that will be used as a call to &mt.
  966: 
  967: =cut
  968: 
  969: no strict;
  970: @ISA = ("Apache::lonhelper::element");
  971: use strict;
  972: use Apache::lonlocal;
  973: 
  974: BEGIN {
  975:     &Apache::lonhelper::register('Apache::lonhelper::message',
  976:                               ('message'));
  977: }
  978: 
  979: sub new {
  980:     my $ref = Apache::lonhelper::element->new();
  981:     bless($ref);
  982: }
  983: 
  984: # CONSTRUCTION: Construct the message element from the XML
  985: sub start_message {
  986:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  987: 
  988:     if ($target ne 'helper') {
  989:         return '';
  990:     }
  991: 
  992:     $paramHash->{MESSAGE_TEXT} = &mtn(&Apache::lonxml::get_all_text('/message',
  993:                                                                $parser));
  994: 
  995:     if (defined($token->[2]{'nextstate'})) {
  996:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
  997:     }
  998:     return '';
  999: }
 1000: 
 1001: sub end_message {
 1002:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1003: 
 1004:     if ($target ne 'helper') {
 1005:         return '';
 1006:     }
 1007:     Apache::lonhelper::message->new();
 1008:     return '';
 1009: }
 1010: 
 1011: sub render {
 1012:     my $self = shift;
 1013: 
 1014:     return &mtn($self->{MESSAGE_TEXT});
 1015: }
 1016: # If a NEXTSTATE was given, switch to it
 1017: sub postprocess {
 1018:     my $self = shift;
 1019:     if (defined($self->{NEXTSTATE})) {
 1020:         $helper->changeState($self->{NEXTSTATE});
 1021:     }
 1022: 
 1023:     return 1;
 1024: }
 1025: 1;
 1026: 
 1027: package Apache::lonhelper::choices;
 1028: 
 1029: =pod
 1030: 
 1031: =head2 Element: choicesX<choices, helper element>
 1032: 
 1033: Choice states provide a single choice to the user as a text selection box.
 1034: A "choice" is two pieces of text, one which will be displayed to the user
 1035: (the "human" value), and one which will be passed back to the program
 1036: (the "computer" value). For instance, a human may choose from a list of
 1037: resources on disk by title, while your program wants the file name.
 1038: 
 1039: <choices> takes an attribute "variable" to control which helper variable
 1040: the result is stored in.
 1041: 
 1042: <choices> takes an attribute "multichoice" which, if set to a true
 1043: value, will allow the user to select multiple choices.
 1044: 
 1045: <choices> takes an attribute "allowempty" which, if set to a true 
 1046: value, will allow the user to select none of the choices without raising
 1047: an error message.
 1048: 
 1049: =head3 SUB-TAGS
 1050: 
 1051: <choices> can have the following subtags:X<choice, helper tag>
 1052: 
 1053: =over 4
 1054: 
 1055: =item * <nextstate>state_name</nextstate>: If given, this will cause the
 1056:       choice element to transition to the given state after executing.
 1057:       This will override the <nextstate> passed to <choices> (if any).
 1058: 
 1059: =item * <choice />: If the choices are static,
 1060:       this element will allow you to specify them. Each choice
 1061:       contains  attribute, "computer", as described above. The
 1062:       content of the tag will be used as the human label.
 1063:       For example,  
 1064:       <choice computer='234-12-7312'>Bobby McDormik</choice>.
 1065: 
 1066: <choice> can take a parameter "eval", which if set to
 1067: a true value, will cause the contents of the tag to be
 1068: evaluated as it would be in an <eval> tag; see <eval> tag
 1069: below.
 1070: 
 1071: <choice> may optionally contain a 'nextstate' attribute, which
 1072: will be the state transistioned to if the choice is made, if
 1073: the choice is not multichoice. This will override the nextstate
 1074: passed to the parent C<choices> tag.
 1075: 
 1076: <choice> may optionally contain a 'relatedvalue' attribute, which
 1077: if present will cause a text entry to appear to the right of the
 1078: selection.  The value of the relatedvalue attribute is a variable
 1079: into which the text entry will be stored e.g.:
 1080: <choice computer='numberprovided" relatedvalue="num">Type the number in:</choice>
 1081: 
 1082: <choice> may contain a relatededefault atribute which, if the
 1083: relatedvalue attribute is present will be the initial value of the input
 1084: box.
 1085: 
 1086: =back
 1087: 
 1088: To create the choices programmatically, either wrap the choices in 
 1089: <condition> tags (prefered), or use an <exec> block inside the <choice>
 1090: tag. Store the choices in $state->{CHOICES}, which is a list of list
 1091: references, where each list has three strings. The first is the human
 1092: name, the second is the computer name. and the third is the option
 1093: next state. For example:
 1094: 
 1095:  <exec>
 1096:     for (my $i = 65; $i < 65 + 26; $i++) {
 1097:         push @{$state->{CHOICES}}, [chr($i), $i, 'next'];
 1098:     }
 1099:  </exec>
 1100: 
 1101: This will allow the user to select from the letters A-Z (in ASCII), while
 1102: passing the ASCII value back into the helper variables, and the state
 1103: will in all cases transition to 'next'.
 1104: 
 1105: You can mix and match methods of creating choices, as long as you always 
 1106: "push" onto the choice list, rather then wiping it out. (You can even 
 1107: remove choices programmatically, but that would probably be bad form.)
 1108: 
 1109: =head3 defaultvalue support
 1110: 
 1111: Choices supports default values both in multichoice and single choice mode.
 1112: In single choice mode, have the defaultvalue tag's function return the 
 1113: computer value of the box you want checked. If the function returns a value
 1114: that does not correspond to any of the choices, the default behavior of selecting
 1115: the first choice will be preserved.
 1116: 
 1117: For multichoice, return a string with the computer values you want checked,
 1118: delimited by triple pipes. Note this matches how the result of the <choices>
 1119: tag is stored in the {VARS} hash.
 1120: 
 1121: =cut
 1122: 
 1123: no strict;
 1124: @ISA = ("Apache::lonhelper::element");
 1125: use strict;
 1126: use Apache::lonlocal;
 1127: use Apache::lonnet;
 1128: 
 1129: BEGIN {
 1130:     &Apache::lonhelper::register('Apache::lonhelper::choices',
 1131:                               ('choice', 'choices'));
 1132: }
 1133: 
 1134: sub new {
 1135:     my $ref = Apache::lonhelper::element->new();
 1136:     bless($ref);
 1137: }
 1138: 
 1139: # CONSTRUCTION: Construct the message element from the XML
 1140: sub start_choices {
 1141:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1142: 
 1143:     if ($target ne 'helper') {
 1144:         return '';
 1145:     }
 1146: 
 1147:     # Need to initialize the choices list, so everything can assume it exists
 1148:     $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'}));
 1149:     $helper->declareVar($paramHash->{'variable'});
 1150:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1151:     $paramHash->{'allowempty'} = $token->[2]{'allowempty'};
 1152:     $paramHash->{CHOICES} = [];
 1153:     return '';
 1154: }
 1155: 
 1156: sub end_choices {
 1157:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1158: 
 1159:     if ($target ne 'helper') {
 1160:         return '';
 1161:     }
 1162:     Apache::lonhelper::choices->new();
 1163:     return '';
 1164: }
 1165: 
 1166: sub start_choice {
 1167:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1168: 
 1169:     if ($target ne 'helper') {
 1170:         return '';
 1171:     }
 1172: 
 1173:     my $computer = $token->[2]{'computer'};
 1174:     my $human = &mt(&Apache::lonxml::get_all_text('/choice',
 1175:                                               $parser));
 1176:     my $nextstate  = $token->[2]{'nextstate'};
 1177:     my $evalFlag   = $token->[2]{'eval'};
 1178:     my $relatedVar = $token->[2]{'relatedvalue'}; 
 1179:     my $relatedDefault = $token->[2]{'relateddefault'};
 1180:     push @{$paramHash->{CHOICES}}, [&mtn($human), $computer, $nextstate, 
 1181:                                     $evalFlag, $relatedVar, $relatedDefault];
 1182:     return '';
 1183: }
 1184: 
 1185: sub end_choice {
 1186:     return '';
 1187: }
 1188: 
 1189: {
 1190:     # used to generate unique id attributes for <input> tags. 
 1191:     # internal use only.
 1192:     my $id = 0;
 1193:     sub new_id { return $id++; }
 1194: }
 1195: 
 1196: sub render {
 1197:     my $self = shift;
 1198:     my $var = $self->{'variable'};
 1199:     my $buttons = '';
 1200:     my $result = '';
 1201: 
 1202:     if ($self->{'multichoice'}) {
 1203:         $result .= <<SCRIPT;
 1204: <script type="text/javascript">
 1205: // <!--
 1206:     function checkall(value, checkName) {
 1207: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 1208:             ele = document.forms.helpform.elements[i];
 1209:             if (ele.name == checkName + '.forminput') {
 1210:                 document.forms.helpform.elements[i].checked=value;
 1211:             }
 1212:         }
 1213:     }
 1214: // -->
 1215: </script>
 1216: SCRIPT
 1217:     }
 1218: 
 1219:     # Only print "select all" and "unselect all" if there are five or
 1220:     # more choices; fewer then that and it looks silly.
 1221:     if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) {
 1222:         my %lt=&Apache::lonlocal::texthash(
 1223: 			'sa'  => "Select All",
 1224: 		        'ua'  => "Unselect All");
 1225:         $buttons = <<BUTTONS;
 1226: <br />
 1227: <input type="button" onclick="checkall(true, '$var')" value="$lt{'sa'}" />
 1228: <input type="button" onclick="checkall(false, '$var')" value="$lt{'ua'}" />
 1229: <br />&nbsp;
 1230: BUTTONS
 1231:     }
 1232: 
 1233:     if (defined $self->{ERROR_MSG}) {
 1234:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />';
 1235:     }
 1236: 
 1237:     $result .= $buttons;
 1238:     
 1239:     $result .= "<table>\n\n";
 1240: 
 1241:     my %checkedChoices;
 1242:     my $checkedChoicesFunc;
 1243: 
 1244:     if (defined($self->{DEFAULT_VALUE})) {
 1245:         $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE});
 1246:         die 'Error in default value code for variable ' . 
 1247:             $self->{'variable'} . ', Perl said: ' . $@ if $@;
 1248:     } else {
 1249:         $checkedChoicesFunc = sub { return ''; };
 1250:     }
 1251: 
 1252:     # Process which choices should be checked.
 1253:     if ($self->{'multichoice'}) {
 1254:         for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) {
 1255:             $checkedChoices{$selectedChoice} = 1;
 1256:         }
 1257:     } else {
 1258:         # single choice
 1259:         my $selectedChoice = &$checkedChoicesFunc($helper, $self);
 1260:         
 1261:         my $foundChoice = 0;
 1262:         
 1263:         # check that the choice is in the list of choices.
 1264:         for my $choice (@{$self->{CHOICES}}) {
 1265:             if ($choice->[1] eq $selectedChoice) {
 1266:                 $checkedChoices{$choice->[1]} = 1;
 1267:                 $foundChoice = 1;
 1268:             }
 1269:         }
 1270:         
 1271:         # If we couldn't find the choice, pick the first one 
 1272:         if (!$foundChoice) {
 1273:             $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1;
 1274:         }
 1275:     }
 1276: 
 1277:     my $type = "radio";
 1278:     if ($self->{'multichoice'}) { $type = 'checkbox'; }
 1279:     foreach my $choice (@{$self->{CHOICES}}) {
 1280:         my $id = &new_id();
 1281:         $result .= "<tr>\n<td width='20'>&nbsp;</td>\n";
 1282:         $result .= "<td valign='top'><input type='$type' name='$var.forminput'"
 1283:             . " value='" . 
 1284:             HTML::Entities::encode($choice->[1],"<>&\"'") 
 1285:             . "'";
 1286:         if ($checkedChoices{$choice->[1]}) {
 1287:             $result .= " checked='checked' ";
 1288:         }
 1289:         $result .= qq{id="id$id"};
 1290:         my $choiceLabel = $choice->[0];
 1291:         if ($choice->[3]) {  # if we need to evaluate this choice
 1292:             $choiceLabel = "sub { my $helper = shift; my $state = shift;" .
 1293:                 $choiceLabel . "}";
 1294:             $choiceLabel = eval($choiceLabel);
 1295:             $choiceLabel = &$choiceLabel($helper, $self);
 1296:         }
 1297:         $result .= "/></td><td> ".qq{<label for="id$id">}.
 1298:             $choiceLabel. "</label></td>";
 1299: 	if ($choice->[4]) {
 1300: 	    $result .='<td><input type="text" size="5" name="'
 1301: 		.$choice->[4].'.forminput" value="'
 1302:                 .$choice->[5].'" /></td>';
 1303: 	}
 1304: 	$result .= "</tr>\n";
 1305:     }
 1306:     $result .= "</table>\n\n\n";
 1307:     $result .= $buttons;
 1308: 
 1309:     return $result;
 1310: }
 1311: 
 1312: # If a NEXTSTATE was given or a nextstate for this choice was
 1313: # given, switch to it
 1314: sub postprocess {
 1315:     my $self = shift;
 1316:     my $chosenValue = $env{'form.' . $self->{'variable'} . '.forminput'};
 1317: 
 1318:     if (!defined($chosenValue) && !$self->{'allowempty'}) {
 1319:         $self->{ERROR_MSG} = 
 1320: 	    &mt("You must choose one or more choices to continue.");
 1321:         return 0;
 1322:     }
 1323: 
 1324:     if (ref($chosenValue)) {
 1325:         $helper->{VARS}->{$self->{'variable'}} = join('|||', @$chosenValue);
 1326:     }
 1327: 
 1328:     if (defined($self->{NEXTSTATE})) {
 1329:         $helper->changeState($self->{NEXTSTATE});
 1330:     }
 1331:     
 1332:     foreach my $choice (@{$self->{CHOICES}}) {
 1333:         if ($choice->[1] eq $chosenValue) {
 1334:             if (defined($choice->[2])) {
 1335:                 $helper->changeState($choice->[2]);
 1336:             }
 1337:         }
 1338: 	if ($choice->[4]) {
 1339: 	    my $varname = $choice->[4];
 1340: 	    $helper->{'VARS'}->{$varname} = $env{'form.'."$varname.forminput"};
 1341: 	}
 1342:     }
 1343:     return 1;
 1344: }
 1345: 1;
 1346: 
 1347: package Apache::lonhelper::dropdown;
 1348: 
 1349: =pod
 1350: 
 1351: =head2 Element: dropdownX<dropdown, helper tag>
 1352: 
 1353: A drop-down provides a drop-down box instead of a radio button
 1354: box. Because most people do not know how to use a multi-select
 1355: drop-down box, that option is not allowed. Otherwise, the arguments
 1356: are the same as "choices", except "allowempty" is also meaningless.
 1357: 
 1358: <dropdown> takes an attribute "variable" to control which helper variable
 1359: the result is stored in.
 1360: 
 1361: =head3 SUB-TAGS
 1362: 
 1363: <choice>, which acts just as it does in the "choices" element.
 1364: 
 1365: =cut
 1366: 
 1367: # This really ought to be a sibling class to "choice" which is itself
 1368: # a child of some abstract class.... *shrug*
 1369: 
 1370: no strict;
 1371: @ISA = ("Apache::lonhelper::element");
 1372: use strict;
 1373: use Apache::lonlocal;
 1374: use Apache::lonnet;
 1375: 
 1376: BEGIN {
 1377:     &Apache::lonhelper::register('Apache::lonhelper::dropdown',
 1378:                               ('dropdown'));
 1379: }
 1380: 
 1381: sub new {
 1382:     my $ref = Apache::lonhelper::element->new();
 1383:     bless($ref);
 1384: }
 1385: 
 1386: # CONSTRUCTION: Construct the message element from the XML
 1387: sub start_dropdown {
 1388:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1389: 
 1390:     if ($target ne 'helper') {
 1391:         return '';
 1392:     }
 1393: 
 1394:     # Need to initialize the choices list, so everything can assume it exists
 1395:     $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'}));
 1396:     $helper->declareVar($paramHash->{'variable'});
 1397:     $paramHash->{CHOICES} = [];
 1398:     return '';
 1399: }
 1400: 
 1401: sub end_dropdown {
 1402:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1403: 
 1404:     if ($target ne 'helper') {
 1405:         return '';
 1406:     }
 1407:     Apache::lonhelper::dropdown->new();
 1408:     return '';
 1409: }
 1410: 
 1411: sub render {
 1412:     my $self = shift;
 1413:     my $var = $self->{'variable'};
 1414:     my $result = '';
 1415: 
 1416:     if (defined $self->{ERROR_MSG}) {
 1417:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />';
 1418:     }
 1419: 
 1420:     my %checkedChoices;
 1421:     my $checkedChoicesFunc;
 1422: 
 1423:     if (defined($self->{DEFAULT_VALUE})) {
 1424:         $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE});
 1425:         die 'Error in default value code for variable ' . 
 1426:             $self->{'variable'} . ', Perl said: ' . $@ if $@;
 1427:     } else {
 1428:         $checkedChoicesFunc = sub { return ''; };
 1429:     }
 1430: 
 1431:     # single choice
 1432:     my $selectedChoice = &$checkedChoicesFunc($helper, $self);
 1433:     
 1434:     my $foundChoice = 0;
 1435:     
 1436:     # check that the choice is in the list of choices.
 1437:     for my $choice (@{$self->{CHOICES}}) {
 1438: 	if ($choice->[1] eq $selectedChoice) {
 1439: 	    $checkedChoices{$choice->[1]} = 1;
 1440: 	    $foundChoice = 1;
 1441: 	}
 1442:     }
 1443:     
 1444:     # If we couldn't find the choice, pick the first one 
 1445:     if (!$foundChoice) {
 1446: 	$checkedChoices{$self->{CHOICES}->[0]->[1]} = 1;
 1447:     }
 1448: 
 1449:     $result .= "<select name='${var}.forminput'>\n";
 1450:     foreach my $choice (@{$self->{CHOICES}}) {
 1451:         $result .= "<option value='" . 
 1452:             HTML::Entities::encode($choice->[1],"<>&\"'") 
 1453:             . "'";
 1454:         if ($checkedChoices{$choice->[1]}) {
 1455:             $result .= " selected='selected' ";
 1456:         }
 1457:         my $choiceLabel = $choice->[0];
 1458:         if ($choice->[4]) {  # if we need to evaluate this choice
 1459:             $choiceLabel = "sub { my $helper = shift; my $state = shift;" .
 1460:                 $choiceLabel . "}";
 1461:             $choiceLabel = eval($choiceLabel);
 1462:             $choiceLabel = &$choiceLabel($helper, $self);
 1463:         }
 1464:         $result .= ">" . &mtn($choiceLabel) . "</option>\n";
 1465:     }
 1466:     $result .= "</select>\n";
 1467: 
 1468:     return $result;
 1469: }
 1470: 
 1471: # If a NEXTSTATE was given or a nextstate for this choice was
 1472: # given, switch to it
 1473: sub postprocess {
 1474:     my $self = shift;
 1475:     my $chosenValue = $env{'form.' . $self->{'variable'} . '.forminput'};
 1476: 
 1477:     if (!defined($chosenValue) && !$self->{'allowempty'}) {
 1478:         $self->{ERROR_MSG} = "You must choose one or more choices to" .
 1479:             " continue.";
 1480:         return 0;
 1481:     }
 1482: 
 1483:     if (defined($self->{NEXTSTATE})) {
 1484:         $helper->changeState($self->{NEXTSTATE});
 1485:     }
 1486:     
 1487:     foreach my $choice (@{$self->{CHOICES}}) {
 1488:         if ($choice->[1] eq $chosenValue) {
 1489:             if (defined($choice->[2])) {
 1490:                 $helper->changeState($choice->[2]);
 1491:             }
 1492:         }
 1493:     }
 1494:     return 1;
 1495: }
 1496: 1;
 1497: 
 1498: package Apache::lonhelper::date;
 1499: 
 1500: =pod
 1501: 
 1502: =head2 Element: dateX<date, helper element>
 1503: 
 1504: Date elements allow the selection of a date with a drop down list.
 1505: 
 1506: Date elements can take two attributes:
 1507: 
 1508: =over 4
 1509: 
 1510: =item * B<variable>: The name of the variable to store the chosen
 1511:         date in. Required.
 1512: 
 1513: =item * B<hoursminutes>: If a true value, the date will show hours
 1514:         and minutes, as well as month/day/year. If false or missing,
 1515:         the date will only show the month, day, and year.
 1516: 
 1517: =back
 1518: 
 1519: Date elements contain only an option <nextstate> tag to determine
 1520: the next state.
 1521: 
 1522: Example:
 1523: 
 1524:  <date variable="DUE_DATE" hoursminutes="1">
 1525:    <nextstate>choose_why</nextstate>
 1526:    </date>
 1527: 
 1528: =cut
 1529: 
 1530: no strict;
 1531: @ISA = ("Apache::lonhelper::element");
 1532: use strict;
 1533: use Apache::lonlocal; # A localization nightmare
 1534: use Apache::lonnet;
 1535: use Time::localtime;
 1536: 
 1537: BEGIN {
 1538:     &Apache::lonhelper::register('Apache::lonhelper::date',
 1539:                               ('date'));
 1540: }
 1541: 
 1542: # Don't need to override the "new" from element
 1543: sub new {
 1544:     my $ref = Apache::lonhelper::element->new();
 1545:     bless($ref);
 1546: }
 1547: 
 1548: my @months = ("January", "February", "March", "April", "May", "June", "July",
 1549: 	      "August", "September", "October", "November", "December");
 1550: 
 1551: # CONSTRUCTION: Construct the message element from the XML
 1552: sub start_date {
 1553:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1554: 
 1555:     if ($target ne 'helper') {
 1556:         return '';
 1557:     }
 1558: 
 1559:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1560:     $helper->declareVar($paramHash->{'variable'});
 1561:     $paramHash->{'hoursminutes'} = $token->[2]{'hoursminutes'};
 1562:     $paramHash->{'anytime'} = $token->[2]{'anytime'};
 1563: }
 1564: 
 1565: sub end_date {
 1566:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1567: 
 1568:     if ($target ne 'helper') {
 1569:         return '';
 1570:     }
 1571:     Apache::lonhelper::date->new();
 1572:     return '';
 1573: }
 1574: 
 1575: sub render {
 1576:     my $self = shift;
 1577:     my $result = "";
 1578:     my $var = $self->{'variable'};
 1579: 
 1580:     my $date;
 1581: 
 1582:     my $time=time;
 1583:     my ($anytime,$onclick);
 1584: 
 1585: 
 1586:     # first check VARS for a valid new value from the user
 1587:     # then check DEFAULT_VALUE for a valid default time value
 1588:     # otherwise pick now as reasonably good time
 1589: 
 1590:     if (defined($helper->{VARS}{$var})
 1591: 	&&  $helper->{VARS}{$var} > 0) {
 1592: 	$date = localtime($helper->{VARS}{$var});
 1593:     } elsif (defined($self->{DEFAULT_VALUE})) {
 1594:         my $valueFunc = eval($self->{DEFAULT_VALUE});
 1595:         die('Error in default value code for variable ' . 
 1596:             $self->{'variable'} . ', Perl said: ' . $@) if $@;
 1597:         $time = &$valueFunc($helper, $self);
 1598: 	if (lc($time) eq 'anytime') {
 1599: 	    $anytime=1;
 1600: 	    $date = localtime(time);
 1601: 	    $date->min(0);
 1602: 	} elsif (defined($time) && $time ne 0) {
 1603: 	    $date = localtime($time);
 1604: 	} else {
 1605: 	    # leave date undefined so it'll default to now
 1606: 	}
 1607:     }
 1608: 
 1609:     if (!defined($date)) {
 1610: 	$date = localtime(time);
 1611: 	$date->min(0);
 1612:     }
 1613: 
 1614:     &Apache::lonnet::logthis("date mode ");
 1615: 
 1616:     if ($anytime) {
 1617: 	$onclick = "onclick=\"javascript:updateCheck(this.form,'${var}anytime',false)\"";
 1618:     }
 1619:     # Default date: The current hour.
 1620: 
 1621:     if (defined $self->{ERROR_MSG}) {
 1622:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 1623:     }
 1624: 
 1625:     # Month
 1626:     my $i;
 1627:     $result .= "<select $onclick name='${var}month'>\n";
 1628:     for ($i = 0; $i < 12; $i++) {
 1629:         if ($i == $date->mon) {
 1630:             $result .= "<option value='$i' selected='selected'>";
 1631:         } else {
 1632:             $result .= "<option value='$i'>";
 1633:         }
 1634:         $result .= &mt($months[$i]) . "</option>\n";
 1635:     }
 1636:     $result .= "</select>\n";
 1637: 
 1638:     # Day
 1639:     $result .= "<select $onclick name='${var}day'>\n";
 1640:     for ($i = 1; $i < 32; $i++) {
 1641:         if ($i == $date->mday) {
 1642:             $result .= '<option selected="selected">';
 1643:         } else {
 1644:             $result .= '<option>';
 1645:         }
 1646:         $result .= "$i</option>\n";
 1647:     }
 1648:     $result .= "</select>,\n";
 1649: 
 1650:     # Year
 1651:     $result .= "<select $onclick name='${var}year'>\n";
 1652:     for ($i = 2000; $i < 2030; $i++) { # update this after 64-bit dates
 1653:         if ($date->year + 1900 == $i) {
 1654:             $result .= "<option selected='selected'>";
 1655:         } else {
 1656:             $result .= "<option>";
 1657:         }
 1658:         $result .= "$i</option>\n";
 1659:     }
 1660:     $result .= "</select>,\n";
 1661: 
 1662:     # Display Hours and Minutes if they are called for
 1663:     if ($self->{'hoursminutes'}) {
 1664: 	# This needs parameterization for times.
 1665: 	my $am = &mt('a.m.');
 1666: 	my $pm = &mt('p.m.');
 1667:         # Build hour
 1668:         $result .= "<select $onclick name='${var}hour'>\n";
 1669:         $result .= "<option " . ($date->hour == 0 ? 'selected="selected" ':'') .
 1670:             " value='0'>" . &mt('midnight') . "</option>\n";
 1671:         for ($i = 1; $i < 12; $i++) {
 1672:             if ($date->hour == $i) {
 1673:                 $result .= "<option selected='selected' value='$i'>$i $am</option>\n";
 1674:             } else {
 1675:                 $result .= "<option value='$i'>$i $am</option>\n";
 1676:             }
 1677:         }
 1678:         $result .= "<option " . ($date->hour == 12 ? 'selected="selected" ':'') .
 1679:             " value='12'>" . &mt('noon') . "</option>\n";
 1680:         for ($i = 13; $i < 24; $i++) {
 1681:             my $printedHour = $i - 12;
 1682:             if ($date->hour == $i) {
 1683:                 $result .= "<option selected='selected' value='$i'>$printedHour $pm</option>\n";
 1684:             } else {
 1685:                 $result .= "<option value='$i'>$printedHour $pm</option>\n";
 1686:             }
 1687:         }
 1688: 
 1689:         $result .= "</select> :\n";
 1690: 
 1691:         $result .= "<select $onclick name='${var}minute'>\n";
 1692: 	my $selected=0;
 1693:         for my $i ((0,15,30,45,59,undef,0..59)) {
 1694:             my $printedMinute = $i;
 1695:             if (defined($i) && $i < 10) {
 1696:                 $printedMinute = "0" . $printedMinute;
 1697:             }
 1698:             if (!$selected && $date->min == $i) {
 1699:                 $result .= "<option selected='selected'>";
 1700: 		$selected=1;
 1701:             } else {
 1702:                 $result .= "<option>";
 1703:             }
 1704:             $result .= "$printedMinute</option>\n";
 1705:         }
 1706:         $result .= "</select>\n";
 1707:     }
 1708:     if ($self->{'anytime'}) {
 1709: 	$result.=(<<CHECK);
 1710: <script type="text/javascript">
 1711: // <!--
 1712:     function updateCheck(form,name,value) {
 1713: 	var checkbox=form[name];
 1714: 	checkbox.checked = value;
 1715:     }
 1716: // -->
 1717: </script>
 1718: CHECK
 1719: 	$result.="&nbsp;or&nbsp;<label><input type='checkbox' ";
 1720: 	if ($anytime) {
 1721: 	    $result.=' checked="checked" '
 1722: 	}
 1723: 	$result.="name='${var}anytime'/>".&mt('Any time').'</label>'
 1724:     }
 1725:     return $result;
 1726: 
 1727: }
 1728: # If a NEXTSTATE was given, switch to it
 1729: sub postprocess {
 1730:     my $self = shift;
 1731:     my $var = $self->{'variable'};
 1732:     if ($env{'form.' . $var . 'anytime'}) {
 1733: 	$helper->{VARS}->{$var} = undef;
 1734:     } else {
 1735: 	my $month = $env{'form.' . $var . 'month'}; 
 1736: 	my $day = $env{'form.' . $var . 'day'}; 
 1737: 	my $year = $env{'form.' . $var . 'year'}; 
 1738: 	my $min = 0; 
 1739: 	my $hour = 0;
 1740: 	if ($self->{'hoursminutes'}) {
 1741: 	    $min = $env{'form.' . $var . 'minute'};
 1742: 	    $hour = $env{'form.' . $var . 'hour'};
 1743: 	}
 1744: 
 1745: 	my $chosenDate;
 1746: 	eval {$chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year);};
 1747: 	my $error = $@;
 1748: 
 1749: 	# Check to make sure that the date was not automatically co-erced into a 
 1750: 	# valid date, as we want to flag that as an error
 1751: 	# This happens for "Feb. 31", for instance, which is coerced to March 2 or
 1752: 	# 3, depending on if it's a leap year
 1753: 	my $checkDate = localtime($chosenDate);
 1754: 	
 1755: 	if ($error || $checkDate->mon != $month || $checkDate->mday != $day ||
 1756: 	    $checkDate->year + 1900 != $year) {
 1757: 	    unless (Apache::lonlocal::current_language()== ~/^en/) {
 1758: 		$self->{ERROR_MSG} = &mt("Invalid date entry");
 1759: 		return 0;
 1760: 	    }
 1761: 	    # LOCALIZATION FIXME: Needs to be parameterized
 1762: 	    $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a "
 1763: 		. "date because it doesn't exist. Please enter a valid date.";
 1764: 
 1765: 	    return 0;
 1766: 	}
 1767: 	$helper->{VARS}->{$var} = $chosenDate;
 1768:     }
 1769: 
 1770:     if (defined($self->{VALIDATOR})) {
 1771: 	my $validator = eval($self->{VALIDATOR});
 1772: 	die 'Died during evaluation of validator code; Perl said: ' . $@ if $@;
 1773: 	my $invalid = &$validator($helper, $state, $self, $self->getValue());
 1774: 	if ($invalid) {
 1775: 	    $self->{ERROR_MSG} = $invalid;
 1776: 	    return 0;
 1777: 	}
 1778:     }
 1779: 
 1780:     if (defined($self->{NEXTSTATE})) {
 1781:         $helper->changeState($self->{NEXTSTATE});
 1782:     }
 1783: 
 1784:     return 1;
 1785: }
 1786: 1;
 1787: 
 1788: package Apache::lonhelper::resource;
 1789: 
 1790: =pod
 1791: 
 1792: =head2 Element: resourceX<resource, helper element>
 1793: 
 1794: <resource> elements allow the user to select one or multiple resources
 1795: from the current course. You can filter out which resources they can view,
 1796: and filter out which resources they can select. The course will always
 1797: be displayed fully expanded, because of the difficulty of maintaining
 1798: selections across folder openings and closings. If this is fixed, then
 1799: the user can manipulate the folders.
 1800: 
 1801: <resource> takes the standard variable attribute to control what helper
 1802: variable stores the results. It also takes a "multichoice"X<multichoice> attribute,
 1803: which controls whether the user can select more then one resource. The 
 1804: "toponly" attribute controls whether the resource display shows just the
 1805: resources in that sequence, or recurses into all sub-sequences, defaulting
 1806: to false. The "suppressEmptySequences" attribute reflects the 
 1807: suppressEmptySequences argument to the render routine, which will cause
 1808: folders that have all of their contained resources filtered out to also
 1809: be filtered out. The 'addstatus' attribute, if true, will add the icon
 1810: and long status display columns to the display. The 'addparts'
 1811: attribute will add in a part selector beside problems that have more
 1812: than 1 part.
 1813: 
 1814: =head3 SUB-TAGS
 1815: 
 1816: =over 4
 1817: 
 1818: =item * <filterfunc>X<filterfunc>: If you want to filter what resources are displayed
 1819:   to the user, use a filter func. The <filterfunc> tag should contain
 1820:   Perl code that when wrapped with "sub { my $res = shift; " and "}" is 
 1821:   a function that returns true if the resource should be displayed, 
 1822:   and false if it should be skipped. $res is a resource object. 
 1823:   (See Apache::lonnavmaps documentation for information about the 
 1824:   resource object.)
 1825: 
 1826: =item * <choicefunc>X<choicefunc>: Same as <filterfunc>, except that controls whether
 1827:   the given resource can be chosen. (It is almost always a good idea to
 1828:   show the user the folders, for instance, but you do not always want to 
 1829:   let the user select them.)
 1830: 
 1831: =item * <nextstate>: Standard nextstate behavior.
 1832: 
 1833: =item * <valuefunc>X<valuefunc>: This function controls what is returned by the resource
 1834:   when the user selects it. Like filterfunc and choicefunc, it should be
 1835:   a function fragment that when wrapped by "sub { my $res = shift; " and
 1836:   "}" returns a string representing what you want to have as the value. By
 1837:   default, the value will be the resource ID of the object ($res->{ID}).
 1838: 
 1839: =item * <mapurl>X<mapurl>: If the URL of a map is given here, only that map
 1840:   will be displayed, instead of the whole course. If the attribute
 1841:   "evaluate" is given and is true, the contents of the mapurl will be
 1842:   evaluated with "sub { my $helper = shift; my $state = shift;" and
 1843:   "}", with the return value used as the mapurl.
 1844: 
 1845: =back
 1846: 
 1847: =cut
 1848: 
 1849: no strict;
 1850: @ISA = ("Apache::lonhelper::element");
 1851: use strict;
 1852: use Apache::lonnet;
 1853: 
 1854: BEGIN {
 1855:     &Apache::lonhelper::register('Apache::lonhelper::resource',
 1856:                               ('resource', 'filterfunc', 
 1857:                                'choicefunc', 'valuefunc',
 1858:                                'mapurl','option'));
 1859: }
 1860: 
 1861: sub new {
 1862:     my $ref = Apache::lonhelper::element->new();
 1863:     bless($ref);
 1864: }
 1865: 
 1866: # CONSTRUCTION: Construct the message element from the XML
 1867: sub start_resource {
 1868:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1869: 
 1870:     if ($target ne 'helper') {
 1871:         return '';
 1872:     }
 1873: 
 1874:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1875:     $helper->declareVar($paramHash->{'variable'});
 1876:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1877:     $paramHash->{'suppressEmptySequences'} = $token->[2]{'suppressEmptySequences'};
 1878:     $paramHash->{'toponly'} = $token->[2]{'toponly'};
 1879:     $paramHash->{'addstatus'} = $token->[2]{'addstatus'};
 1880:     $paramHash->{'addparts'} = $token->[2]{'addparts'};
 1881:     if ($paramHash->{'addparts'}) {
 1882: 	$helper->declareVar($paramHash->{'variable'}.'_part');
 1883:     }
 1884:     $paramHash->{'closeallpages'} = $token->[2]{'closeallpages'};
 1885:     return '';
 1886: }
 1887: 
 1888: sub end_resource {
 1889:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1890: 
 1891:     if ($target ne 'helper') {
 1892:         return '';
 1893:     }
 1894:     if (!defined($paramHash->{FILTER_FUNC})) {
 1895:         $paramHash->{FILTER_FUNC} = sub {return 1;};
 1896:     }
 1897:     if (!defined($paramHash->{CHOICE_FUNC})) {
 1898:         $paramHash->{CHOICE_FUNC} = sub {return 1;};
 1899:     }
 1900:     if (!defined($paramHash->{VALUE_FUNC})) {
 1901:         $paramHash->{VALUE_FUNC} = sub {my $res = shift; return $res->{ID}; };
 1902:     }
 1903:     Apache::lonhelper::resource->new();
 1904:     return '';
 1905: }
 1906: 
 1907: sub start_filterfunc {
 1908:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1909: 
 1910:     if ($target ne 'helper') {
 1911:         return '';
 1912:     }
 1913: 
 1914:     my $contents = Apache::lonxml::get_all_text('/filterfunc',
 1915:                                                 $parser);
 1916:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1917:     $paramHash->{FILTER_FUNC} = eval $contents;
 1918: }
 1919: 
 1920: sub end_filterfunc { return ''; }
 1921: 
 1922: sub start_choicefunc {
 1923:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1924: 
 1925:     if ($target ne 'helper') {
 1926:         return '';
 1927:     }
 1928: 
 1929:     my $contents = Apache::lonxml::get_all_text('/choicefunc',
 1930:                                                 $parser);
 1931:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1932:     $paramHash->{CHOICE_FUNC} = eval $contents;
 1933: }
 1934: 
 1935: sub end_choicefunc { return ''; }
 1936: 
 1937: sub start_valuefunc {
 1938:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1939: 
 1940:     if ($target ne 'helper') {
 1941:         return '';
 1942:     }
 1943: 
 1944:     my $contents = Apache::lonxml::get_all_text('/valuefunc',
 1945:                                                 $parser);
 1946:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1947:     $paramHash->{VALUE_FUNC} = eval $contents;
 1948: }
 1949: 
 1950: sub end_valuefunc { return ''; }
 1951: 
 1952: sub start_mapurl {
 1953:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1954: 
 1955:     if ($target ne 'helper') {
 1956:         return '';
 1957:     }
 1958: 
 1959:     my $contents = Apache::lonxml::get_all_text('/mapurl',
 1960:                                                 $parser);
 1961:     $paramHash->{EVAL_MAP_URL} = $token->[2]{'evaluate'};
 1962:     $paramHash->{MAP_URL} = $contents;
 1963: }
 1964: 
 1965: sub end_mapurl { return ''; }
 1966: 
 1967: 
 1968: sub start_option {
 1969:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1970:     if (!defined($paramHash->{OPTION_TEXTS})) {
 1971: 	$paramHash->{OPTION_TEXTS} = [ ];
 1972: 	$paramHash->{OPTION_VARS}  = [ ];
 1973: 
 1974:     }
 1975:     # OPTION_TEXTS is a list of the text attribute
 1976:     #               values used to create column headings.
 1977:     # OPTION_VARS is a list of the variable names, used to create the checkbox
 1978:     #             inputs.
 1979:     #  We're ok with empty elements. as place holders
 1980:     # Although the 'variable' element should really exist.
 1981:     #
 1982: 
 1983:     my $option_texts  = $paramHash->{OPTION_TEXTS};
 1984:     my $option_vars   = $paramHash->{OPTION_VARS};
 1985:     push(@$option_texts,  $token->[2]{'text'});
 1986:     push(@$option_vars,   $token->[2]{'variable'});
 1987: 
 1988:     #  Need to create and declare the option variables as well to make them
 1989:     # persistent.
 1990:     #
 1991:     my $varname = $token->[2]{'variable'};
 1992:     $helper->declareVar($varname);
 1993: 
 1994: 
 1995:     return '';
 1996: }
 1997: 
 1998: sub end_option {
 1999:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2000:     return '';
 2001: }
 2002: 
 2003: # A note, in case I don't get to this before I leave.
 2004: # If someone complains about the "Back" button returning them
 2005: # to the previous folder state, instead of returning them to
 2006: # the previous helper state, the *correct* answer is for the helper
 2007: # to keep track of how many times the user has manipulated the folders,
 2008: # and feed that to the history.go() call in the helper rendering routines.
 2009: # If done correctly, the helper itself can keep track of how many times
 2010: # it renders the same states, so it doesn't go in just this state, and
 2011: # you can lean on the browser back button to make sure it all chains
 2012: # correctly.
 2013: # Right now, though, I'm just forcing all folders open.
 2014: 
 2015: sub render {
 2016:     my $self = shift;
 2017:     my $result = "";
 2018:     my $var = $self->{'variable'};
 2019:     my $curVal = $helper->{VARS}->{$var};
 2020: 
 2021:     my $buttons = '';
 2022: 
 2023:     if ($self->{'multichoice'}) {
 2024:         $result = <<SCRIPT;
 2025: <script type="text/javascript">
 2026: // <!--
 2027:     function checkall(value, checkName) {
 2028: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 2029:             ele = document.forms.helpform.elements[i];
 2030:             if (ele.name == checkName + '.forminput') {
 2031:                 document.forms.helpform.elements[i].checked=value;
 2032:             }
 2033:         }
 2034:     }
 2035: // -->
 2036: </script>
 2037: SCRIPT
 2038:         my %lt=&Apache::lonlocal::texthash(
 2039: 			'sar'  => "Select All Resources",
 2040: 		        'uar'  => "Unselect All Resources");
 2041: 
 2042:         $buttons = <<BUTTONS;
 2043: <br /> &nbsp;
 2044: <input type="button" onclick="checkall(true, '$var')" value="$lt{'sar'}" />
 2045: <input type="button" onclick="checkall(false, '$var')" value="$lt{'uar'}" />
 2046: <br /> &nbsp;
 2047: BUTTONS
 2048:     }
 2049: 
 2050:     if (defined $self->{ERROR_MSG}) {
 2051:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 2052:     }
 2053: 
 2054:     $result .= $buttons;
 2055: 
 2056:     my $filterFunc     = $self->{FILTER_FUNC};
 2057:     my $choiceFunc     = $self->{CHOICE_FUNC};
 2058:     my $valueFunc      = $self->{VALUE_FUNC};
 2059:     my $multichoice    = $self->{'multichoice'};
 2060:     my $option_vars    = $self->{OPTION_VARS};
 2061:     my $option_texts   = $self->{OPTION_TEXTS};
 2062:     my $addparts       = $self->{'addparts'};
 2063:     my $headings_done  = 0;
 2064: 
 2065:     # Evaluate the map url as needed
 2066:     my $mapUrl;
 2067:     if ($self->{EVAL_MAP_URL}) {
 2068: 	my $mapUrlFunc = eval('sub { my $helper = shift; my $state = shift; ' . 
 2069: 	    $self->{MAP_URL} . '}');
 2070: 	$mapUrl = &$mapUrlFunc($helper, $self);
 2071:     } else {
 2072: 	$mapUrl = $self->{MAP_URL};
 2073:     }
 2074: 
 2075:     my %defaultSymbs;
 2076:     if (defined($self->{DEFAULT_VALUE})) {
 2077:         my $valueFunc = eval($self->{DEFAULT_VALUE});
 2078:         die 'Error in default value code for variable ' . 
 2079:             $self->{'variable'} . ', Perl said: ' . $@ if $@;
 2080:         my @defaultSymbs = &$valueFunc($helper, $self);
 2081: 	if (!$multichoice && @defaultSymbs) { # only allowed 1
 2082: 	    @defaultSymbs = ($defaultSymbs[0]);
 2083: 	}
 2084: 	%defaultSymbs = map { if ($_) {($_,1) } } @defaultSymbs;
 2085: 	delete($defaultSymbs{''});
 2086:     }
 2087: 
 2088:     # Create the composite function that renders the column on the nav map
 2089:     # have to admit any language that lets me do this can't be all bad
 2090:     #  - Jeremy (Pythonista) ;-)
 2091:     my $checked = 0;
 2092:     my $renderColFunc = sub {
 2093:         my ($resource, $part, $params) = @_;
 2094: 	my $result = "";
 2095: 
 2096: 	if(!$headings_done) {
 2097: 	    if ($option_texts) {
 2098: 		foreach my $text (@$option_texts) {
 2099: 		    $result .= "<th>$text</th>";
 2100: 		}
 2101: 	    }
 2102: 	    $result .= "<th>Select</th>";
 2103: 	    $result .= "</tr><tr>"; # Close off the extra row and start a new one.
 2104: 	    $headings_done = 1;
 2105: 	}
 2106: 
 2107:         my $inputType;
 2108:         if ($multichoice) { $inputType = 'checkbox'; }
 2109:         else {$inputType = 'radio'; }
 2110: 
 2111:         if (!&$choiceFunc($resource)) {
 2112: 	    $result .= '<td>&nbsp;</td>';
 2113:             return $result;
 2114:         } else {
 2115: 	    my $col = "";
 2116: 	    my $raw_name = &$valueFunc($resource);
 2117: 	    my $resource_name =   
 2118:                    HTML::Entities::encode($raw_name,"<>&\"'");
 2119: 	    if($option_vars) {
 2120: 		foreach my $option_var (@$option_vars) {
 2121: 		    my $var_value = "\|\|\|" . $helper->{VARS}->{$option_var} . 
 2122: 			"\|\|\|";
 2123: 		    my $checked ="";
 2124: 		    if($var_value =~ /\Q|||$raw_name|||\E/) {
 2125: 			$checked = "checked='checked'";
 2126: 		    }
 2127: 		    $col .= 
 2128:                         "<td align='center'><input type='checkbox' name ='$option_var".
 2129: 			".forminput' value='".
 2130: 			$resource_name . "' $checked /> </td>";
 2131: 		}
 2132: 	    }
 2133: 
 2134:             $col .= "<td align='center'><input type='$inputType' name='${var}.forminput' ";
 2135: 	    if (%defaultSymbs) {
 2136: 		my $symb=$resource->symb();
 2137: 		if (exists($defaultSymbs{$symb})) {
 2138: 		    $col .= "checked='checked' ";
 2139: 		    $checked = 1;
 2140: 		}
 2141: 	    } else {
 2142: 		if (!$checked && !$multichoice) {
 2143: 		    $col .= "checked='checked' ";
 2144: 		    $checked = 1;
 2145: 		}
 2146: 		if ($multichoice) { # all resources start checked; see bug 1174
 2147: 		    $col .= "checked='checked' ";
 2148: 		    $checked = 1;
 2149: 		}
 2150: 	    }
 2151:             $col .= "value='" . $resource_name  . "' /></td>";
 2152: 
 2153:             return $result.$col;
 2154:         }
 2155:     };
 2156:     my $renderPartsFunc = sub {
 2157:         my ($resource, $part, $params) = @_;
 2158: 	my $col= "<td>";
 2159: 	my $id=$resource->{ID};
 2160: 	my $resource_name =   
 2161: 	    &HTML::Entities::encode(&$valueFunc($resource),"<>&\"'");
 2162: 	if ($addparts && (scalar(@{$resource->parts}) > 1)) {
 2163: 	    $col .= "<select onclick=\"javascript:updateRadio(this.form,'${var}.forminput','$resource_name');updateHidden(this.form,'$id','${var}');\" name='part_$id.forminput'>\n";
 2164: 	    $col .= "<option value=\"$part\">All Parts</option>\n";
 2165: 	    foreach my $part (@{$resource->parts}) {
 2166: 		$col .= "<option value=\"$part\">Part: $part</option>\n";
 2167: 	    }
 2168: 	    $col .= "</select>";
 2169: 	}
 2170: 	$col .= "</td>";
 2171:     };
 2172:     $result.=(<<RADIO);
 2173: <script type="text/javascript">
 2174: // <!--
 2175:     function updateRadio(form,name,value) {
 2176: 	var radiobutton=form[name];
 2177: 	for (var i=0; i<radiobutton.length; i++) {
 2178: 	    if (radiobutton[i].value == value) {
 2179: 		radiobutton[i].checked = true;
 2180: 		break;
 2181: 	    }
 2182: 	}
 2183:     }
 2184:     function updateHidden(form,id,name) {
 2185: 	var select=form['part_'+id+'.forminput'];
 2186: 	var hidden=form[name+'_part.forminput'];
 2187: 	var which=select.selectedIndex;
 2188: 	hidden.value=select.options[which].value;
 2189:     }
 2190: // -->
 2191: </script>
 2192: <input type="hidden" name="${var}_part.forminput" />
 2193: 
 2194: RADIO
 2195:     $env{'form.condition'} = !$self->{'toponly'};
 2196:     my $cols = [$renderColFunc];
 2197:     if ($self->{'addparts'}) { push(@$cols, $renderPartsFunc); }
 2198:     push(@$cols, Apache::lonnavmaps::resource());
 2199:     if ($self->{'addstatus'}) {
 2200: 	push @$cols, (Apache::lonnavmaps::part_status_summary());
 2201: 	
 2202:     }
 2203:     $result .= 
 2204:         &Apache::lonnavmaps::render( { 'cols' => $cols,
 2205:                                        'showParts' => 0,
 2206:                                        'filterFunc' => $filterFunc,
 2207:                                        'resource_no_folder_link' => 1,
 2208: 				       'closeAllPages' => $self->{'closeallpages'},
 2209:                                        'suppressEmptySequences' => $self->{'suppressEmptySequences'},
 2210:                                        'iterator_map' => $mapUrl }
 2211:                                        );
 2212: 
 2213:     $result .= $buttons;
 2214:                                                 
 2215:     return $result;
 2216: }
 2217:     
 2218: sub postprocess {
 2219:     my $self = shift;
 2220: 
 2221:     if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) {
 2222:         $self->{ERROR_MSG} = 'You must choose at least one resource to continue.';
 2223:         return 0;
 2224:     }
 2225: 
 2226:     if (defined($self->{NEXTSTATE})) {
 2227:         $helper->changeState($self->{NEXTSTATE});
 2228:     }
 2229: 
 2230:     return 1;
 2231: }
 2232: 
 2233: 1;
 2234: 
 2235: package Apache::lonhelper::student;
 2236: 
 2237: =pod
 2238: 
 2239: =head2 Element: studentX<student, helper element>
 2240: 
 2241: Student elements display a choice of students enrolled in the current
 2242: course. Currently it is primitive; this is expected to evolve later.
 2243: 
 2244: Student elements take the following attributes: 
 2245: 
 2246: =over 4
 2247: 
 2248: =item * B<variable>: 
 2249: 
 2250: Does what it usually does: declare which helper variable to put the
 2251: result in.
 2252: 
 2253: =item * B<multichoice>: 
 2254: 
 2255: If true allows the user to select multiple students. Defaults to false.
 2256: 
 2257: =item * B<coursepersonnel>: 
 2258: 
 2259: If true adds the course personnel to the top of the student
 2260: selection. Defaults to false.
 2261: 
 2262: =item * B<activeonly>:
 2263: 
 2264: If true, only active students and course personnel will be
 2265: shown. Defaults to false.
 2266: 
 2267: =item * B<emptyallowed>:
 2268: 
 2269: If true, the selection of no users is allowed. Defaults to false.
 2270: 
 2271: =back
 2272: 
 2273: =cut
 2274: 
 2275: no strict;
 2276: @ISA = ("Apache::lonhelper::element");
 2277: use strict;
 2278: use Apache::lonlocal;
 2279: use Apache::lonnet;
 2280: 
 2281: BEGIN {
 2282:     &Apache::lonhelper::register('Apache::lonhelper::student',
 2283:                               ('student'));
 2284: }
 2285: 
 2286: sub new {
 2287:     my $ref = Apache::lonhelper::element->new();
 2288:     bless($ref);
 2289: }
 2290: 
 2291: sub start_student {
 2292:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2293: 
 2294:     if ($target ne 'helper') {
 2295:         return '';
 2296:     }
 2297: 
 2298:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2299:     $helper->declareVar($paramHash->{'variable'});
 2300:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 2301:     $paramHash->{'coursepersonnel'} = $token->[2]{'coursepersonnel'};
 2302:     $paramHash->{'activeonly'} = $token->[2]{'activeonly'};
 2303:     if (defined($token->[2]{'nextstate'})) {
 2304:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
 2305:     }
 2306:     $paramHash->{'emptyallowed'} = $token->[2]{'emptyallowed'};
 2307:     
 2308: }    
 2309: 
 2310: sub end_student {
 2311:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2312: 
 2313:     if ($target ne 'helper') {
 2314:         return '';
 2315:     }
 2316:     Apache::lonhelper::student->new();
 2317: }
 2318: 
 2319: sub render {
 2320:     my $self = shift;
 2321:     my $result = '';
 2322:     my $buttons = '';
 2323:     my $var = $self->{'variable'};
 2324: 
 2325: 
 2326:     if (defined $self->{ERROR_MSG}) {
 2327:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 2328:     }
 2329: 
 2330:     my %defaultUsers;
 2331:     if (defined($self->{DEFAULT_VALUE})) {
 2332:         my $valueFunc = eval($self->{DEFAULT_VALUE});
 2333:         die 'Error in default value code for variable ' . 
 2334:             $self->{'variable'} . ', Perl said: ' . $@ if $@;
 2335:         my @defaultUsers = &$valueFunc($helper, $self);
 2336: 	if (!$self->{'multichoice'} && @defaultUsers) { # only allowed 1
 2337: 	    @defaultUsers = ($defaultUsers[0]);
 2338: 	}
 2339: 	%defaultUsers = map { if ($_) {($_,1) } } @defaultUsers;
 2340: 	delete($defaultUsers{''});
 2341:     }
 2342: 
 2343: 
 2344:     my ($course_personnel, 
 2345: 	$current_members, 
 2346: 	$expired_members, 
 2347: 	$future_members) = 
 2348: 	    &Apache::lonselstudent::get_people_in_class($env{'request.course.sec'});
 2349: 
 2350: 
 2351: 
 2352:     # Load up the non-students, if necessary
 2353: 
 2354:     if ($self->{'coursepersonnel'}) {
 2355: 	unshift @$current_members, (@$course_personnel);
 2356:     }
 2357: 
 2358: 
 2359:     #   Current personel
 2360: 
 2361:     $result .= &Apache::lonselstudent::render_student_list( $current_members,
 2362: 							    "helpform",
 2363: 							    "current", 
 2364: 							    \%defaultUsers,
 2365: 							    $self->{'multichoice'},
 2366: 							    $self->{'variable'},
 2367: 							    1);
 2368: 
 2369: 
 2370:     # If activeonly is not set then we can also give the expired students:
 2371:     #
 2372:     if (!$self->{'activeonly'} && ((scalar @$expired_members) > 0)) {
 2373: 
 2374: 	# And future.
 2375: 
 2376: 	$result .= &Apache::lonselstudent::render_student_list( $future_members,
 2377: 								"helpform",
 2378: 								"future",
 2379: 								\%defaultUsers,
 2380: 								$self->{'multichoice'},
 2381: 								$self->{'variable'},
 2382: 								0);
 2383: 	# Past 
 2384: 
 2385: 	$result .= &Apache::lonselstudent::render_student_list($expired_members,
 2386: 							       "helpform",
 2387: 							       "past",
 2388: 							       \%defaultUsers,
 2389: 							       $self->{'multichoice'},
 2390: 							       $self->{'variable'},
 2391: 							       0);
 2392:     }
 2393: 
 2394: 
 2395: 
 2396:     return $result;
 2397: }
 2398: 
 2399: sub postprocess {
 2400:     my $self = shift;
 2401: 
 2402:     my $result = $env{'form.' . $self->{'variable'} . '.forminput'};
 2403:     if (!$result && !$self->{'emptyallowed'}) {
 2404: 	if ($self->{'coursepersonnel'}) {
 2405: 	    $self->{ERROR_MSG} = 
 2406: 		&mt('You must choose at least one user to continue.');
 2407: 	} else {
 2408: 	    $self->{ERROR_MSG} = 
 2409: 		&mt('You must choose at least one student to continue.');
 2410: 	}
 2411:         return 0;
 2412:     }
 2413: 
 2414:     if (defined($self->{NEXTSTATE})) {
 2415:         $helper->changeState($self->{NEXTSTATE});
 2416:     }
 2417: 
 2418:     return 1;
 2419: }
 2420: 
 2421: 1;
 2422: 
 2423: package Apache::lonhelper::files;
 2424: 
 2425: =pod
 2426: 
 2427: =head2 Element: filesX<files, helper element>
 2428: 
 2429: files allows the users to choose files from a given directory on the
 2430: server. It is always multichoice and stores the result as a triple-pipe
 2431: delimited entry in the helper variables. 
 2432: 
 2433: Since it is extremely unlikely that you can actually code a constant
 2434: representing the directory you wish to allow the user to search, <files>
 2435: takes a subroutine that returns the name of the directory you wish to
 2436: have the user browse.
 2437: 
 2438: files accepts the attribute "variable" to control where the files chosen
 2439: are put. It accepts the attribute "multichoice" as the other attribute,
 2440: defaulting to false, which if true will allow the user to select more
 2441: then one choice. 
 2442: 
 2443: <files> accepts three subtags: 
 2444: 
 2445: =over 4
 2446: 
 2447: =item * B<nextstate>: works as it does with the other tags. 
 2448: 
 2449: =item * B<filechoice>: When the contents of this tag are surrounded by
 2450:     "sub {" and "}", will return a string representing what directory
 2451:     on the server to allow the user to choose files from. 
 2452: 
 2453: =item * B<filefilter>: Should contain Perl code that when surrounded
 2454:     by "sub { my $filename = shift; " and "}", returns a true value if
 2455:     the user can pick that file, or false otherwise. The filename
 2456:     passed to the function will be just the name of the file, with no
 2457:     path info. By default, a filter function will be used that will
 2458:     mask out old versions of files. This function is available as
 2459:     Apache::lonhelper::files::not_old_version if you want to use it to
 2460:     composite your own filters.
 2461: 
 2462: =back
 2463: 
 2464: B<General security note>: You should ensure the user can not somehow 
 2465: pass something into your code that would allow them to look places 
 2466: they should not be able to see, like the C</etc/> directory. However,
 2467: the security impact would be minimal, since it would only expose
 2468: the existence of files, there should be no way to parlay that into
 2469: viewing the files. 
 2470: 
 2471: =cut
 2472: 
 2473: no strict;
 2474: @ISA = ("Apache::lonhelper::element");
 2475: use strict;
 2476: use Apache::lonlocal;
 2477: use Apache::lonnet;
 2478: use Apache::lonpubdir; # for getTitleString
 2479: 
 2480: BEGIN {
 2481:     &Apache::lonhelper::register('Apache::lonhelper::files',
 2482:                                  ('files', 'filechoice', 'filefilter'));
 2483: }
 2484: 
 2485: sub not_old_version {
 2486:     my $file = shift;
 2487:     
 2488:     # Given a file name, return false if it is an "old version" of a
 2489:     # file, or true if it is not.
 2490: 
 2491:     if ($file =~ /^.*\.[0-9]+\.[A-Za-z]+(\.meta)?$/) {
 2492: 	return 0;
 2493:     }
 2494:     return 1;
 2495: }
 2496: 
 2497: sub new {
 2498:     my $ref = Apache::lonhelper::element->new();
 2499:     bless($ref);
 2500: }
 2501: 
 2502: sub start_files {
 2503:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2504: 
 2505:     if ($target ne 'helper') {
 2506:         return '';
 2507:     }
 2508:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2509:     $helper->declareVar($paramHash->{'variable'});
 2510:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 2511: }    
 2512: 
 2513: sub end_files {
 2514:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2515: 
 2516:     if ($target ne 'helper') {
 2517:         return '';
 2518:     }
 2519:     if (!defined($paramHash->{FILTER_FUNC})) {
 2520:         $paramHash->{FILTER_FUNC} = sub { return 1; };
 2521:     }
 2522:     Apache::lonhelper::files->new();
 2523: }    
 2524: 
 2525: sub start_filechoice {
 2526:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2527: 
 2528:     if ($target ne 'helper') {
 2529:         return '';
 2530:     }
 2531:     $paramHash->{'filechoice'} = Apache::lonxml::get_all_text('/filechoice',
 2532:                                                               $parser);
 2533: }
 2534: 
 2535: sub end_filechoice { return ''; }
 2536: 
 2537: sub start_filefilter {
 2538:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2539: 
 2540:     if ($target ne 'helper') {
 2541:         return '';
 2542:     }
 2543: 
 2544:     my $contents = Apache::lonxml::get_all_text('/filefilter',
 2545:                                                 $parser);
 2546:     $contents = 'sub { my $filename = shift; ' . $contents . '}';
 2547:     $paramHash->{FILTER_FUNC} = eval $contents;
 2548: }
 2549: 
 2550: sub end_filefilter { return ''; }
 2551: 
 2552: { 
 2553:     # used to generate unique id attributes for <input> tags. 
 2554:     # internal use only.
 2555:     my $id=0;
 2556:     sub new_id { return $id++;}
 2557: }
 2558: 
 2559: sub render {
 2560:     my $self = shift;
 2561:     my $result = '';
 2562:     my $var = $self->{'variable'};
 2563:     
 2564:     my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}');
 2565:     die 'Error in resource filter code for variable ' . 
 2566:         {'variable'} . ', Perl said:' . $@ if $@;
 2567: 
 2568:     my $subdir = &$subdirFunc();
 2569: 
 2570:     my $filterFunc = $self->{FILTER_FUNC};
 2571:     if (!defined($filterFunc)) {
 2572: 	$filterFunc = &not_old_version;
 2573:     }
 2574:     my $buttons = '';
 2575:     my $type = 'radio';
 2576:     if ($self->{'multichoice'}) {
 2577:         $type = 'checkbox';
 2578:     }
 2579: 
 2580:     if ($self->{'multichoice'}) {
 2581:         $result = <<SCRIPT;
 2582: <script type="text/javascript">
 2583: // <!--
 2584:     function checkall(value, checkName) {
 2585: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 2586:             ele = document.forms.helpform.elements[i];
 2587:             if (ele.name == checkName + '.forminput') {
 2588:                 document.forms.helpform.elements[i].checked=value;
 2589:             }
 2590:         }
 2591:     }
 2592: 
 2593:     function checkallclass(value, className) {
 2594:         for (i=0; i<document.forms.helpform.elements.length; i++) {
 2595:             ele = document.forms.helpform.elements[i];
 2596:             if (ele.type == "$type" && ele.onclick) {
 2597:                 document.forms.helpform.elements[i].checked=value;
 2598:             }
 2599:         }
 2600:     }
 2601: // -->
 2602: </script>
 2603: SCRIPT
 2604:        my %lt=&Apache::lonlocal::texthash(
 2605: 			'saf'  => "Select All Files",
 2606: 		        'uaf'  => "Unselect All Files");
 2607:        $buttons = <<BUTTONS;
 2608: <br /> &nbsp;
 2609: <input type="button" onclick="checkall(true, '$var')" value="$lt{'saf'}" />
 2610: <input type="button" onclick="checkall(false, '$var')" value="$lt{'uaf'}" />
 2611: BUTTONS
 2612: 
 2613:        %lt=&Apache::lonlocal::texthash(
 2614: 			'sap'  => "Select All Published",
 2615: 		        'uap'  => "Unselect All Published");
 2616:         if ($helper->{VARS}->{'construction'}) {
 2617:        $buttons .= <<BUTTONS;
 2618: <input type="button" onclick="checkallclass(true, 'Published')" value="$lt{'sap'}" />
 2619: <input type="button" onclick="checkallclass(false, 'Published')" value="$lt{'uap'}" />
 2620: <br /> &nbsp;
 2621: BUTTONS
 2622:        }
 2623:     }
 2624: 
 2625:     # Get the list of files in this directory.
 2626:     my @fileList;
 2627: 
 2628:     # If the subdirectory is in local CSTR space
 2629:     my $metadir;
 2630:     if ($subdir =~ m|/home/([^/]+)/public_html/(.*)|) {
 2631: 	my ($user,$domain)= 
 2632: 	    &Apache::loncacc::constructaccess($subdir,
 2633: 				     $Apache::lonnet::perlvar{'lonDefDomain'});
 2634: 	$metadir='/res/'.$domain.'/'.$user.'/'.$2;
 2635:         @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, '');
 2636:     } elsif ($subdir =~ m|^~([^/]+)/(.*)$|) {
 2637: 	$subdir='/home/'.$1.'/public_html/'.$2;
 2638: 	my ($user,$domain)= 
 2639: 	    &Apache::loncacc::constructaccess($subdir,
 2640: 				     $Apache::lonnet::perlvar{'lonDefDomain'});
 2641: 	$metadir='/res/'.$domain.'/'.$user.'/'.$2;
 2642:         @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, '');
 2643:     } else {
 2644:         # local library server resource space
 2645:         @fileList = &Apache::lonnet::dirlist($subdir, $env{'user.domain'}, $env{'user.name'}, '');
 2646:     }
 2647: 
 2648:     # Sort the fileList into order
 2649:     @fileList = sort {lc($a) cmp lc($b)} @fileList;
 2650: 
 2651:     $result .= $buttons;
 2652: 
 2653:     if (defined $self->{ERROR_MSG}) {
 2654:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 2655:     }
 2656: 
 2657:     $result .= '<table border="0" cellpadding="2" cellspacing="0">';
 2658: 
 2659:     # Keeps track if there are no choices, prints appropriate error
 2660:     # if there are none. 
 2661:     my $choices = 0;
 2662:     # Print each legitimate file choice.
 2663:     for my $file (@fileList) {
 2664:         $file = (split(/&/, $file))[0];
 2665:         if ($file eq '.' || $file eq '..') {
 2666:             next;
 2667:         }
 2668:         my $fileName = $subdir .'/'. $file;
 2669:         if (&$filterFunc($file)) {
 2670: 	    my $status;
 2671: 	    my $color;
 2672: 	    if ($helper->{VARS}->{'construction'}) {
 2673: 		($status, $color) = @{fileState($subdir, $file)};
 2674: 	    } else {
 2675: 		$status = '';
 2676: 		$color = '';
 2677: 	    }
 2678: 
 2679:             # Get the title
 2680:             my $title = Apache::lonpubdir::getTitleString(($metadir?$metadir:$subdir) .'/'. $file);
 2681: 
 2682:             # Netscape 4 is stupid and there's nowhere to put the
 2683:             # information on the input tag that the file is Published,
 2684:             # Unpublished, etc. In *real* browsers we can just say
 2685:             # "class='Published'" and check the className attribute of
 2686:             # the input tag, but Netscape 4 is too stupid to understand
 2687:             # that attribute, and un-comprehended attributes are not
 2688:             # reflected into the object model. So instead, what I do 
 2689:             # is either have or don't have an "onclick" handler that 
 2690:             # does nothing, give Published files the onclick handler, and
 2691:             # have the checker scripts check for that. Stupid and clumsy,
 2692:             # and only gives us binary "yes/no" information (at least I
 2693:             # couldn't figure out how to reach into the event handler's
 2694:             # actual code to retreive a value), but it works well enough
 2695:             # here.
 2696:         
 2697:             my $onclick = '';
 2698:             if ($status eq 'Published' && $helper->{VARS}->{'construction'}) {
 2699:                 $onclick = 'onclick="a=1" ';
 2700:             }
 2701:             my $id = &new_id();
 2702:             $result .= '<tr><td align="right"' . " bgcolor='$color'>" .
 2703:                 "<input $onclick type='$type' name='" . $var
 2704:             . ".forminput' ".qq{id="$id"}." value='" . HTML::Entities::encode($fileName,"<>&\"'").
 2705:                 "'";
 2706:             if (!$self->{'multichoice'} && $choices == 0) {
 2707:                 $result .= ' checked="checked"';
 2708:             }
 2709:             $result .= "/></td><td bgcolor='$color'>".
 2710:                 qq{<label for="$id">}. $file . "</label></td>" .
 2711:                 "<td bgcolor='$color'>$title</td>" .
 2712:                 "<td bgcolor='$color'>$status</td>" . "</tr>\n";
 2713:             $choices++;
 2714:         }
 2715:     }
 2716: 
 2717:     $result .= "</table>\n";
 2718: 
 2719:     if (!$choices) {
 2720:         $result .= '<font color="#FF0000">There are no files available to select in this directory ('.$subdir.'). Please go back and select another option.</font><br /><br />';
 2721:     }
 2722: 
 2723:     $result .= $buttons;
 2724: 
 2725:     return $result;
 2726: }
 2727: 
 2728: # Determine the state of the file: Published, unpublished, modified.
 2729: # Return the color it should be in and a label as a two-element array
 2730: # reference.
 2731: # Logic lifted from lonpubdir.pm, even though I don't know that it's still
 2732: # the most right thing to do.
 2733: 
 2734: sub fileState {
 2735:     my $constructionSpaceDir = shift;
 2736:     my $file = shift;
 2737:     
 2738:     my ($uname,$udom)=($env{'user.name'},$env{'user.domain'});
 2739:     if ($env{'request.role'}=~/^ca\./) {
 2740: 	(undef,$udom,$uname)=split(/\//,$env{'request.role'});
 2741:     }
 2742:     my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
 2743:     my $subdirpart = $constructionSpaceDir;
 2744:     $subdirpart =~ s/^\/home\/$uname\/public_html//;
 2745:     my $resdir = $docroot . '/res/' . $udom . '/' . $uname .
 2746:         $subdirpart;
 2747: 
 2748:     my @constructionSpaceFileStat = stat($constructionSpaceDir . '/' . $file);
 2749:     my @resourceSpaceFileStat = stat($resdir . '/' . $file);
 2750:     if (!@resourceSpaceFileStat) {
 2751:         return ['Unpublished', '#FFCCCC'];
 2752:     }
 2753: 
 2754:     my $constructionSpaceFileModified = $constructionSpaceFileStat[9];
 2755:     my $resourceSpaceFileModified = $resourceSpaceFileStat[9];
 2756:     
 2757:     if ($constructionSpaceFileModified > $resourceSpaceFileModified) {
 2758:         return ['Modified', '#FFFFCC'];
 2759:     }
 2760:     return ['Published', '#CCFFCC'];
 2761: }
 2762: 
 2763: sub postprocess {
 2764:     my $self = shift;
 2765:     my $result = $env{'form.' . $self->{'variable'} . '.forminput'};
 2766:     if (!$result) {
 2767:         $self->{ERROR_MSG} = 'You must choose at least one file '.
 2768:             'to continue.';
 2769:         return 0;
 2770:     }
 2771: 
 2772:     if (defined($self->{NEXTSTATE})) {
 2773:         $helper->changeState($self->{NEXTSTATE});
 2774:     }
 2775: 
 2776:     return 1;
 2777: }
 2778: 
 2779: 1;
 2780: 
 2781: package Apache::lonhelper::section;
 2782: 
 2783: =pod
 2784: 
 2785: =head2 Element: sectionX<section, helper element>
 2786: 
 2787: <section> allows the user to choose one or more sections from the current
 2788: course.
 2789: 
 2790: It takes the standard attributes "variable", "multichoice",
 2791: "allowempty" and "nextstate", meaning what they do for most other
 2792: elements.
 2793: 
 2794: also takes a boolean 'onlysections' whcih will restrict this to only
 2795: have sections and not include groups
 2796: 
 2797: =cut
 2798: 
 2799: no strict;
 2800: @ISA = ("Apache::lonhelper::choices");
 2801: use strict;
 2802: 
 2803: BEGIN {
 2804:     &Apache::lonhelper::register('Apache::lonhelper::section',
 2805:                                  ('section'));
 2806: }
 2807: 
 2808: sub new {
 2809:     my $ref = Apache::lonhelper::choices->new();
 2810:     bless($ref);
 2811: }
 2812: 
 2813: sub start_section {
 2814:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2815: 
 2816:     if ($target ne 'helper') {
 2817:         return '';
 2818:     }
 2819: 
 2820:     $paramHash->{CHOICES} = [];
 2821: 
 2822:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2823:     $helper->declareVar($paramHash->{'variable'});
 2824:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 2825:     $paramHash->{'allowempty'} = $token->[2]{'allowempty'};
 2826:     if (defined($token->[2]{'nextstate'})) {
 2827:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
 2828:     }
 2829: 
 2830:     # Populate the CHOICES element
 2831:     my %choices;
 2832: 
 2833:     my $section = Apache::loncoursedata::CL_SECTION();
 2834:     my $classlist = Apache::loncoursedata::get_classlist();
 2835:     foreach my $user (keys(%$classlist)) {
 2836:         my $section_name = $classlist->{$user}[$section];
 2837:         if (!$section_name) {
 2838:             $choices{"No section assigned"} = "";
 2839:         } else {
 2840:             $choices{$section_name} = $section_name;
 2841:         }
 2842:     } 
 2843:    
 2844:     if (exists($choices{"No section assigned"})) {
 2845: 	push(@{$paramHash->{CHOICES}}, 
 2846: 	     ['No section assigned','No section assigned']);
 2847: 	delete($choices{"No section assigned"});
 2848:     }
 2849:     for my $section_name (sort {lc($a) cmp lc($b) } (keys(%choices))) {
 2850: 	push @{$paramHash->{CHOICES}}, [$section_name, $section_name];
 2851:     }
 2852:     return if ($token->[2]{'onlysections'});
 2853: 
 2854:     # add in groups to the end of the list
 2855:     my %curr_groups = &Apache::longroup::coursegroups();
 2856:     foreach my $group_name (sort(keys(%curr_groups))) {
 2857: 	push(@{$paramHash->{CHOICES}}, [$group_name, $group_name]);
 2858:     }
 2859: }    
 2860: 
 2861: sub end_section {
 2862:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2863: 
 2864:     if ($target ne 'helper') {
 2865:         return '';
 2866:     }
 2867:     Apache::lonhelper::section->new();
 2868: }    
 2869: 1;
 2870: 
 2871: package Apache::lonhelper::group;
 2872: 
 2873: =pod
 2874:  
 2875: =head2 Element: groupX<group, helper element>
 2876:  
 2877: <group> allows the user to choose one or more groups from the current course.
 2878: 
 2879: It takes the standard attributes "variable", "multichoice",
 2880:  "allowempty" and "nextstate", meaning what they do for most other
 2881:  elements.
 2882: 
 2883: =cut
 2884: 
 2885: no strict;
 2886: @ISA = ("Apache::lonhelper::choices");
 2887: use strict;
 2888: 
 2889: BEGIN {
 2890:     &Apache::lonhelper::register('Apache::lonhelper::group',
 2891:                                  ('group'));
 2892: }
 2893: 
 2894: sub new {
 2895:     my $ref = Apache::lonhelper::choices->new();
 2896:     bless($ref);
 2897: }
 2898:  
 2899: sub start_group {
 2900:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2901:  
 2902:     if ($target ne 'helper') {
 2903:         return '';
 2904:     }
 2905: 
 2906:     $paramHash->{CHOICES} = [];
 2907: 
 2908:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2909:     $helper->declareVar($paramHash->{'variable'});
 2910:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 2911:     $paramHash->{'allowempty'} = $token->[2]{'allowempty'};
 2912:     if (defined($token->[2]{'nextstate'})) {
 2913:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
 2914:     }
 2915: 
 2916:     # Populate the CHOICES element
 2917:     my %choices;
 2918: 
 2919:     my %curr_groups = &Apache::longroup::coursegroups();
 2920:     foreach my $group_name (sort {lc($a) cmp lc($b)} (keys(%curr_groups))) {
 2921: 	push(@{$paramHash->{CHOICES}}, [$group_name, $group_name]);
 2922:     }
 2923: }
 2924: 
 2925: sub end_group {
 2926:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2927: 
 2928:     if ($target ne 'helper') {
 2929:         return '';
 2930:     }
 2931:     Apache::lonhelper::group->new();
 2932: }
 2933: 1;
 2934: 
 2935: package Apache::lonhelper::string;
 2936: 
 2937: =pod
 2938: 
 2939: =head2 Element: stringX<string, helper element>
 2940: 
 2941: string elements provide a string entry field for the user. string elements
 2942: take the usual 'variable' and 'nextstate' parameters. string elements
 2943: also pass through 'maxlength' and 'size' attributes to the input tag.
 2944: 
 2945: string honors the defaultvalue tag, if given.
 2946: 
 2947: string honors the validation function, if given.
 2948: 
 2949: =cut
 2950: 
 2951: no strict;
 2952: @ISA = ("Apache::lonhelper::element");
 2953: use strict;
 2954: use Apache::lonlocal;
 2955: 
 2956: BEGIN {
 2957:     &Apache::lonhelper::register('Apache::lonhelper::string',
 2958:                               ('string'));
 2959: }
 2960: 
 2961: sub new {
 2962:     my $ref = Apache::lonhelper::element->new();
 2963:     bless($ref);
 2964: }
 2965: 
 2966: # CONSTRUCTION: Construct the message element from the XML
 2967: sub start_string {
 2968:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2969: 
 2970:     if ($target ne 'helper') {
 2971:         return '';
 2972:     }
 2973: 
 2974:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2975:     $helper->declareVar($paramHash->{'variable'});
 2976:     $paramHash->{'nextstate'} = $token->[2]{'nextstate'};
 2977:     $paramHash->{'maxlength'} = $token->[2]{'maxlength'};
 2978:     $paramHash->{'size'} = $token->[2]{'size'};
 2979: 
 2980:     return '';
 2981: }
 2982: 
 2983: sub end_string {
 2984:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2985: 
 2986:     if ($target ne 'helper') {
 2987:         return '';
 2988:     }
 2989:     Apache::lonhelper::string->new();
 2990:     return '';
 2991: }
 2992: 
 2993: sub render {
 2994:     my $self = shift;
 2995:     my $result = '';
 2996: 
 2997:     if (defined $self->{ERROR_MSG}) {
 2998:         $result .= '<p><font color="#FF0000">' . $self->{ERROR_MSG} . '</font></p>';
 2999:     }
 3000: 
 3001:     $result .= '<input type="string" name="' . $self->{'variable'} . '.forminput"';
 3002: 
 3003:     if (defined($self->{'size'})) {
 3004:         $result .= ' size="' . $self->{'size'} . '"';
 3005:     }
 3006:     if (defined($self->{'maxlength'})) {
 3007:         $result .= ' maxlength="' . $self->{'maxlength'} . '"';
 3008:     }
 3009: 
 3010:     if (defined($self->{DEFAULT_VALUE})) {
 3011:         my $valueFunc = eval($self->{DEFAULT_VALUE});
 3012:         die 'Error in default value code for variable ' . 
 3013:             $self->{'variable'} . ', Perl said: ' . $@ if $@;
 3014:         $result .= ' value="' . &$valueFunc($helper, $self) . '"';
 3015:     }
 3016: 
 3017:     $result .= ' />';
 3018: 
 3019:     return $result;
 3020: }
 3021: 
 3022: # If a NEXTSTATE was given, switch to it
 3023: sub postprocess {
 3024:     my $self = shift;
 3025: 
 3026:     if (defined($self->{VALIDATOR})) {
 3027: 	my $validator = eval($self->{VALIDATOR});
 3028: 	die 'Died during evaluation of validator code; Perl said: ' . $@ if $@;
 3029: 	my $invalid = &$validator($helper, $state, $self, $self->getValue());
 3030: 	if ($invalid) {
 3031: 	    $self->{ERROR_MSG} = $invalid;
 3032: 	    return 0;
 3033: 	}
 3034:     }
 3035: 
 3036:     if (defined($self->{'nextstate'})) {
 3037:         $helper->changeState($self->{'nextstate'});
 3038:     }
 3039: 
 3040:     return 1;
 3041: }
 3042: 
 3043: 1;
 3044: 
 3045: package Apache::lonhelper::general;
 3046: 
 3047: =pod
 3048: 
 3049: =head2 General-purpose tag: <exec>X<exec, helper tag>
 3050: 
 3051: The contents of the exec tag are executed as Perl code, B<not> inside a 
 3052: safe space, so the full range of $env and such is available. The code
 3053: will be executed as a subroutine wrapped with the following code:
 3054: 
 3055: "sub { my $helper = shift; my $state = shift;" and
 3056: 
 3057: "}"
 3058: 
 3059: The return value is ignored.
 3060: 
 3061: $helper is the helper object. Feel free to add methods to the helper
 3062: object to support whatever manipulation you may need to do (for instance,
 3063: overriding the form location if the state is the final state; see 
 3064: parameter.helper for an example).
 3065: 
 3066: $state is the $paramHash that has currently been generated and may
 3067: be manipulated by the code in exec. Note that the $state is not yet
 3068: an actual state B<object>, it is just a hash, so do not expect to
 3069: be able to call methods on it.
 3070: 
 3071: =cut
 3072: 
 3073: use Apache::lonlocal;
 3074: use Apache::lonnet;
 3075: 
 3076: BEGIN {
 3077:     &Apache::lonhelper::register('Apache::lonhelper::general',
 3078:                                  'exec', 'condition', 'clause',
 3079:                                  'eval');
 3080: }
 3081: 
 3082: sub start_exec {
 3083:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3084: 
 3085:     if ($target ne 'helper') {
 3086:         return '';
 3087:     }
 3088:     
 3089:     my $code = &Apache::lonxml::get_all_text('/exec', $parser);
 3090:     
 3091:     $code = eval ('sub { my $helper = shift; my $state = shift; ' .
 3092:         $code . "}");
 3093:     die 'Error in <exec>, Perl said: '. $@ if $@;
 3094:     &$code($helper, $paramHash);
 3095: }
 3096: 
 3097: sub end_exec { return ''; }
 3098: 
 3099: =pod
 3100: 
 3101: =head2 General-purpose tag: <condition>
 3102: 
 3103: The <condition> tag allows you to mask out parts of the helper code
 3104: depending on some programatically determined condition. The condition
 3105: tag contains a tag <clause> which contains perl code that when wrapped
 3106: with "sub { my $helper = shift; my $state = shift; " and "}", returns
 3107: a true value if the XML in the condition should be evaluated as a normal
 3108: part of the helper, or false if it should be completely discarded.
 3109: 
 3110: The <clause> tag must be the first sub-tag of the <condition> tag or
 3111: it will not work as expected.
 3112: 
 3113: =cut
 3114: 
 3115: # The condition tag just functions as a marker, it doesn't have
 3116: # to "do" anything. Technically it doesn't even have to be registered
 3117: # with the lonxml code, but I leave this here to be explicit about it.
 3118: sub start_condition { return ''; }
 3119: sub end_condition { return ''; }
 3120: 
 3121: sub start_clause {
 3122:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3123: 
 3124:     if ($target ne 'helper') {
 3125:         return '';
 3126:     }
 3127:     
 3128:     my $clause = Apache::lonxml::get_all_text('/clause', $parser);
 3129:     $clause = eval('sub { my $helper = shift; my $state = shift; '
 3130:         . $clause . '}');
 3131:     die 'Error in clause of condition, Perl said: ' . $@ if $@;
 3132:     if (!&$clause($helper, $paramHash)) {
 3133:         # Discard all text until the /condition.
 3134:         &Apache::lonxml::get_all_text('/condition', $parser);
 3135:     }
 3136: }
 3137: 
 3138: sub end_clause { return ''; }
 3139: 
 3140: =pod
 3141: 
 3142: =head2 General-purpose tag: <eval>X<eval, helper tag>
 3143: 
 3144: The <eval> tag will be evaluated as a subroutine call passed in the
 3145: current helper object and state hash as described in <condition> above,
 3146: but is expected to return a string to be printed directly to the
 3147: screen. This is useful for dynamically generating messages. 
 3148: 
 3149: =cut
 3150: 
 3151: # This is basically a type of message.
 3152: # Programmatically setting $paramHash->{NEXTSTATE} would work, though
 3153: # it's probably bad form.
 3154: 
 3155: sub start_eval {
 3156:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3157: 
 3158:     if ($target ne 'helper') {
 3159:         return '';
 3160:     }
 3161:     
 3162:     my $program = Apache::lonxml::get_all_text('/eval', $parser);
 3163:     $program = eval('sub { my $helper = shift; my $state = shift; '
 3164:         . $program . '}');
 3165:     die 'Error in eval code, Perl said: ' . $@ if $@;
 3166:     $paramHash->{MESSAGE_TEXT} = &$program($helper, $paramHash);
 3167: }
 3168: 
 3169: sub end_eval { 
 3170:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3171: 
 3172:     if ($target ne 'helper') {
 3173:         return '';
 3174:     }
 3175: 
 3176:     Apache::lonhelper::message->new();
 3177: }
 3178: 
 3179: 1;
 3180: 
 3181: package Apache::lonhelper::final;
 3182: 
 3183: =pod
 3184: 
 3185: =head2 Element: finalX<final, helper tag>
 3186: 
 3187: <final> is a special element that works with helpers that use the <finalcode>
 3188: tagX<finalcode, helper tag>. It goes through all the states and elements, executing the <finalcode>
 3189: snippets and collecting the results. Finally, it takes the user out of the
 3190: helper, going to a provided page.
 3191: 
 3192: If the parameter "restartCourse" is true, this will override the buttons and
 3193: will make a "Finish Helper" button that will re-initialize the course for them,
 3194: which is useful for the Course Initialization helper so the users never see
 3195: the old values taking effect.
 3196: 
 3197: If the parameter "restartCourse" is not true a 'Finish' Button will be
 3198: presented that takes the user back to whatever was defined as <exitpage>
 3199: 
 3200: =cut
 3201: 
 3202: no strict;
 3203: @ISA = ("Apache::lonhelper::element");
 3204: use strict;
 3205: use Apache::lonlocal;
 3206: use Apache::lonnet;
 3207: BEGIN {
 3208:     &Apache::lonhelper::register('Apache::lonhelper::final',
 3209:                                  ('final', 'exitpage'));
 3210: }
 3211: 
 3212: sub new {
 3213:     my $ref = Apache::lonhelper::element->new();
 3214:     bless($ref);
 3215: }
 3216: 
 3217: sub start_final { 
 3218:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3219: 
 3220:     if ($target ne 'helper') {
 3221:         return '';
 3222:     }
 3223: 
 3224:     $paramHash->{'restartCourse'} = $token->[2]{'restartCourse'};
 3225: 
 3226:     return ''; 
 3227: }
 3228: 
 3229: sub end_final {
 3230:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3231: 
 3232:     if ($target ne 'helper') {
 3233:         return '';
 3234:     }
 3235: 
 3236:     Apache::lonhelper::final->new();
 3237:    
 3238:     return '';
 3239: }
 3240: 
 3241: sub start_exitpage {
 3242:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3243: 
 3244:     if ($target ne 'helper') {
 3245:         return '';
 3246:     }
 3247: 
 3248:     $paramHash->{EXIT_PAGE} = &Apache::lonxml::get_all_text('/exitpage',
 3249:                                                             $parser);
 3250: 
 3251:     return '';
 3252: }
 3253: 
 3254: sub end_exitpage { return ''; }
 3255: 
 3256: sub render {
 3257:     my $self = shift;
 3258: 
 3259:     my @results;
 3260: 
 3261:     # Collect all the results
 3262:     for my $stateName (keys %{$helper->{STATES}}) {
 3263:         my $state = $helper->{STATES}->{$stateName};
 3264:         
 3265:         for my $element (@{$state->{ELEMENTS}}) {
 3266:             if (defined($element->{FINAL_CODE})) {
 3267:                 # Compile the code.
 3268:                 my $code = 'sub { my $helper = shift; my $element = shift; ' 
 3269:                     . $element->{FINAL_CODE} . '}';
 3270:                 $code = eval($code);
 3271:                 die 'Error while executing final code for element with var ' .
 3272:                     $element->{'variable'} . ', Perl said: ' . $@ if $@;
 3273: 
 3274:                 my $result = &$code($helper, $element);
 3275:                 if ($result) {
 3276:                     push @results, $result;
 3277:                 }
 3278:             }
 3279:         }
 3280:     }
 3281: 
 3282:     my $result;
 3283: 
 3284:     if (scalar(@results) != 0) {
 3285: 	$result .= "<ul>\n";
 3286: 	for my $re (@results) {
 3287: 	    $result .= '    <li>' . $re . "</li>\n";
 3288: 	}
 3289: 	
 3290: 	if (!@results) {
 3291: 	    $result .= '    <li>' . 
 3292: 		&mt('No changes were made to current settings.') . '</li>';
 3293: 	}
 3294: 	
 3295: 	$result .= '</ul>';
 3296:     }
 3297: 
 3298:     my $actionURL = $self->{EXIT_PAGE};
 3299:     my $targetURL = '';
 3300:     my $finish=&mt('Finish');
 3301:     if ($self->{'restartCourse'}) {
 3302: 	$actionURL = '/adm/roles';
 3303: 	$targetURL = '/adm/menu';
 3304: 	if ($env{'course.'.$env{'request.course.id'}.'.url'}=~/^uploaded/) {
 3305: 	    $targetURL = '/adm/coursedocs';
 3306: 	} else {
 3307: 	    $targetURL = '/adm/navmaps';
 3308: 	}
 3309: 	if ($env{'course.'.$env{'request.course.id'}.'.clonedfrom'}) {
 3310: 	    $targetURL = '/adm/parmset?overview=1';
 3311: 	}
 3312: 	my $finish=&mt('Finish Course Initialization');
 3313:     }
 3314:     my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"');
 3315:     my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"');
 3316:     my $target = " target='loncapaclient'";
 3317:     if (($env{'browser.interface'} eq 'textual') ||
 3318:         ($env{'environment.remote'} eq 'off')) {  $target='';  }
 3319:     $result .= "<center>\n" .
 3320: 	"<form action='".$actionURL."' method='post' $target>\n" .
 3321: 	"<input type='button' onclick='history.go(-1)' value='$previous' />" .
 3322: 	"<input type='hidden' name='orgurl' value='$targetURL' />" .
 3323: 	"<input type='hidden' name='selectrole' value='1' />\n" .
 3324: 	"<input type='hidden' name='" . $env{'request.role'} . 
 3325: 	"' value='1' />\n<input type='submit' value='" . $finish . "' />\n" .
 3326: 	"</form></center>";
 3327: 
 3328:     return $result;
 3329: }
 3330: 
 3331: sub overrideForm {
 3332:     return 1;
 3333: }
 3334: 
 3335: 1;
 3336: 
 3337: package Apache::lonhelper::parmwizfinal;
 3338: 
 3339: # This is the final state for the parmwizard. It is not generally useful,
 3340: # so it is not perldoc'ed. It does its own processing.
 3341: # It is represented with <parmwizfinal />, and
 3342: # should later be moved to lonparmset.pm .
 3343: 
 3344: no strict;
 3345: @ISA = ('Apache::lonhelper::element');
 3346: use strict;
 3347: use Apache::lonlocal;
 3348: use Apache::lonnet;
 3349: 
 3350: BEGIN {
 3351:     &Apache::lonhelper::register('Apache::lonhelper::parmwizfinal',
 3352:                                  ('parmwizfinal'));
 3353: }
 3354: 
 3355: use Time::localtime;
 3356: 
 3357: sub new {
 3358:     my $ref = Apache::lonhelper::choices->new();
 3359:     bless ($ref);
 3360: }
 3361: 
 3362: sub start_parmwizfinal { return ''; }
 3363: 
 3364: sub end_parmwizfinal {
 3365:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 3366: 
 3367:     if ($target ne 'helper') {
 3368:         return '';
 3369:     }
 3370:     Apache::lonhelper::parmwizfinal->new();
 3371: }
 3372: 
 3373: # Renders a form that, when submitted, will form the input to lonparmset.pm
 3374: sub render {
 3375:     my $self = shift;
 3376:     my $vars = $helper->{VARS};
 3377: 
 3378:     # FIXME: Unify my designators with the standard ones
 3379:     my %dateTypeHash = ('open_date' => "opening date",
 3380:                         'due_date' => "due date",
 3381:                         'answer_date' => "answer date",
 3382: 			'tries' => 'number of tries',
 3383: 			'weight' => 'problem weight'
 3384: 			);
 3385:     my %parmTypeHash = ('open_date' => "0_opendate",
 3386:                         'due_date' => "0_duedate",
 3387:                         'answer_date' => "0_answerdate",
 3388: 			'tries' => '0_maxtries',
 3389: 			'weight' => '0_weight' );
 3390:     my %realParmName = ('open_date' => "opendate",
 3391:                         'due_date' => "duedate",
 3392:                         'answer_date' => "answerdate",
 3393: 			'tries' => 'maxtries',
 3394: 			'weight' => 'weight' );
 3395:     
 3396:     my $affectedResourceId = "";
 3397:     my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}};
 3398:     my $level = "";
 3399:     my $resourceString;
 3400:     my $symb;
 3401:     my $paramlevel;
 3402:     
 3403:     # Print the granularity, depending on the action
 3404:     if ($vars->{GRANULARITY} eq 'whole_course') {
 3405:         $resourceString .= '<li>'.&mt('for <b>all resources in the course</b>').'</li>';
 3406: 	if ($vars->{TARGETS} eq 'course') {
 3407: 	    $level = 14; # general course, see lonparmset.pm perldoc
 3408: 	} elsif ($vars->{TARGETS} eq 'section') {
 3409: 	    $level = 9;
 3410: 	} elsif ($vars->{TARGETS} eq 'group') {
 3411: 	    $level = 6;
 3412: 	} else {
 3413: 	    $level = 3;
 3414: 	}
 3415:         $affectedResourceId = "0.0";
 3416:         $symb = 'a';
 3417:         $paramlevel = 'general';
 3418:     } elsif ($vars->{GRANULARITY} eq 'map') {
 3419:         my $navmap = Apache::lonnavmaps::navmap->new();
 3420:         my $res = $navmap->getByMapPc($vars->{RESOURCE_ID});
 3421:         my $title = $res->compTitle();
 3422:         $symb = $res->symb();
 3423:         $resourceString .= '<li>'.&mt('for the map named [_1]',"<b>$title</b>").'</li>';
 3424: 	if ($vars->{TARGETS} eq 'course') {
 3425: 	    $level = 13; # general course, see lonparmset.pm perldoc
 3426: 	} elsif ($vars->{TARGETS} eq 'section') {
 3427: 	    $level = 8;
 3428: 	} elsif ($vars->{TARGETS} eq 'group') {
 3429: 	    $level = 5;
 3430: 	} else {
 3431: 	    $level = 2;
 3432: 	}
 3433:         $affectedResourceId = $vars->{RESOURCE_ID};
 3434:         $paramlevel = 'map';
 3435:     } else {
 3436:         my $navmap = Apache::lonnavmaps::navmap->new();
 3437:         my $res = $navmap->getById($vars->{RESOURCE_ID});
 3438:         my $part = $vars->{RESOURCE_ID_part};
 3439: 	if ($part ne 'All Parts' && $part) { $parm_name=~s/^0/$part/; } else { $part=&mt('All Parts'); }
 3440:         $symb = $res->symb();
 3441:         my $title = $res->compTitle();
 3442:         $resourceString .= '<li>'.&mt('for the resource named [_1] part [_2]',"<b>$title</b>","<b>$part</b>").'</li>';
 3443: 	if ($vars->{TARGETS} eq 'course') {
 3444: 	    $level = 10; # general course, see lonparmset.pm perldoc
 3445: 	} elsif ($vars->{TARGETS} eq 'section') {
 3446: 	    $level = 7;
 3447: 	} elsif ($vars->{TARGETS} eq 'group') {
 3448: 	    $level = 4;
 3449: 	} else {
 3450: 	    $level = 1;
 3451: 	}
 3452:         $affectedResourceId = $vars->{RESOURCE_ID};
 3453:         $paramlevel = 'full';
 3454:     }
 3455: 
 3456:     my $result = "<form name='helpform' method='POST' action='/adm/parmset#$affectedResourceId&$parm_name&$level'>\n";
 3457:     $result .= "<input type='hidden' name='action' value='settable' />\n";
 3458:     $result .= "<input type='hidden' name='dis' value='helper' />\n";
 3459:     $result .= "<input type='hidden' name='pscat' value='".
 3460: 	$realParmName{$vars->{ACTION_TYPE}}."' />\n";
 3461:     if ($vars->{GRANULARITY} eq 'resource') {
 3462: 	$result .= "<input type='hidden' name='symb' value='".
 3463: 	    HTML::Entities::encode($symb,"'<>&\"") . "' />\n";
 3464:     } elsif ($vars->{GRANULARITY} eq 'map') {
 3465: 	$result .= "<input type='hidden' name='pschp' value='".
 3466: 	    $affectedResourceId."' />\n";
 3467:     }
 3468:     my $part = $vars->{RESOURCE_ID_part};
 3469:     if ($part eq 'All Parts' || !$part) { $part=0; }
 3470:     $result .= "<input type='hidden' name='psprt' value='".
 3471: 	HTML::Entities::encode($part,"'<>&\"") . "' />\n";
 3472: 
 3473:     $result .= '<p>'.&mt('Confirm that this information is correct, then click &quot;Finish Helper&quot; to complete setting the parameter.').'<ul>';
 3474:     
 3475:     # Print the type of manipulation:
 3476:     my $extra;
 3477:     if ($vars->{ACTION_TYPE} eq 'tries') {
 3478: 	$extra =  $vars->{TRIES};
 3479:     }
 3480:     if ($vars->{ACTION_TYPE} eq 'weight') {
 3481: 	$extra =  $vars->{WEIGHT};
 3482:     }
 3483:     $result .= "<li>";
 3484:     my $what = &mt($dateTypeHash{$vars->{ACTION_TYPE}});
 3485:     if ($extra) {
 3486: 	$result .= &mt('Setting the [_1] to [_2]',"<b>$what</b>",$extra);
 3487:     } else {
 3488: 	$result .= &mt('Setting the [_1]',"<b>$what</b>");
 3489:     }
 3490:     $result .= "</li>\n";
 3491:     if ($vars->{ACTION_TYPE} eq 'due_date' || 
 3492:         $vars->{ACTION_TYPE} eq 'answer_date') {
 3493:         # for due dates, we default to "date end" type entries
 3494:         $result .= "<input type='hidden' name='recent_date_end' " .
 3495:             "value='" . $vars->{PARM_DATE} . "' />\n";
 3496:         $result .= "<input type='hidden' name='pres_value' " . 
 3497:             "value='" . $vars->{PARM_DATE} . "' />\n";
 3498:         $result .= "<input type='hidden' name='pres_type' " .
 3499:             "value='date_end' />\n";
 3500:     } elsif ($vars->{ACTION_TYPE} eq 'open_date') {
 3501:         $result .= "<input type='hidden' name='recent_date_start' ".
 3502:             "value='" . $vars->{PARM_DATE} . "' />\n";
 3503:         $result .= "<input type='hidden' name='pres_value' " .
 3504:             "value='" . $vars->{PARM_DATE} . "' />\n";
 3505:         $result .= "<input type='hidden' name='pres_type' " .
 3506:             "value='date_start' />\n";
 3507:     } elsif ($vars->{ACTION_TYPE} eq 'tries') {
 3508: 	$result .= "<input type='hidden' name='pres_value' " .
 3509: 	    "value='" . $vars->{TRIES} . "' />\n";
 3510:         $result .= "<input type='hidden' name='pres_type' " .
 3511:             "value='int_pos' />\n";
 3512:     } elsif ($vars->{ACTION_TYPE} eq 'weight') {
 3513: 	$result .= "<input type='hidden' name='pres_value' " .
 3514: 	    "value='" . $vars->{WEIGHT} . "' />\n";
 3515:     }
 3516: 
 3517:     $result .= $resourceString;
 3518:     
 3519:     # Print targets
 3520:     if ($vars->{TARGETS} eq 'course') {
 3521:         $result .= '<li>'.&mt('for <b>all students in course</b>').'</li>';
 3522:     } elsif ($vars->{TARGETS} eq 'section') {
 3523:         my $section = $vars->{SECTION_NAME};
 3524:         $result .= '<li>'.&mt('for section [_1]',"<b>$section</b>").'</li>';
 3525: 	$result .= "<input type='hidden' name='csec' value='" .
 3526:             HTML::Entities::encode($section,"'<>&\"") . "' />\n";
 3527:     } elsif ($vars->{TARGETS} eq 'group') {
 3528:         my $group = $vars->{GROUP_NAME};
 3529:         $result .= '<li>'.&mt('for group [_1]',"<b>$group</b>").'</li>';
 3530:         $result .= "<input type='hidden' name='cgroup' value='" .
 3531:             HTML::Entities::encode($group,"'<>&\"") . "' />\n";
 3532:     } else {
 3533:         # FIXME: This is probably wasteful! Store the name!
 3534:         my $classlist = Apache::loncoursedata::get_classlist();
 3535: 	my ($uname,$udom)=split(':',$vars->{USER_NAME});
 3536:         my $name = $classlist->{$uname.':'.$udom}->[6];
 3537:         $result .= '<li>'.&mt('for [_1]',"<b>$name</b>").'</li>';
 3538:         $result .= "<input type='hidden' name='uname' value='".
 3539:             HTML::Entities::encode($uname,"'<>&\"") . "' />\n";
 3540:         $result .= "<input type='hidden' name='udom' value='".
 3541:             HTML::Entities::encode($udom,"'<>&\"") . "' />\n";
 3542:     }
 3543: 
 3544:     # Print value
 3545:     if ($vars->{ACTION_TYPE} ne 'tries' && $vars->{ACTION_TYPE} ne 'weight') {
 3546: 	$result .= '<li>'.&mt('to [_1] ([_2])',"<b>".ctime($vars->{PARM_DATE})."</b>",Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}))."</li>\n";
 3547:     }
 3548:  
 3549:     # print pres_marker
 3550:     $result .= "\n<input type='hidden' name='pres_marker'" .
 3551:         " value='$affectedResourceId&$parm_name&$level' />\n";
 3552:     
 3553:     # Make the table appear
 3554:     $result .= "\n<input type='hidden' value='true' name='prevvisit' />";
 3555:     $result .= "\n<input type='hidden' value='$symb' name='pssymb' />";
 3556:     $result .= "\n<input type='hidden' value='$paramlevel' name='parmlev' />";
 3557: 
 3558:     $result .= "<br /><br /><center><input type='submit' value='".&mt('Finish Helper')."' /></center></form>\n";
 3559: 
 3560:     return $result;
 3561: }
 3562:     
 3563: sub overrideForm {
 3564:     return 1;
 3565: }
 3566: 
 3567: 1;
 3568: 
 3569: __END__
 3570: