Return to lonhelper.pm CVS log

Up to [LON-CAPA] / loncom / interface

* Fixed heisenbug that caused wierd stuff to happen if the handler
  tried to access file-scoped variables. See lengthy comment at the
  beginning of the commit message for a discussion; feel free to discuss
  it with me if it still doesn't make sense. (I think this may have had
  something to do with the global variable troubles in the past.)

* Added "finalcode" and "defaultvalue" tags, intended for use in the
  course initialization helper. <choices> now respects <defaultvalue>.

* If there are fewer then five choices in a multi-choice <choice>, don't
  display the "Select All" and "Unselect All" buttons, as they are
  visually clumsy.

    1: # The LearningOnline Network with CAPA
    2: # .helper XML handler to implement the LON-CAPA helper
    3: #
    4: # $Id: lonhelper.pm,v 1.25 2003/05/08 19:52:43 bowersj2 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: # (Page Handler
   29: #
   30: # (.helper handler
   31: #
   32: 
   33: =pod
   34: 
   35: =head1 lonhelper - HTML Helper framework for LON-CAPA
   36: 
   37: Helpers, often known as "wizards", are well-established UI widgets that users
   38: feel comfortable with. It can take a complicated multidimensional problem the
   39: user has and turn it into a series of bite-sized one-dimensional questions.
   40: 
   41: For developers, helpers provide an easy way to bundle little bits of functionality
   42: for the user, without having to write the tedious state-maintenence code.
   43: 
   44: Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers 
   45: directory and having the .helper file extension. For examples, see that directory.
   46: 
   47: All classes are in the Apache::lonhelper namespace.
   48: 
   49: =head2 lonhelper XML file format
   50: 
   51: A helper consists of a top-level <helper> tag which contains a series of states.
   52: Each state contains one or more state elements, which are what the user sees, like
   53: messages, resource selections, or date queries.
   54: 
   55: The helper tag is required to have one attribute, "title", which is the name
   56: of the helper itself, such as "Parameter helper". 
   57: 
   58: =head2 State tags
   59: 
   60: State tags are required to have an attribute "name", which is the symbolic
   61: name of the state and will not be directly seen by the user. The helper is
   62: required to have one state named "START", which is the state the helper
   63: will start with. By convention, this state should clearly describe what
   64: the helper will do for the user, and may also include the first information
   65: entry the user needs to do for the helper.
   66: 
   67: State tags are also required to have an attribute "title", which is the
   68: human name of the state, and will be displayed as the header on top of 
   69: the screen for the user.
   70: 
   71: =head2 Example Helper Skeleton
   72: 
   73: An example of the tags so far:
   74: 
   75:  <helper title="Example Helper">
   76:    <state name="START" title="Demonstrating the Example Helper">
   77:      <!-- notice this is the START state the wizard requires -->
   78:      </state>
   79:    <state name="GET_NAME" title="Enter Student Name">
   80:      </state>
   81:    </helper>
   82: 
   83: Of course this does nothing. In order for the wizard to do something, it is
   84: necessary to put actual elements into the wizard. Documentation for each
   85: of these elements follows.
   86: 
   87: =head2 Creating a Helper With Code, Not XML
   88: 
   89: In some situations, such as the printing wizard (see lonprintout.pm), 
   90: writing the helper in XML would be too complicated, because of scope 
   91: issues or the fact that the code actually outweighs the XML. It is
   92: possible to create a helper via code, though it is a little odd.
   93: 
   94: Creating a helper via code is more like issuing commands to create
   95: a helper then normal code writing. For instance, elements will automatically
   96: be added to the last state created, so it's important to create the 
   97: states in the correct order.
   98: 
   99: First, create a new helper:
  100: 
  101:  use Apache::lonhelper;
  102: 
  103:  my $helper = Apache::lonhelper::new->("Helper Title");
  104: 
  105: Next you'll need to manually add states to the helper:
  106: 
  107:  Apache::lonhelper::state->new("STATE_NAME", "State's Human Title");
  108: 
  109: You don't need to save a reference to it because all elements up until
  110: the next state creation will automatically be added to this state.
  111: 
  112: Elements are created by populating the $paramHash in 
  113: Apache::lonhelper::paramhash. To prevent namespace issues, retrieve 
  114: a reference to that has with getParamHash:
  115: 
  116:  my $paramHash = Apache::lonhelper::getParamHash();
  117: 
  118: You will need to do this for each state you create.
  119: 
  120: Populate the $paramHash with the parameters for the element you wish
  121: to add next; the easiest way to find out what those entries are is
  122: to read the code. Some common ones are 'variable' to record the variable
  123: to store the results in, and NEXTSTATE to record a next state transition.
  124: 
  125: Then create your element:
  126: 
  127:  $paramHash->{MESSAGETEXT} = "This is a message.";
  128:  Apache::lonhelper::message->new();
  129: 
  130: The creation will take the $paramHash and bless it into a
  131: Apache::lonhelper::message object. To create the next element, you need
  132: to get a reference to the new, empty $paramHash:
  133: 
  134:  $paramHash = Apache::lonhelper::getParamHash();
  135: 
  136: and you can repeat creating elements that way. You can add states
  137: and elements as needed.
  138: 
  139: See lonprintout.pm, subroutine printHelper for an example of this, where
  140: we dynamically add some states to prevent security problems, for instance.
  141: 
  142: Normally the machinery in the XML format is sufficient; dynamically 
  143: adding states can easily be done by wrapping the state in a <condition>
  144: tag. This should only be used when the code dominates the XML content,
  145: the code is so complicated that it is difficult to get access to
  146: all of the information you need because of scoping issues, or so much
  147: of the information used is persistent because would-be <exec> or 
  148: <eval> blocks that using the {DATA} mechanism results in hard-to-read
  149: and -maintain code.
  150: 
  151: It is possible to do some of the work with an XML fragment parsed by
  152: lonxml; again, see lonprintout.pm for an example. In that case it is 
  153: imperative that you call B<Apache::lonhelper::registerHelperTags()>
  154: before parsing XML fragments and B<Apache::lonhelper::unregisterHelperTags()>
  155: when you are done. See lonprintout.pm for examples of this usage in the
  156: printHelper subroutine.
  157: 
  158: =cut
  159: 
  160: package Apache::lonhelper;
  161: use Apache::Constants qw(:common);
  162: use Apache::File;
  163: use Apache::lonxml;
  164: 
  165: # Register all the tags with the helper, so the helper can 
  166: # push and pop them
  167: 
  168: my @helperTags;
  169: 
  170: sub register {
  171:     my ($namespace, @tags) = @_;
  172: 
  173:     for my $tag (@tags) {
  174:         push @helperTags, [$namespace, $tag];
  175:     }
  176: }
  177: 
  178: BEGIN {
  179:     Apache::lonxml::register('Apache::lonhelper', 
  180:                              ('helper'));
  181:       register('Apache::lonhelper', ('state'));
  182: }
  183: 
  184: # Since all helpers are only three levels deep (helper tag, state tag, 
  185: # substate type), it's easier and more readble to explicitly track 
  186: # those three things directly, rather then futz with the tag stack 
  187: # every time.
  188: my $helper;
  189: my $state;
  190: my $substate;
  191: # To collect parameters, the contents of the subtags are collected
  192: # into this paramHash, then passed to the element object when the 
  193: # end of the element tag is located.
  194: my $paramHash; 
  195: 
  196: # Note from Jeremy 5-8-2003: It is *vital* that the real handler be called
  197: # as a subroutine from the handler, or very mysterious things might happen.
  198: # I don't know exactly why, but it seems that the scope where the Apache
  199: # server enters the perl handler is treated differently from the rest of
  200: # the handler. This also seems to manifest itself in the debugger as entering
  201: # the perl handler in seemingly random places (sometimes it starts in the
  202: # compiling phase, sometimes in the handler execution phase where it runs
  203: # the code and stepping into the "1;" the module ends with goes into the handler,
  204: # sometimes starting directly with the handler); I think the cause is related.
  205: # In the debugger, this means that breakpoints are ignored until you step into
  206: # a function and get out of what must be a "faked up scope" in the Apache->
  207: # mod_perl connection. In this code, it was manifesting itself in the existence
  208: # of two seperate file-scoped $helper variables, one set to the value of the
  209: # helper in the helper constructor, and one referenced by the handler on the
  210: # "$helper->process()" line. The second was therefore never set, and was still
  211: # undefined when I tried to call process on it.
  212: # By pushing the "real handler" down into the "real scope", everybody except the 
  213: # actual handler function directly below this comment gets the same $helper and
  214: # everybody is happy.
  215: # The upshot of all of this is that for safety when a handler is  using 
  216: # file-scoped variables in LON-CAPA, the handler should be pushed down one 
  217: # call level, as I do here, to ensure that the top-level handler function does
  218: # not get a different file scope from the rest of the code.
  219: sub handler {
  220:     my $r = shift;
  221:     return real_handler($r);
  222: }
  223: 
  224: # For debugging purposes, one can send a second parameter into this
  225: # function, the 'uri' of the helper you wish to have rendered, and
  226: # call this from other handlers.
  227: sub real_handler {
  228:     my $r = shift;
  229:     my $uri = shift;
  230:     if (!defined($uri)) { $uri = $r->uri(); }
  231:     $ENV{'request.uri'} = $uri;
  232:     my $filename = '/home/httpd/html' . $uri;
  233:     my $fh = Apache::File->new($filename);
  234:     my $file;
  235:     read $fh, $file, 100000000;
  236: 
  237:     # Send header, don't cache this page
  238:     if ($r->header_only) {
  239:         if ($ENV{'browser.mathml'}) {
  240:             $r->content_type('text/xml');
  241:         } else {
  242:             $r->content_type('text/html');
  243:         }
  244:         $r->send_http_header;
  245:         return OK;
  246:     }
  247:     if ($ENV{'browser.mathml'}) {
  248:         $r->content_type('text/xml');
  249:     } else {
  250:         $r->content_type('text/html');
  251:     }
  252:     $r->send_http_header;
  253:     $r->rflush();
  254: 
  255:     # Discard result, we just want the objects that get created by the
  256:     # xml parsing
  257:     &Apache::lonxml::xmlparse($r, 'helper', $file);
  258: 
  259:     $helper->process();
  260: 
  261:     $r->print($helper->display());
  262:    return OK;
  263: }
  264: 
  265: sub registerHelperTags {
  266:     for my $tagList (@helperTags) {
  267:         Apache::lonxml::register($tagList->[0], $tagList->[1]);
  268:     }
  269: }
  270: 
  271: sub unregisterHelperTags {
  272:     for my $tagList (@helperTags) {
  273:         Apache::lonxml::deregister($tagList->[0], $tagList->[1]);
  274:     }
  275: }
  276: 
  277: sub start_helper {
  278:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  279: 
  280:     if ($target ne 'helper') {
  281:         return '';
  282:     }
  283: 
  284:     registerHelperTags();
  285: 
  286:     Apache::lonhelper::helper->new($token->[2]{'title'});
  287:     return '';
  288: }
  289: 
  290: sub end_helper {
  291:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  292:     
  293:     if ($target ne 'helper') {
  294:         return '';
  295:     }
  296: 
  297:     unregisterHelperTags();
  298: 
  299:     return '';
  300: }
  301: 
  302: sub start_state {
  303:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  304: 
  305:     if ($target ne 'helper') {
  306:         return '';
  307:     }
  308: 
  309:     Apache::lonhelper::state->new($token->[2]{'name'},
  310:                                   $token->[2]{'title'});
  311:     return '';
  312: }
  313: 
  314: # Use this to get the param hash from other files.
  315: sub getParamHash {
  316:     return $paramHash;
  317: }
  318: 
  319: # Use this to get the helper, if implementing elements in other files
  320: # (like lonprintout.pm)
  321: sub getHelper {
  322:     return $helper;
  323: }
  324: 
  325: # don't need this, so ignore it
  326: sub end_state {
  327:     return '';
  328: }
  329: 
  330: 1;
  331: 
  332: package Apache::lonhelper::helper;
  333: 
  334: use Digest::MD5 qw(md5_hex);
  335: use HTML::Entities;
  336: use Apache::loncommon;
  337: use Apache::File;
  338: 
  339: sub new {
  340:     my $proto = shift;
  341:     my $class = ref($proto) || $proto;
  342:     my $self = {};
  343: 
  344:     $self->{TITLE} = shift;
  345:     
  346:     Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
  347: 
  348:     # If there is a state from the previous form, use that. If there is no
  349:     # state, use the start state parameter.
  350:     if (defined $ENV{"form.CURRENT_STATE"})
  351:     {
  352: 	$self->{STATE} = $ENV{"form.CURRENT_STATE"};
  353:     }
  354:     else
  355:     {
  356: 	$self->{STATE} = "START";
  357:     }
  358: 
  359:     $self->{TOKEN} = $ENV{'form.TOKEN'};
  360:     # If a token was passed, we load that in. Otherwise, we need to create a 
  361:     # new storage file
  362:     # Tried to use standard Tie'd hashes, but you can't seem to take a 
  363:     # reference to a tied hash and write to it. I'd call that a wart.
  364:     if ($self->{TOKEN}) {
  365:         # Validate the token before trusting it
  366:         if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) {
  367:             # Not legit. Return nothing and let all hell break loose.
  368:             # User shouldn't be doing that!
  369:             return undef;
  370:         }
  371: 
  372:         # Get the hash.
  373:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file
  374:         
  375:         my $file = Apache::File->new($self->{FILENAME});
  376:         my $contents = <$file>;
  377: 
  378:         # Now load in the contents
  379:         for my $value (split (/&/, $contents)) {
  380:             my ($name, $value) = split(/=/, $value);
  381:             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  382:             $self->{VARS}->{$name} = $value;
  383:         }
  384: 
  385:         $file->close();
  386:     } else {
  387:         # Only valid if we're just starting.
  388:         if ($self->{STATE} ne 'START') {
  389:             return undef;
  390:         }
  391:         # Must create the storage
  392:         $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} .
  393:                                  time() . rand());
  394:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN});
  395:     }
  396: 
  397:     # OK, we now have our persistent storage.
  398: 
  399:     if (defined $ENV{"form.RETURN_PAGE"})
  400:     {
  401: 	$self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"};
  402:     }
  403:     else
  404:     {
  405: 	$self->{RETURN_PAGE} = $ENV{REFERER};
  406:     }
  407: 
  408:     $self->{STATES} = {};
  409:     $self->{DONE} = 0;
  410: 
  411:     # Used by various helpers for various things; see lonparm.helper
  412:     # for an example.
  413:     $self->{DATA} = {};
  414: 
  415:     $helper = $self;
  416: 
  417:     # Establish the $paramHash
  418:     $paramHash = {};
  419: 
  420:     bless($self, $class);
  421:     return $self;
  422: }
  423: 
  424: # Private function; returns a string to construct the hidden fields
  425: # necessary to have the helper track state.
  426: sub _saveVars {
  427:     my $self = shift;
  428:     my $result = "";
  429:     $result .= '<input type="hidden" name="CURRENT_STATE" value="' .
  430:         HTML::Entities::encode($self->{STATE}) . "\" />\n";
  431:     $result .= '<input type="hidden" name="TOKEN" value="' .
  432:         $self->{TOKEN} . "\" />\n";
  433:     $result .= '<input type="hidden" name="RETURN_PAGE" value="' .
  434:         HTML::Entities::encode($self->{RETURN_PAGE}) . "\" />\n";
  435: 
  436:     return $result;
  437: }
  438: 
  439: # Private function: Create the querystring-like representation of the stored
  440: # data to write to disk.
  441: sub _varsInFile {
  442:     my $self = shift;
  443:     my @vars = ();
  444:     for my $key (keys %{$self->{VARS}}) {
  445:         push @vars, &Apache::lonnet::escape($key) . '=' .
  446:             &Apache::lonnet::escape($self->{VARS}->{$key});
  447:     }
  448:     return join ('&', @vars);
  449: }
  450: 
  451: # Use this to declare variables.
  452: # FIXME: Document this
  453: sub declareVar {
  454:     my $self = shift;
  455:     my $var = shift;
  456: 
  457:     if (!defined($self->{VARS}->{$var})) {
  458:         $self->{VARS}->{$var} = '';
  459:     }
  460: 
  461:     my $envname = 'form.' . $var . '.forminput';
  462:     if (defined($ENV{$envname})) {
  463:         $self->{VARS}->{$var} = $ENV{$envname};
  464:     }
  465: }
  466: 
  467: sub changeState {
  468:     my $self = shift;
  469:     $self->{STATE} = shift;
  470: }
  471: 
  472: sub registerState {
  473:     my $self = shift;
  474:     my $state = shift;
  475: 
  476:     my $stateName = $state->name();
  477:     $self->{STATES}{$stateName} = $state;
  478: }
  479: 
  480: sub process {
  481:     my $self = shift;
  482: 
  483:     # Phase 1: Post processing for state of previous screen (which is actually
  484:     # the "current state" in terms of the helper variables), if it wasn't the 
  485:     # beginning state.
  486:     if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq "Next ->") {
  487: 	my $prevState = $self->{STATES}{$self->{STATE}};
  488:         $prevState->postprocess();
  489:     }
  490:     
  491:     # Note, to handle errors in a state's input that a user must correct,
  492:     # do not transition in the postprocess, and force the user to correct
  493:     # the error.
  494: 
  495:     # Phase 2: Preprocess current state
  496:     my $startState = $self->{STATE};
  497:     my $state = $self->{STATES}->{$startState};
  498:     
  499:     # For debugging, print something here to determine if you're going
  500:     # to an undefined state.
  501:     if (!defined($state)) {
  502:         return;
  503:     }
  504:     $state->preprocess();
  505: 
  506:     # Phase 3: While the current state is different from the previous state,
  507:     # keep processing.
  508:     while ( $startState ne $self->{STATE} && 
  509:             defined($self->{STATES}->{$self->{STATE}}) )
  510:     {
  511: 	$startState = $self->{STATE};
  512: 	$state = $self->{STATES}->{$startState};
  513: 	$state->preprocess();
  514:     }
  515: 
  516:     return;
  517: } 
  518: 
  519: # 1: Do the post processing for the previous state.
  520: # 2: Do the preprocessing for the current state.
  521: # 3: Check to see if state changed, if so, postprocess current and move to next.
  522: #    Repeat until state stays stable.
  523: # 4: Render the current state to the screen as an HTML page.
  524: sub display {
  525:     my $self = shift;
  526: 
  527:     my $state = $self->{STATES}{$self->{STATE}};
  528: 
  529:     my $result = "";
  530: 
  531:     if (!defined($state)) {
  532:         $result = "<font color='#ff0000'>Error: state '$state' not defined!</font>";
  533:         return $result;
  534:     }
  535: 
  536:     # Phase 4: Display.
  537:     my $stateTitle = $state->title();
  538:     my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'','');
  539: 
  540:     $result .= <<HEADER;
  541: <html>
  542:     <head>
  543:         <title>LON-CAPA Helper: $self->{TITLE}</title>
  544:     </head>
  545:     $bodytag
  546: HEADER
  547:     if (!$state->overrideForm()) { $result.="<form name='helpform' method='GET'>"; }
  548:     $result .= <<HEADER;
  549:         <table border="0"><tr><td>
  550:         <h2><i>$stateTitle</i></h2>
  551: HEADER
  552: 
  553:     if (!$state->overrideForm()) {
  554:         $result .= $self->_saveVars();
  555:     }
  556:     $result .= $state->render() . "<p>&nbsp;</p>";
  557: 
  558:     if (!$state->overrideForm()) {
  559:         $result .= '<center>';
  560:         if ($self->{STATE} ne $self->{START_STATE}) {
  561:             #$result .= '<input name="SUBMIT" type="submit" value="&lt;- Previous" />&nbsp;&nbsp;';
  562:         }
  563:         if ($self->{DONE}) {
  564:             my $returnPage = $self->{RETURN_PAGE};
  565:             $result .= "<a href=\"$returnPage\">End Helper</a>";
  566:         }
  567:         else {
  568:             $result .= '<input name="back" type="button" ';
  569:             $result .= 'value="&lt;- Previous" onclick="history.go(-1)" /> ';
  570:             $result .= '<input name="SUBMIT" type="submit" value="Next -&gt;" />';
  571:         }
  572:         $result .= "</center>\n";
  573:     }
  574: 
  575:     #foreach my $key (keys %{$self->{VARS}}) {
  576:     #    $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />";
  577:     #}
  578: 
  579:     $result .= <<FOOTER;
  580:               </td>
  581:             </tr>
  582:           </table>
  583:         </form>
  584:     </body>
  585: </html>
  586: FOOTER
  587: 
  588:     # Handle writing out the vars to the file
  589:     my $file = Apache::File->new('>'.$self->{FILENAME});
  590:     print $file $self->_varsInFile();
  591: 
  592:     return $result;
  593: }
  594: 
  595: 1;
  596: 
  597: package Apache::lonhelper::state;
  598: 
  599: # States bundle things together and are responsible for compositing the
  600: # various elements together. It is not generally necessary for users to
  601: # use the state object directly, so it is not perldoc'ed.
  602: 
  603: # Basically, all the states do is pass calls to the elements and aggregate
  604: # the results.
  605: 
  606: sub new {
  607:     my $proto = shift;
  608:     my $class = ref($proto) || $proto;
  609:     my $self = {};
  610: 
  611:     $self->{NAME} = shift;
  612:     $self->{TITLE} = shift;
  613:     $self->{ELEMENTS} = [];
  614: 
  615:     bless($self, $class);
  616: 
  617:     $helper->registerState($self);
  618: 
  619:     $state = $self;
  620: 
  621:     return $self;
  622: }
  623: 
  624: sub name {
  625:     my $self = shift;
  626:     return $self->{NAME};
  627: }
  628: 
  629: sub title {
  630:     my $self = shift;
  631:     return $self->{TITLE};
  632: }
  633: 
  634: sub preprocess {
  635:     my $self = shift;
  636:     for my $element (@{$self->{ELEMENTS}}) {
  637:         $element->preprocess();
  638:     }
  639: }
  640: 
  641: # FIXME: Document that all postprocesses must return a true value or
  642: # the state transition will be overridden
  643: sub postprocess {
  644:     my $self = shift;
  645: 
  646:     # Save the state so we can roll it back if we need to.
  647:     my $originalState = $helper->{STATE};
  648:     my $everythingSuccessful = 1;
  649: 
  650:     for my $element (@{$self->{ELEMENTS}}) {
  651:         my $result = $element->postprocess();
  652:         if (!$result) { $everythingSuccessful = 0; }
  653:     }
  654: 
  655:     # If not all the postprocesses were successful, override
  656:     # any state transitions that may have occurred. It is the
  657:     # responsibility of the states to make sure they have 
  658:     # error handling in that case.
  659:     if (!$everythingSuccessful) {
  660:         $helper->{STATE} = $originalState;
  661:     }
  662: }
  663: 
  664: # Override the form if any element wants to.
  665: # two elements overriding the form will make a mess, but that should
  666: # be considered helper author error ;-)
  667: sub overrideForm {
  668:     my $self = shift;
  669:     for my $element (@{$self->{ELEMENTS}}) {
  670:         if ($element->overrideForm()) {
  671:             return 1;
  672:         }
  673:     }
  674:     return 0;
  675: }
  676: 
  677: sub addElement {
  678:     my $self = shift;
  679:     my $element = shift;
  680:     
  681:     push @{$self->{ELEMENTS}}, $element;
  682: }
  683: 
  684: sub render {
  685:     my $self = shift;
  686:     my @results = ();
  687: 
  688:     for my $element (@{$self->{ELEMENTS}}) {
  689:         push @results, $element->render();
  690:     }
  691:     return join("\n", @results);
  692: }
  693: 
  694: 1;
  695: 
  696: package Apache::lonhelper::element;
  697: # Support code for elements
  698: 
  699: =pod
  700: 
  701: =head2 Element Base Class
  702: 
  703: The Apache::lonhelper::element base class provides support methods for
  704: the elements to use, such as a multiple value processer.
  705: 
  706: B<Methods>:
  707: 
  708: =over 4
  709: 
  710: =item * process_multiple_choices(formName, varName): Process the form 
  711: element named "formName" and place the selected items into the helper 
  712: variable named varName. This is for things like checkboxes or 
  713: multiple-selection listboxes where the user can select more then 
  714: one entry. The selected entries are delimited by triple pipes in 
  715: the helper variables, like this:  
  716: 
  717:  CHOICE_1|||CHOICE_2|||CHOICE_3
  718: 
  719: =back
  720: 
  721: B<finalcode tag>
  722: 
  723: Each element can contain a "finalcode" tag that, when the special FINAL
  724: helper state is used, will be executed, surrounded by "sub { my $helper = shift;"
  725: and "}". It is expected to return a string describing what it did, which 
  726: may be an empty string. See course initialization helper for an example. This is
  727: generally intended for helpers like the course initialization helper, which consist
  728: of several panels, each of which is performing some sort of bite-sized functionality.
  729: 
  730: B<defaultvalue tag>
  731: 
  732: Each element that accepts user input can contain a "defaultvalue" tag that,
  733: when surrounded by "sub { my $helper = shift; my $state = shift; " and "}",
  734: will form a subroutine that when called will provide a default value for
  735: the element. How this value is interpreted by the element is specific to
  736: the element itself, and possibly the settings the element has (such as 
  737: multichoice vs. single choice for <choices> tags). 
  738: 
  739: This is also intended for things like the course initialization wizard, where the
  740: user is setting various parameters. By correctly grabbing current settings 
  741: and including them into the helper, it allows the user to come back to the
  742: helper later and re-execute it, without needing to worry about overwriting
  743: some setting accidentally.
  744: 
  745: Again, see the course initialization helper for examples.
  746: 
  747: =cut
  748: 
  749: BEGIN {
  750:     &Apache::lonhelper::register('Apache::lonhelper::element',
  751:                                  ('nextstate', 'finalcode',
  752:                                   'defaultvalue'));
  753: }
  754: 
  755: # Because we use the param hash, this is often a sufficent
  756: # constructor
  757: sub new {
  758:     my $proto = shift;
  759:     my $class = ref($proto) || $proto;
  760:     my $self = $paramHash;
  761:     bless($self, $class);
  762: 
  763:     $self->{PARAMS} = $paramHash;
  764:     $self->{STATE} = $state;
  765:     $state->addElement($self);
  766:     
  767:     # Ensure param hash is not reused
  768:     $paramHash = {};
  769: 
  770:     return $self;
  771: }   
  772: 
  773: sub start_nextstate {
  774:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  775: 
  776:     if ($target ne 'helper') {
  777:         return '';
  778:     }
  779:     
  780:     $paramHash->{NEXTSTATE} = &Apache::lonxml::get_all_text('/nextstate',
  781:                                                              $parser);
  782:     return '';
  783: }
  784: 
  785: sub end_nextstate { return ''; }
  786: 
  787: sub start_finalcode {
  788:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  789: 
  790:     if ($target ne 'helper') {
  791:         return '';
  792:     }
  793:     
  794:     $paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode',
  795:                                                              $parser);
  796:     return '';
  797: }
  798: 
  799: sub end_finalcode { return ''; }
  800: 
  801: sub start_defaultvalue {
  802:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  803: 
  804:     if ($target ne 'helper') {
  805:         return '';
  806:     }
  807:     
  808:     $paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue',
  809:                                                              $parser);
  810:     $paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' .
  811:         $paramHash->{DEFAULT_VALUE} . '}';
  812:     return '';
  813: }
  814: 
  815: sub end_defaultvalue { return ''; }
  816: 
  817: sub preprocess {
  818:     return 1;
  819: }
  820: 
  821: sub postprocess {
  822:     return 1;
  823: }
  824: 
  825: sub render {
  826:     return '';
  827: }
  828: 
  829: sub overrideForm {
  830:     return 0;
  831: }
  832: 
  833: sub process_multiple_choices {
  834:     my $self = shift;
  835:     my $formname = shift;
  836:     my $var = shift;
  837: 
  838:     # Must extract values from data directly, as there
  839:     # may be more then one.
  840:     my @values;
  841:     for my $formparam (split (/&/, $ENV{QUERY_STRING})) {
  842:         my ($name, $value) = split(/=/, $formparam);
  843:         if ($name ne $formname) {
  844:             next;
  845:         }
  846:         $value =~ tr/+/ /;
  847:         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  848:         push @values, $value;
  849:     }
  850:     $helper->{VARS}->{$var} = join('|||', @values);
  851:     
  852:     return;
  853: }
  854: 
  855: 1;
  856: 
  857: package Apache::lonhelper::message;
  858: 
  859: =pod
  860: 
  861: =head2 Element: message
  862: 
  863: Message elements display the contents of their <message_text> tags, and
  864: transition directly to the state in the <nextstate> tag. Example:
  865: 
  866:  <message>
  867:    <nextstate>GET_NAME</nextstate>
  868:    <message_text>This is the <b>message</b> the user will see, 
  869:                  <i>HTML allowed</i>.</message_text>
  870:    </message>
  871: 
  872: This will display the HTML message and transition to the <nextstate> if
  873: given. The HTML will be directly inserted into the helper, so if you don't
  874: want text to run together, you'll need to manually wrap the <message_text>
  875: in <p> tags, or whatever is appropriate for your HTML.
  876: 
  877: Message tags do not add in whitespace, so if you want it, you'll need to add
  878: it into states. This is done so you can inline some elements, such as 
  879: the <date> element, right between two messages, giving the appearence that 
  880: the <date> element appears inline. (Note the elements can not be embedded
  881: within each other.)
  882: 
  883: This is also a good template for creating your own new states, as it has
  884: very little code beyond the state template.
  885: 
  886: =cut
  887: 
  888: no strict;
  889: @ISA = ("Apache::lonhelper::element");
  890: use strict;
  891: 
  892: BEGIN {
  893:     &Apache::lonhelper::register('Apache::lonhelper::message',
  894:                               ('message'));
  895: }
  896: 
  897: sub new {
  898:     my $ref = Apache::lonhelper::element->new();
  899:     bless($ref);
  900: }
  901: 
  902: # CONSTRUCTION: Construct the message element from the XML
  903: sub start_message {
  904:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  905: 
  906:     if ($target ne 'helper') {
  907:         return '';
  908:     }
  909: 
  910:     $paramHash->{MESSAGE_TEXT} = &Apache::lonxml::get_all_text('/message',
  911:                                                                $parser);
  912: 
  913:     if (defined($token->[2]{'nextstate'})) {
  914:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
  915:     }
  916:     return '';
  917: }
  918: 
  919: sub end_message {
  920:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  921: 
  922:     if ($target ne 'helper') {
  923:         return '';
  924:     }
  925:     Apache::lonhelper::message->new();
  926:     return '';
  927: }
  928: 
  929: sub render {
  930:     my $self = shift;
  931: 
  932:     return $self->{MESSAGE_TEXT};
  933: }
  934: # If a NEXTSTATE was given, switch to it
  935: sub postprocess {
  936:     my $self = shift;
  937:     if (defined($self->{NEXTSTATE})) {
  938:         $helper->changeState($self->{NEXTSTATE});
  939:     }
  940: 
  941:     return 1;
  942: }
  943: 1;
  944: 
  945: package Apache::lonhelper::choices;
  946: 
  947: =pod
  948: 
  949: =head2 Element: choices
  950: 
  951: Choice states provide a single choice to the user as a text selection box.
  952: A "choice" is two pieces of text, one which will be displayed to the user
  953: (the "human" value), and one which will be passed back to the program
  954: (the "computer" value). For instance, a human may choose from a list of
  955: resources on disk by title, while your program wants the file name.
  956: 
  957: <choices> takes an attribute "variable" to control which helper variable
  958: the result is stored in.
  959: 
  960: <choices> takes an attribute "multichoice" which, if set to a true
  961: value, will allow the user to select multiple choices.
  962: 
  963: B<SUB-TAGS>
  964: 
  965: <choices> can have the following subtags:
  966: 
  967: =over 4
  968: 
  969: =item * <nextstate>state_name</nextstate>: If given, this will cause the
  970:       choice element to transition to the given state after executing. If
  971:       this is used, do not pass nextstates to the <choice> tag.
  972: 
  973: =item * <choice />: If the choices are static,
  974:       this element will allow you to specify them. Each choice
  975:       contains  attribute, "computer", as described above. The
  976:       content of the tag will be used as the human label.
  977:       For example,  
  978:       <choice computer='234-12-7312'>Bobby McDormik</choice>.
  979: 
  980:       <choice> can take a parameter "eval", which if set to
  981:       a true value, will cause the contents of the tag to be
  982:       evaluated as it would be in an <eval> tag; see <eval> tag
  983:       below.
  984: 
  985: <choice> may optionally contain a 'nextstate' attribute, which
  986: will be the state transisitoned to if the choice is made, if
  987: the choice is not multichoice.
  988: 
  989: =back
  990: 
  991: To create the choices programmatically, either wrap the choices in 
  992: <condition> tags (prefered), or use an <exec> block inside the <choice>
  993: tag. Store the choices in $state->{CHOICES}, which is a list of list
  994: references, where each list has three strings. The first is the human
  995: name, the second is the computer name. and the third is the option
  996: next state. For example:
  997: 
  998:  <exec>
  999:     for (my $i = 65; $i < 65 + 26; $i++) {
 1000:         push @{$state->{CHOICES}}, [chr($i), $i, 'next'];
 1001:     }
 1002:  </exec>
 1003: 
 1004: This will allow the user to select from the letters A-Z (in ASCII), while
 1005: passing the ASCII value back into the helper variables, and the state
 1006: will in all cases transition to 'next'.
 1007: 
 1008: You can mix and match methods of creating choices, as long as you always 
 1009: "push" onto the choice list, rather then wiping it out. (You can even 
 1010: remove choices programmatically, but that would probably be bad form.)
 1011: 
 1012: B<defaultvalue support>
 1013: 
 1014: Choices supports default values both in multichoice and single choice mode.
 1015: In single choice mode, have the defaultvalue tag's function return the 
 1016: computer value of the box you want checked. If the function returns a value
 1017: that does not correspond to any of the choices, the default behavior of selecting
 1018: the first choice will be preserved.
 1019: 
 1020: For multichoice, return a string with the computer values you want checked,
 1021: delimited by triple pipes. Note this matches how the result of the <choices>
 1022: tag is stored in the {VARS} hash.
 1023: 
 1024: =cut
 1025: 
 1026: no strict;
 1027: @ISA = ("Apache::lonhelper::element");
 1028: use strict;
 1029: 
 1030: BEGIN {
 1031:     &Apache::lonhelper::register('Apache::lonhelper::choices',
 1032:                               ('choice', 'choices'));
 1033: }
 1034: 
 1035: sub new {
 1036:     my $ref = Apache::lonhelper::element->new();
 1037:     bless($ref);
 1038: }
 1039: 
 1040: # CONSTRUCTION: Construct the message element from the XML
 1041: sub start_choices {
 1042:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1043: 
 1044:     if ($target ne 'helper') {
 1045:         return '';
 1046:     }
 1047: 
 1048:     # Need to initialize the choices list, so everything can assume it exists
 1049:     $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'}));
 1050:     $helper->declareVar($paramHash->{'variable'});
 1051:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1052:     $paramHash->{CHOICES} = [];
 1053:     return '';
 1054: }
 1055: 
 1056: sub end_choices {
 1057:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1058: 
 1059:     if ($target ne 'helper') {
 1060:         return '';
 1061:     }
 1062:     Apache::lonhelper::choices->new();
 1063:     return '';
 1064: }
 1065: 
 1066: sub start_choice {
 1067:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1068: 
 1069:     if ($target ne 'helper') {
 1070:         return '';
 1071:     }
 1072: 
 1073:     my $computer = $token->[2]{'computer'};
 1074:     my $human = &Apache::lonxml::get_all_text('/choice',
 1075:                                               $parser);
 1076:     my $nextstate = $token->[2]{'nextstate'};
 1077:     my $evalFlag = $token->[2]{'eval'};
 1078:     push @{$paramHash->{CHOICES}}, [$human, $computer, $nextstate, 
 1079:                                     $evalFlag];
 1080:     return '';
 1081: }
 1082: 
 1083: sub end_choice {
 1084:     return '';
 1085: }
 1086: 
 1087: sub render {
 1088:     # START HERE: Replace this with correct choices code.
 1089:     my $self = shift;
 1090:     my $var = $self->{'variable'};
 1091:     my $buttons = '';
 1092:     my $result = '';
 1093: 
 1094:     if ($self->{'multichoice'}) {
 1095:         $result .= <<SCRIPT;
 1096: <script>
 1097:     function checkall(value, checkName) {
 1098: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 1099:             ele = document.forms.helpform.elements[i];
 1100:             if (ele.name == checkName + '.forminput') {
 1101:                 document.forms.helpform.elements[i].checked=value;
 1102:             }
 1103:         }
 1104:     }
 1105: </script>
 1106: SCRIPT
 1107:     }
 1108: 
 1109:     # Only print "select all" and "unselect all" if there are five or
 1110:     # more choices; fewer then that and it looks silly.
 1111:     if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) {
 1112:         $buttons = <<BUTTONS;
 1113: <br />
 1114: <input type="button" onclick="checkall(true, '$var')" value="Select All" />
 1115: <input type="button" onclick="checkall(false, '$var')" value="Unselect All" />
 1116: <br />&nbsp;
 1117: BUTTONS
 1118:     }
 1119: 
 1120:     if (defined $self->{ERROR_MSG}) {
 1121:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />';
 1122:     }
 1123: 
 1124:     $result .= $buttons;
 1125:     
 1126:     $result .= "<table>\n\n";
 1127: 
 1128:     my %checkedChoices;
 1129:     my $checkedChoicesFunc;
 1130: 
 1131:     if (defined($self->{DEFAULT_VALUE})) {
 1132:         $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE});
 1133:         die 'Error in default value code for variable ' . 
 1134:             {'variable'} . ', Perl said:' . $@ if $@;
 1135:     } else {
 1136:         $checkedChoicesFunc = sub { return ''; };
 1137:     }
 1138: 
 1139:     # Process which choices should be checked.
 1140:     if ($self->{'multichoice'}) {
 1141:         for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) {
 1142:             $checkedChoices{$selectedChoice} = 1;
 1143:         }
 1144:     } else {
 1145:         # single choice
 1146:         my $selectedChoice = &$checkedChoicesFunc($helper, $self);
 1147:         
 1148:         my $foundChoice = 0;
 1149:         
 1150:         # check that the choice is in the list of choices.
 1151:         for my $choice (@{$self->{CHOICES}}) {
 1152:             if ($choice->[1] eq $selectedChoice) {
 1153:                 $checkedChoices{$choice->[1]} = 1;
 1154:                 $foundChoice = 1;
 1155:             }
 1156:         }
 1157:         
 1158:         # If we couldn't find the choice, pick the first one 
 1159:         if (!$foundChoice) {
 1160:             $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1;
 1161:         }
 1162:     }
 1163: 
 1164:     my $type = "radio";
 1165:     if ($self->{'multichoice'}) { $type = 'checkbox'; }
 1166:     foreach my $choice (@{$self->{CHOICES}}) {
 1167:         $result .= "<tr>\n<td width='20'>&nbsp;</td>\n";
 1168:         $result .= "<td valign='top'><input type='$type' name='$var.forminput'"
 1169:             . "' value='" . 
 1170:             HTML::Entities::encode($choice->[1]) 
 1171:             . "'";
 1172:         if ($checkedChoices{$choice->[1]}) {
 1173:             $result .= " checked ";
 1174:         }
 1175:         my $choiceLabel = $choice->[0];
 1176:         if ($choice->[4]) {  # if we need to evaluate this choice
 1177:             $choiceLabel = "sub { my $helper = shift; my $state = shift;" .
 1178:                 $choiceLabel . "}";
 1179:             $choiceLabel = eval($choiceLabel);
 1180:             $choiceLabel = &$choiceLabel($helper, $self);
 1181:         }
 1182:         $result .= "/></td><td> " . $choiceLabel . "</td></tr>\n";
 1183:     }
 1184:     $result .= "</table>\n\n\n";
 1185:     $result .= $buttons;
 1186: 
 1187:     return $result;
 1188: }
 1189: 
 1190: # If a NEXTSTATE was given or a nextstate for this choice was
 1191: # given, switch to it
 1192: sub postprocess {
 1193:     my $self = shift;
 1194:     my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};
 1195: 
 1196:     if (!defined($chosenValue)) {
 1197:         $self->{ERROR_MSG} = "You must choose one or more choices to" .
 1198:             " continue.";
 1199:         return 0;
 1200:     }
 1201: 
 1202:     if ($self->{'multichoice'}) {
 1203:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
 1204:                                         $self->{'variable'});
 1205:     }
 1206: 
 1207:     if (defined($self->{NEXTSTATE})) {
 1208:         $helper->changeState($self->{NEXTSTATE});
 1209:     }
 1210:     
 1211:     foreach my $choice (@{$self->{CHOICES}}) {
 1212:         if ($choice->[1] eq $chosenValue) {
 1213:             if (defined($choice->[2])) {
 1214:                 $helper->changeState($choice->[2]);
 1215:             }
 1216:         }
 1217:     }
 1218:     return 1;
 1219: }
 1220: 1;
 1221: 
 1222: package Apache::lonhelper::date;
 1223: 
 1224: =pod
 1225: 
 1226: =head2 Element: date
 1227: 
 1228: Date elements allow the selection of a date with a drop down list.
 1229: 
 1230: Date elements can take two attributes:
 1231: 
 1232: =over 4
 1233: 
 1234: =item * B<variable>: The name of the variable to store the chosen
 1235:         date in. Required.
 1236: 
 1237: =item * B<hoursminutes>: If a true value, the date will show hours
 1238:         and minutes, as well as month/day/year. If false or missing,
 1239:         the date will only show the month, day, and year.
 1240: 
 1241: =back
 1242: 
 1243: Date elements contain only an option <nextstate> tag to determine
 1244: the next state.
 1245: 
 1246: Example:
 1247: 
 1248:  <date variable="DUE_DATE" hoursminutes="1">
 1249:    <nextstate>choose_why</nextstate>
 1250:    </date>
 1251: 
 1252: =cut
 1253: 
 1254: no strict;
 1255: @ISA = ("Apache::lonhelper::element");
 1256: use strict;
 1257: 
 1258: use Time::localtime;
 1259: 
 1260: BEGIN {
 1261:     &Apache::lonhelper::register('Apache::lonhelper::date',
 1262:                               ('date'));
 1263: }
 1264: 
 1265: # Don't need to override the "new" from element
 1266: sub new {
 1267:     my $ref = Apache::lonhelper::element->new();
 1268:     bless($ref);
 1269: }
 1270: 
 1271: my @months = ("January", "February", "March", "April", "May", "June", "July",
 1272: 	      "August", "September", "October", "November", "December");
 1273: 
 1274: # CONSTRUCTION: Construct the message element from the XML
 1275: sub start_date {
 1276:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1277: 
 1278:     if ($target ne 'helper') {
 1279:         return '';
 1280:     }
 1281: 
 1282:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1283:     $helper->declareVar($paramHash->{'variable'});
 1284:     $paramHash->{'hoursminutes'} = $token->[2]{'hoursminutes'};
 1285: }
 1286: 
 1287: sub end_date {
 1288:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1289: 
 1290:     if ($target ne 'helper') {
 1291:         return '';
 1292:     }
 1293:     Apache::lonhelper::date->new();
 1294:     return '';
 1295: }
 1296: 
 1297: sub render {
 1298:     my $self = shift;
 1299:     my $result = "";
 1300:     my $var = $self->{'variable'};
 1301: 
 1302:     my $date;
 1303:     
 1304:     # Default date: The current hour.
 1305:     $date = localtime();
 1306:     $date->min(0);
 1307: 
 1308:     if (defined $self->{ERROR_MSG}) {
 1309:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 1310:     }
 1311: 
 1312:     # Month
 1313:     my $i;
 1314:     $result .= "<select name='${var}month'>\n";
 1315:     for ($i = 0; $i < 12; $i++) {
 1316:         if ($i == $date->mon) {
 1317:             $result .= "<option value='$i' selected>";
 1318:         } else {
 1319:             $result .= "<option value='$i'>";
 1320:         }
 1321:         $result .= $months[$i] . "</option>\n";
 1322:     }
 1323:     $result .= "</select>\n";
 1324: 
 1325:     # Day
 1326:     $result .= "<select name='${var}day'>\n";
 1327:     for ($i = 1; $i < 32; $i++) {
 1328:         if ($i == $date->mday) {
 1329:             $result .= '<option selected>';
 1330:         } else {
 1331:             $result .= '<option>';
 1332:         }
 1333:         $result .= "$i</option>\n";
 1334:     }
 1335:     $result .= "</select>,\n";
 1336: 
 1337:     # Year
 1338:     $result .= "<select name='${var}year'>\n";
 1339:     for ($i = 2000; $i < 2030; $i++) { # update this after 64-bit dates
 1340:         if ($date->year + 1900 == $i) {
 1341:             $result .= "<option selected>";
 1342:         } else {
 1343:             $result .= "<option>";
 1344:         }
 1345:         $result .= "$i</option>\n";
 1346:     }
 1347:     $result .= "</select>,\n";
 1348: 
 1349:     # Display Hours and Minutes if they are called for
 1350:     if ($self->{'hoursminutes'}) {
 1351:         # Build hour
 1352:         $result .= "<select name='${var}hour'>\n";
 1353:         $result .= "<option " . ($date->hour == 0 ? 'selected ':'') .
 1354:             " value='0'>midnight</option>\n";
 1355:         for ($i = 1; $i < 12; $i++) {
 1356:             if ($date->hour == $i) {
 1357:                 $result .= "<option selected value='$i'>$i a.m.</option>\n";
 1358:             } else {
 1359:                 $result .= "<option value='$i'>$i a.m</option>\n";
 1360:             }
 1361:         }
 1362:         $result .= "<option " . ($date->hour == 12 ? 'selected ':'') .
 1363:             " value='12'>noon</option>\n";
 1364:         for ($i = 13; $i < 24; $i++) {
 1365:             my $printedHour = $i - 12;
 1366:             if ($date->hour == $i) {
 1367:                 $result .= "<option selected value='$i'>$printedHour p.m.</option>\n";
 1368:             } else {
 1369:                 $result .= "<option value='$i'>$printedHour p.m.</option>\n";
 1370:             }
 1371:         }
 1372: 
 1373:         $result .= "</select> :\n";
 1374: 
 1375:         $result .= "<select name='${var}minute'>\n";
 1376:         for ($i = 0; $i < 60; $i++) {
 1377:             my $printedMinute = $i;
 1378:             if ($i < 10) {
 1379:                 $printedMinute = "0" . $printedMinute;
 1380:             }
 1381:             if ($date->min == $i) {
 1382:                 $result .= "<option selected>";
 1383:             } else {
 1384:                 $result .= "<option>";
 1385:             }
 1386:             $result .= "$printedMinute</option>\n";
 1387:         }
 1388:         $result .= "</select>\n";
 1389:     }
 1390: 
 1391:     return $result;
 1392: 
 1393: }
 1394: # If a NEXTSTATE was given, switch to it
 1395: sub postprocess {
 1396:     my $self = shift;
 1397:     my $var = $self->{'variable'};
 1398:     my $month = $ENV{'form.' . $var . 'month'}; 
 1399:     my $day = $ENV{'form.' . $var . 'day'}; 
 1400:     my $year = $ENV{'form.' . $var . 'year'}; 
 1401:     my $min = 0; 
 1402:     my $hour = 0;
 1403:     if ($self->{'hoursminutes'}) {
 1404:         $min = $ENV{'form.' . $var . 'minute'};
 1405:         $hour = $ENV{'form.' . $var . 'hour'};
 1406:     }
 1407: 
 1408:     my $chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year);
 1409:     # Check to make sure that the date was not automatically co-erced into a 
 1410:     # valid date, as we want to flag that as an error
 1411:     # This happens for "Feb. 31", for instance, which is coerced to March 2 or
 1412:     # 3, depending on if it's a leapyear
 1413:     my $checkDate = localtime($chosenDate);
 1414: 
 1415:     if ($checkDate->mon != $month || $checkDate->mday != $day ||
 1416:         $checkDate->year + 1900 != $year) {
 1417:         $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a "
 1418:             . "date because it doesn't exist. Please enter a valid date.";
 1419:         return 0;
 1420:     }
 1421: 
 1422:     $helper->{VARS}->{$var} = $chosenDate;
 1423: 
 1424:     if (defined($self->{NEXTSTATE})) {
 1425:         $helper->changeState($self->{NEXTSTATE});
 1426:     }
 1427: 
 1428:     return 1;
 1429: }
 1430: 1;
 1431: 
 1432: package Apache::lonhelper::resource;
 1433: 
 1434: =pod
 1435: 
 1436: =head2 Element: resource
 1437: 
 1438: <resource> elements allow the user to select one or multiple resources
 1439: from the current course. You can filter out which resources they can view,
 1440: and filter out which resources they can select. The course will always
 1441: be displayed fully expanded, because of the difficulty of maintaining
 1442: selections across folder openings and closings. If this is fixed, then
 1443: the user can manipulate the folders.
 1444: 
 1445: <resource> takes the standard variable attribute to control what helper
 1446: variable stores the results. It also takes a "multichoice" attribute,
 1447: which controls whether the user can select more then one resource. The 
 1448: "toponly" attribute controls whether the resource display shows just the
 1449: resources in that sequence, or recurses into all sub-sequences, defaulting
 1450: to false.
 1451: 
 1452: B<SUB-TAGS>
 1453: 
 1454: =over 4
 1455: 
 1456: =item * <filterfunc>: If you want to filter what resources are displayed
 1457:   to the user, use a filter func. The <filterfunc> tag should contain
 1458:   Perl code that when wrapped with "sub { my $res = shift; " and "}" is 
 1459:   a function that returns true if the resource should be displayed, 
 1460:   and false if it should be skipped. $res is a resource object. 
 1461:   (See Apache::lonnavmaps documentation for information about the 
 1462:   resource object.)
 1463: 
 1464: =item * <choicefunc>: Same as <filterfunc>, except that controls whether
 1465:   the given resource can be chosen. (It is almost always a good idea to
 1466:   show the user the folders, for instance, but you do not always want to 
 1467:   let the user select them.)
 1468: 
 1469: =item * <nextstate>: Standard nextstate behavior.
 1470: 
 1471: =item * <valuefunc>: This function controls what is returned by the resource
 1472:   when the user selects it. Like filterfunc and choicefunc, it should be
 1473:   a function fragment that when wrapped by "sub { my $res = shift; " and
 1474:   "}" returns a string representing what you want to have as the value. By
 1475:   default, the value will be the resource ID of the object ($res->{ID}).
 1476: 
 1477: =item * <mapurl>: If the URL of a map is given here, only that map
 1478:   will be displayed, instead of the whole course.
 1479: 
 1480: =back
 1481: 
 1482: =cut
 1483: 
 1484: no strict;
 1485: @ISA = ("Apache::lonhelper::element");
 1486: use strict;
 1487: 
 1488: BEGIN {
 1489:     &Apache::lonhelper::register('Apache::lonhelper::resource',
 1490:                               ('resource', 'filterfunc', 
 1491:                                'choicefunc', 'valuefunc',
 1492:                                'mapurl'));
 1493: }
 1494: 
 1495: sub new {
 1496:     my $ref = Apache::lonhelper::element->new();
 1497:     bless($ref);
 1498: }
 1499: 
 1500: # CONSTRUCTION: Construct the message element from the XML
 1501: sub start_resource {
 1502:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1503: 
 1504:     if ($target ne 'helper') {
 1505:         return '';
 1506:     }
 1507: 
 1508:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1509:     $helper->declareVar($paramHash->{'variable'});
 1510:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1511:     $paramHash->{'toponly'} = $token->[2]{'toponly'};
 1512:     return '';
 1513: }
 1514: 
 1515: sub end_resource {
 1516:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1517: 
 1518:     if ($target ne 'helper') {
 1519:         return '';
 1520:     }
 1521:     if (!defined($paramHash->{FILTER_FUNC})) {
 1522:         $paramHash->{FILTER_FUNC} = sub {return 1;};
 1523:     }
 1524:     if (!defined($paramHash->{CHOICE_FUNC})) {
 1525:         $paramHash->{CHOICE_FUNC} = sub {return 1;};
 1526:     }
 1527:     if (!defined($paramHash->{VALUE_FUNC})) {
 1528:         $paramHash->{VALUE_FUNC} = sub {my $res = shift; return $res->{ID}; };
 1529:     }
 1530:     Apache::lonhelper::resource->new();
 1531:     return '';
 1532: }
 1533: 
 1534: sub start_filterfunc {
 1535:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1536: 
 1537:     if ($target ne 'helper') {
 1538:         return '';
 1539:     }
 1540: 
 1541:     my $contents = Apache::lonxml::get_all_text('/filterfunc',
 1542:                                                 $parser);
 1543:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1544:     $paramHash->{FILTER_FUNC} = eval $contents;
 1545: }
 1546: 
 1547: sub end_filterfunc { return ''; }
 1548: 
 1549: sub start_choicefunc {
 1550:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1551: 
 1552:     if ($target ne 'helper') {
 1553:         return '';
 1554:     }
 1555: 
 1556:     my $contents = Apache::lonxml::get_all_text('/choicefunc',
 1557:                                                 $parser);
 1558:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1559:     $paramHash->{CHOICE_FUNC} = eval $contents;
 1560: }
 1561: 
 1562: sub end_choicefunc { return ''; }
 1563: 
 1564: sub start_valuefunc {
 1565:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1566: 
 1567:     if ($target ne 'helper') {
 1568:         return '';
 1569:     }
 1570: 
 1571:     my $contents = Apache::lonxml::get_all_text('/valuefunc',
 1572:                                                 $parser);
 1573:     $contents = 'sub { my $res = shift; ' . $contents . '}';
 1574:     $paramHash->{VALUE_FUNC} = eval $contents;
 1575: }
 1576: 
 1577: sub end_valuefunc { return ''; }
 1578: 
 1579: sub start_mapurl {
 1580:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1581: 
 1582:     if ($target ne 'helper') {
 1583:         return '';
 1584:     }
 1585: 
 1586:     my $contents = Apache::lonxml::get_all_text('/mapurl',
 1587:                                                 $parser);
 1588:     $paramHash->{MAP_URL} = $contents;
 1589: }
 1590: 
 1591: sub end_mapurl { return ''; }
 1592: 
 1593: # A note, in case I don't get to this before I leave.
 1594: # If someone complains about the "Back" button returning them
 1595: # to the previous folder state, instead of returning them to
 1596: # the previous helper state, the *correct* answer is for the helper
 1597: # to keep track of how many times the user has manipulated the folders,
 1598: # and feed that to the history.go() call in the helper rendering routines.
 1599: # If done correctly, the helper itself can keep track of how many times
 1600: # it renders the same states, so it doesn't go in just this state, and
 1601: # you can lean on the browser back button to make sure it all chains
 1602: # correctly.
 1603: # Right now, though, I'm just forcing all folders open.
 1604: 
 1605: sub render {
 1606:     my $self = shift;
 1607:     my $result = "";
 1608:     my $var = $self->{'variable'};
 1609:     my $curVal = $helper->{VARS}->{$var};
 1610: 
 1611:     my $buttons = '';
 1612: 
 1613:     if ($self->{'multichoice'}) {
 1614:         $result = <<SCRIPT;
 1615: <script>
 1616:     function checkall(value, checkName) {
 1617: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 1618:             ele = document.forms.helpform.elements[i];
 1619:             if (ele.name == checkName + '.forminput') {
 1620:                 document.forms.helpform.elements[i].checked=value;
 1621:             }
 1622:         }
 1623:     }
 1624: </script>
 1625: SCRIPT
 1626:         $buttons = <<BUTTONS;
 1627: <br /> &nbsp;
 1628: <input type="button" onclick="checkall(true, '$var')" value="Select All Resources" />
 1629: <input type="button" onclick="checkall(false, '$var')" value="Unselect All Resources" />
 1630: <br /> &nbsp;
 1631: BUTTONS
 1632:     }
 1633: 
 1634:     if (defined $self->{ERROR_MSG}) {
 1635:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 1636:     }
 1637: 
 1638:     $result .= $buttons;
 1639: 
 1640:     my $filterFunc = $self->{FILTER_FUNC};
 1641:     my $choiceFunc = $self->{CHOICE_FUNC};
 1642:     my $valueFunc = $self->{VALUE_FUNC};
 1643:     my $mapUrl = $self->{MAP_URL};
 1644:     my $multichoice = $self->{'multichoice'};
 1645: 
 1646:     # Create the composite function that renders the column on the nav map
 1647:     # have to admit any language that lets me do this can't be all bad
 1648:     #  - Jeremy (Pythonista) ;-)
 1649:     my $checked = 0;
 1650:     my $renderColFunc = sub {
 1651:         my ($resource, $part, $params) = @_;
 1652: 
 1653:         my $inputType;
 1654:         if ($multichoice) { $inputType = 'checkbox'; }
 1655:         else {$inputType = 'radio'; }
 1656: 
 1657:         if (!&$choiceFunc($resource)) {
 1658:             return '<td>&nbsp;</td>';
 1659:         } else {
 1660:             my $col = "<td><input type='$inputType' name='${var}.forminput' ";
 1661:             if (!$checked && !$multichoice) {
 1662:                 $col .= "checked ";
 1663:                 $checked = 1;
 1664:             }
 1665:             $col .= "value='" . 
 1666:                 HTML::Entities::encode(&$valueFunc($resource)) 
 1667:                 . "' /></td>";
 1668:             return $col;
 1669:         }
 1670:     };
 1671: 
 1672:     $ENV{'form.condition'} = !$self->{'toponly'};
 1673:     $result .= 
 1674:         &Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, 
 1675:                                                   Apache::lonnavmaps::resource()],
 1676:                                        'showParts' => 0,
 1677:                                        'filterFunc' => $filterFunc,
 1678:                                        'resource_no_folder_link' => 1,
 1679:                                        'iterator_map' => $mapUrl }
 1680:                                        );
 1681: 
 1682:     $result .= $buttons;
 1683:                                                 
 1684:     return $result;
 1685: }
 1686:     
 1687: sub postprocess {
 1688:     my $self = shift;
 1689: 
 1690:     if ($self->{'multichoice'}) {
 1691:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
 1692:                                         $self->{'variable'});
 1693:     }
 1694: 
 1695:     if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) {
 1696:         $self->{ERROR_MSG} = 'You must choose at least one resource to continue.';
 1697:         return 0;
 1698:     }
 1699: 
 1700:     if (defined($self->{NEXTSTATE})) {
 1701:         $helper->changeState($self->{NEXTSTATE});
 1702:     }
 1703: 
 1704:     return 1;
 1705: }
 1706: 
 1707: 1;
 1708: 
 1709: package Apache::lonhelper::student;
 1710: 
 1711: =pod
 1712: 
 1713: =head2 Element: student
 1714: 
 1715: Student elements display a choice of students enrolled in the current
 1716: course. Currently it is primitive; this is expected to evolve later.
 1717: 
 1718: Student elements take two attributes: "variable", which means what
 1719: it usually does, and "multichoice", which if true allows the user
 1720: to select multiple students.
 1721: 
 1722: =cut
 1723: 
 1724: no strict;
 1725: @ISA = ("Apache::lonhelper::element");
 1726: use strict;
 1727: 
 1728: 
 1729: 
 1730: BEGIN {
 1731:     &Apache::lonhelper::register('Apache::lonhelper::student',
 1732:                               ('student'));
 1733: }
 1734: 
 1735: sub new {
 1736:     my $ref = Apache::lonhelper::element->new();
 1737:     bless($ref);
 1738: }
 1739: 
 1740: sub start_student {
 1741:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1742: 
 1743:     if ($target ne 'helper') {
 1744:         return '';
 1745:     }
 1746: 
 1747:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1748:     $helper->declareVar($paramHash->{'variable'});
 1749:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1750:     if (defined($token->[2]{'nextstate'})) {
 1751:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
 1752:     }
 1753:     
 1754: }    
 1755: 
 1756: sub end_student {
 1757:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1758: 
 1759:     if ($target ne 'helper') {
 1760:         return '';
 1761:     }
 1762:     Apache::lonhelper::student->new();
 1763: }
 1764: 
 1765: sub render {
 1766:     my $self = shift;
 1767:     my $result = '';
 1768:     my $buttons = '';
 1769:     my $var = $self->{'variable'};
 1770: 
 1771:     if ($self->{'multichoice'}) {
 1772:         $result = <<SCRIPT;
 1773: <script>
 1774:     function checkall(value, checkName) {
 1775: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 1776:             ele = document.forms.helpform.elements[i];
 1777:             if (ele.name == checkName + '.forminput') {
 1778:                 document.forms.helpform.elements[i].checked=value;
 1779:             }
 1780:         }
 1781:     }
 1782: </script>
 1783: SCRIPT
 1784:         $buttons = <<BUTTONS;
 1785: <br />
 1786: <input type="button" onclick="checkall(true, '$var')" value="Select All Students" />
 1787: <input type="button" onclick="checkall(false, '$var')" value="Unselect All Students" />
 1788: <br />
 1789: BUTTONS
 1790:     }
 1791: 
 1792:     if (defined $self->{ERROR_MSG}) {
 1793:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 1794:     }
 1795: 
 1796:     # Load up the students
 1797:     my $choices = &Apache::loncoursedata::get_classlist();
 1798:     my @keys = keys %{$choices};
 1799: 
 1800:     # Constants
 1801:     my $section = Apache::loncoursedata::CL_SECTION();
 1802:     my $fullname = Apache::loncoursedata::CL_FULLNAME();
 1803: 
 1804:     # Sort by: Section, name
 1805:     @keys = sort {
 1806:         if ($choices->{$a}->[$section] ne $choices->{$b}->[$section]) {
 1807:             return $choices->{$a}->[$section] cmp $choices->{$b}->[$section];
 1808:         }
 1809:         return $choices->{$a}->[$fullname] cmp $choices->{$b}->[$fullname];
 1810:     } @keys;
 1811: 
 1812:     my $type = 'radio';
 1813:     if ($self->{'multichoice'}) { $type = 'checkbox'; }
 1814:     $result .= "<table cellspacing='2' cellpadding='2' border='0'>\n";
 1815:     $result .= "<tr><td></td><td align='center'><b>Student Name</b></td>".
 1816:         "<td align='center'><b>Section</b></td></tr>";
 1817: 
 1818:     my $checked = 0;
 1819:     foreach (@keys) {
 1820:         $result .= "<tr><td><input type='$type' name='" .
 1821:             $self->{'variable'} . '.forminput' . "'";
 1822:             
 1823:         if (!$self->{'multichoice'} && !$checked) {
 1824:             $result .= " checked ";
 1825:             $checked = 1;
 1826:         }
 1827:         $result .=
 1828:             " value='" . HTML::Entities::encode($_ . ':' . $choices->{$_}->[$section])
 1829:             . "' /></td><td>"
 1830:             . HTML::Entities::encode($choices->{$_}->[$fullname])
 1831:             . "</td><td align='center'>" 
 1832:             . HTML::Entities::encode($choices->{$_}->[$section])
 1833:             . "</td></tr>\n";
 1834:     }
 1835: 
 1836:     $result .= "</table>\n\n";
 1837:     $result .= $buttons;    
 1838:     
 1839:     return $result;
 1840: }
 1841: 
 1842: sub postprocess {
 1843:     my $self = shift;
 1844: 
 1845:     my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
 1846:     if (!$result) {
 1847:         $self->{ERROR_MSG} = 'You must choose at least one student '.
 1848:             'to continue.';
 1849:         return 0;
 1850:     }
 1851: 
 1852:     if ($self->{'multichoice'}) {
 1853:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
 1854:                                         $self->{'variable'});
 1855:     }
 1856:     if (defined($self->{NEXTSTATE})) {
 1857:         $helper->changeState($self->{NEXTSTATE});
 1858:     }
 1859: 
 1860:     return 1;
 1861: }
 1862: 
 1863: 1;
 1864: 
 1865: package Apache::lonhelper::files;
 1866: 
 1867: =pod
 1868: 
 1869: =head2 Element: files
 1870: 
 1871: files allows the users to choose files from a given directory on the
 1872: server. It is always multichoice and stores the result as a triple-pipe
 1873: delimited entry in the helper variables. 
 1874: 
 1875: Since it is extremely unlikely that you can actually code a constant
 1876: representing the directory you wish to allow the user to search, <files>
 1877: takes a subroutine that returns the name of the directory you wish to
 1878: have the user browse.
 1879: 
 1880: files accepts the attribute "variable" to control where the files chosen
 1881: are put. It accepts the attribute "multichoice" as the other attribute,
 1882: defaulting to false, which if true will allow the user to select more
 1883: then one choice. 
 1884: 
 1885: <files> accepts three subtags. One is the "nextstate" sub-tag that works
 1886: as it does with the other tags. Another is a <filechoice> sub tag that
 1887: is Perl code that, when surrounded by "sub {" and "}" will return a
 1888: string representing what directory on the server to allow the user to 
 1889: choose files from. Finally, the <filefilter> subtag should contain Perl
 1890: code that when surrounded by "sub { my $filename = shift; " and "}",
 1891: returns a true value if the user can pick that file, or false otherwise.
 1892: The filename passed to the function will be just the name of the file, 
 1893: with no path info.
 1894: 
 1895: =cut
 1896: 
 1897: no strict;
 1898: @ISA = ("Apache::lonhelper::element");
 1899: use strict;
 1900: 
 1901: BEGIN {
 1902:     &Apache::lonhelper::register('Apache::lonhelper::files',
 1903:                                  ('files', 'filechoice', 'filefilter'));
 1904: }
 1905: 
 1906: sub new {
 1907:     my $ref = Apache::lonhelper::element->new();
 1908:     bless($ref);
 1909: }
 1910: 
 1911: sub start_files {
 1912:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1913: 
 1914:     if ($target ne 'helper') {
 1915:         return '';
 1916:     }
 1917:     $paramHash->{'variable'} = $token->[2]{'variable'};
 1918:     $helper->declareVar($paramHash->{'variable'});
 1919:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 1920: }    
 1921: 
 1922: sub end_files {
 1923:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1924: 
 1925:     if ($target ne 'helper') {
 1926:         return '';
 1927:     }
 1928:     if (!defined($paramHash->{FILTER_FUNC})) {
 1929:         $paramHash->{FILTER_FUNC} = sub { return 1; };
 1930:     }
 1931:     Apache::lonhelper::files->new();
 1932: }    
 1933: 
 1934: sub start_filechoice {
 1935:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1936: 
 1937:     if ($target ne 'helper') {
 1938:         return '';
 1939:     }
 1940:     $paramHash->{'filechoice'} = Apache::lonxml::get_all_text('/filechoice',
 1941:                                                               $parser);
 1942: }
 1943: 
 1944: sub end_filechoice { return ''; }
 1945: 
 1946: sub start_filefilter {
 1947:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 1948: 
 1949:     if ($target ne 'helper') {
 1950:         return '';
 1951:     }
 1952: 
 1953:     my $contents = Apache::lonxml::get_all_text('/filefilter',
 1954:                                                 $parser);
 1955:     $contents = 'sub { my $filename = shift; ' . $contents . '}';
 1956:     $paramHash->{FILTER_FUNC} = eval $contents;
 1957: }
 1958: 
 1959: sub end_filefilter { return ''; }
 1960: 
 1961: sub render {
 1962:     my $self = shift;
 1963:     my $result = '';
 1964:     my $var = $self->{'variable'};
 1965:     
 1966:     my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}');
 1967:     die 'Error in resource filter code for variable ' . 
 1968:         {'variable'} . ', Perl said:' . $@ if $@;
 1969: 
 1970:     my $subdir = &$subdirFunc();
 1971: 
 1972:     my $filterFunc = $self->{FILTER_FUNC};
 1973:     my $buttons = '';
 1974:     my $type = 'radio';
 1975:     if ($self->{'multichoice'}) {
 1976:         $type = 'checkbox';
 1977:     }
 1978: 
 1979:     if ($self->{'multichoice'}) {
 1980:         $result = <<SCRIPT;
 1981: <script>
 1982:     function checkall(value, checkName) {
 1983: 	for (i=0; i<document.forms.helpform.elements.length; i++) {
 1984:             ele = document.forms.helpform.elements[i];
 1985:             if (ele.name == checkName + '.forminput') {
 1986:                 document.forms.helpform.elements[i].checked=value;
 1987:             }
 1988:         }
 1989:     }
 1990: 
 1991:     function checkallclass(value, className) {
 1992:         for (i=0; i<document.forms.helpform.elements.length; i++) {
 1993:             ele = document.forms.helpform.elements[i];
 1994:             if (ele.type == "$type" && ele.onclick) {
 1995:                 document.forms.helpform.elements[i].checked=value;
 1996:             }
 1997:         }
 1998:     }
 1999: </script>
 2000: SCRIPT
 2001:         $buttons = <<BUTTONS;
 2002: <br /> &nbsp;
 2003: <input type="button" onclick="checkall(true, '$var')" value="Select All Files" />
 2004: <input type="button" onclick="checkall(false, '$var')" value="Unselect All Files" />
 2005: BUTTONS
 2006: 
 2007:         if ($helper->{VARS}->{'construction'}) {
 2008:             $buttons .= <<BUTTONS;
 2009: <input type="button" onclick="checkallclass(true, 'Published')" value="Select All Published" />
 2010: <input type="button" onclick="checkallclass(false, 'Published')" value="Unselect All Published" />
 2011: <br /> &nbsp;
 2012: BUTTONS
 2013:        }
 2014:     }
 2015: 
 2016:     # Get the list of files in this directory.
 2017:     my @fileList;
 2018: 
 2019:     # If the subdirectory is in local CSTR space
 2020:     if ($subdir =~ m|/home/([^/]+)/public_html|) {
 2021:         my $user = $1;
 2022:         my $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
 2023:         @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, '');
 2024:     } else {
 2025:         # local library server resource space
 2026:         @fileList = &Apache::lonnet::dirlist($subdir, $ENV{'user.domain'}, $ENV{'user.name'}, '');
 2027:     }
 2028: 
 2029:     $result .= $buttons;
 2030: 
 2031:     if (defined $self->{ERROR_MSG}) {
 2032:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
 2033:     }
 2034: 
 2035:     $result .= '<table border="0" cellpadding="2" cellspacing="0">';
 2036: 
 2037:     # Keeps track if there are no choices, prints appropriate error
 2038:     # if there are none. 
 2039:     my $choices = 0;
 2040:     # Print each legitimate file choice.
 2041:     for my $file (@fileList) {
 2042:         $file = (split(/&/, $file))[0];
 2043:         if ($file eq '.' || $file eq '..') {
 2044:             next;
 2045:         }
 2046:         my $fileName = $subdir .'/'. $file;
 2047:         if (&$filterFunc($file)) {
 2048: 	    my $status;
 2049: 	    my $color;
 2050: 	    if ($helper->{VARS}->{'construction'}) {
 2051: 		($status, $color) = @{fileState($subdir, $file)};
 2052: 	    } else {
 2053: 		$status = '';
 2054: 		$color = '';
 2055: 	    }
 2056: 
 2057:             # Netscape 4 is stupid and there's nowhere to put the
 2058:             # information on the input tag that the file is Published,
 2059:             # Unpublished, etc. In *real* browsers we can just say
 2060:             # "class='Published'" and check the className attribute of
 2061:             # the input tag, but Netscape 4 is too stupid to understand
 2062:             # that attribute, and un-comprehended attributes are not
 2063:             # reflected into the object model. So instead, what I do 
 2064:             # is either have or don't have an "onclick" handler that 
 2065:             # does nothing, give Published files the onclick handler, and
 2066:             # have the checker scripts check for that. Stupid and clumsy,
 2067:             # and only gives us binary "yes/no" information (at least I
 2068:             # couldn't figure out how to reach into the event handler's
 2069:             # actual code to retreive a value), but it works well enough
 2070:             # here.
 2071:         
 2072:             my $onclick = '';
 2073:             if ($status eq 'Published' && $helper->{VARS}->{'construction'}) {
 2074:                 $onclick = 'onclick="a=1" ';
 2075:             }
 2076:             $result .= '<tr><td align="right"' . " bgcolor='$color'>" .
 2077:                 "<input $onclick type='$type' name='" . $var
 2078:             . ".forminput' value='" . HTML::Entities::encode($fileName) .
 2079:                 "'";
 2080:             if (!$self->{'multichoice'} && $choices == 0) {
 2081:                 $result .= ' checked';
 2082:             }
 2083:             $result .= "/></td><td bgcolor='$color'>" . $file .
 2084:                  "</td><td bgcolor='$color'>$status</td></tr>\n";
 2085:             $choices++;
 2086:         }
 2087:     }
 2088: 
 2089:     $result .= "</table>\n";
 2090: 
 2091:     if (!$choices) {
 2092:         $result .= '<font color="#FF0000">There are no files available to select in this directory. Please go back and select another option.</font><br /><br />';
 2093:     }
 2094: 
 2095:     $result .= $buttons;
 2096: 
 2097:     return $result;
 2098: }
 2099: 
 2100: # Determine the state of the file: Published, unpublished, modified.
 2101: # Return the color it should be in and a label as a two-element array
 2102: # reference.
 2103: # Logic lifted from lonpubdir.pm, even though I don't know that it's still
 2104: # the most right thing to do.
 2105: 
 2106: sub fileState {
 2107:     my $constructionSpaceDir = shift;
 2108:     my $file = shift;
 2109:     
 2110:     my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
 2111:     my $subdirpart = $constructionSpaceDir;
 2112:     $subdirpart =~ s/^\/home\/$ENV{'user.name'}\/public_html//;
 2113:     my $resdir = $docroot . '/res/' . $ENV{'user.domain'} . '/' . $ENV{'user.name'} .
 2114:         $subdirpart;
 2115: 
 2116:     my @constructionSpaceFileStat = stat($constructionSpaceDir . '/' . $file);
 2117:     my @resourceSpaceFileStat = stat($resdir . '/' . $file);
 2118:     if (!@resourceSpaceFileStat) {
 2119:         return ['Unpublished', '#FFCCCC'];
 2120:     }
 2121: 
 2122:     my $constructionSpaceFileModified = $constructionSpaceFileStat[9];
 2123:     my $resourceSpaceFileModified = $resourceSpaceFileStat[9];
 2124:     
 2125:     if ($constructionSpaceFileModified > $resourceSpaceFileModified) {
 2126:         return ['Modified', '#FFFFCC'];
 2127:     }
 2128:     return ['Published', '#CCFFCC'];
 2129: }
 2130: 
 2131: sub postprocess {
 2132:     my $self = shift;
 2133:     my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
 2134:     if (!$result) {
 2135:         $self->{ERROR_MSG} = 'You must choose at least one file '.
 2136:             'to continue.';
 2137:         return 0;
 2138:     }
 2139: 
 2140:     if ($self->{'multichoice'}) {
 2141:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
 2142:                                         $self->{'variable'});
 2143:     }
 2144:     if (defined($self->{NEXTSTATE})) {
 2145:         $helper->changeState($self->{NEXTSTATE});
 2146:     }
 2147: 
 2148:     return 1;
 2149: }
 2150: 
 2151: 1;
 2152: 
 2153: package Apache::lonhelper::section;
 2154: 
 2155: =pod
 2156: 
 2157: =head2 Element: section
 2158: 
 2159: <section> allows the user to choose one or more sections from the current
 2160: course.
 2161: 
 2162: It takes the standard attributes "variable", "multichoice", and
 2163: "nextstate", meaning what they do for most other elements.
 2164: 
 2165: =cut
 2166: 
 2167: no strict;
 2168: @ISA = ("Apache::lonhelper::choices");
 2169: use strict;
 2170: 
 2171: BEGIN {
 2172:     &Apache::lonhelper::register('Apache::lonhelper::section',
 2173:                                  ('section'));
 2174: }
 2175: 
 2176: sub new {
 2177:     my $ref = Apache::lonhelper::choices->new();
 2178:     bless($ref);
 2179: }
 2180: 
 2181: sub start_section {
 2182:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2183: 
 2184:     if ($target ne 'helper') {
 2185:         return '';
 2186:     }
 2187: 
 2188:     $paramHash->{CHOICES} = [];
 2189: 
 2190:     $paramHash->{'variable'} = $token->[2]{'variable'};
 2191:     $helper->declareVar($paramHash->{'variable'});
 2192:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
 2193:     if (defined($token->[2]{'nextstate'})) {
 2194:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
 2195:     }
 2196: 
 2197:     # Populate the CHOICES element
 2198:     my %choices;
 2199: 
 2200:     my $section = Apache::loncoursedata::CL_SECTION();
 2201:     my $classlist = Apache::loncoursedata::get_classlist();
 2202:     foreach (keys %$classlist) {
 2203:         my $sectionName = $classlist->{$_}->[$section];
 2204:         if (!$sectionName) {
 2205:             $choices{"No section assigned"} = "";
 2206:         } else {
 2207:             $choices{$sectionName} = $sectionName;
 2208:         }
 2209:     } 
 2210:    
 2211:     for my $sectionName (sort(keys(%choices))) {
 2212:         
 2213:         push @{$paramHash->{CHOICES}}, [$sectionName, $sectionName];
 2214:     }
 2215: }    
 2216: 
 2217: sub end_section {
 2218:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2219: 
 2220:     if ($target ne 'helper') {
 2221:         return '';
 2222:     }
 2223:     Apache::lonhelper::section->new();
 2224: }    
 2225: 1;
 2226: 
 2227: package Apache::lonhelper::general;
 2228: 
 2229: =pod
 2230: 
 2231: =head2 General-purpose tag: <exec>
 2232: 
 2233: The contents of the exec tag are executed as Perl code, not inside a 
 2234: safe space, so the full range of $ENV and such is available. The code
 2235: will be executed as a subroutine wrapped with the following code:
 2236: 
 2237: "sub { my $helper = shift; my $state = shift;" and
 2238: 
 2239: "}"
 2240: 
 2241: The return value is ignored.
 2242: 
 2243: $helper is the helper object. Feel free to add methods to the helper
 2244: object to support whatever manipulation you may need to do (for instance,
 2245: overriding the form location if the state is the final state; see 
 2246: lonparm.helper for an example).
 2247: 
 2248: $state is the $paramHash that has currently been generated and may
 2249: be manipulated by the code in exec. Note that the $state is not yet
 2250: an actual state B<object>, it is just a hash, so do not expect to
 2251: be able to call methods on it.
 2252: 
 2253: =cut
 2254: 
 2255: BEGIN {
 2256:     &Apache::lonhelper::register('Apache::lonhelper::general',
 2257:                                  'exec', 'condition', 'clause',
 2258:                                  'eval');
 2259: }
 2260: 
 2261: sub start_exec {
 2262:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2263: 
 2264:     if ($target ne 'helper') {
 2265:         return '';
 2266:     }
 2267:     
 2268:     my $code = &Apache::lonxml::get_all_text('/exec', $parser);
 2269:     
 2270:     $code = eval ('sub { my $helper = shift; my $state = shift; ' .
 2271:         $code . "}");
 2272:     die 'Error in <exec>, Perl said: '. $@ if $@;
 2273:     &$code($helper, $paramHash);
 2274: }
 2275: 
 2276: sub end_exec { return ''; }
 2277: 
 2278: =pod
 2279: 
 2280: =head2 General-purpose tag: <condition>
 2281: 
 2282: The <condition> tag allows you to mask out parts of the helper code
 2283: depending on some programatically determined condition. The condition
 2284: tag contains a tag <clause> which contains perl code that when wrapped
 2285: with "sub { my $helper = shift; my $state = shift; " and "}", returns
 2286: a true value if the XML in the condition should be evaluated as a normal
 2287: part of the helper, or false if it should be completely discarded.
 2288: 
 2289: The <clause> tag must be the first sub-tag of the <condition> tag or
 2290: it will not work as expected.
 2291: 
 2292: =cut
 2293: 
 2294: # The condition tag just functions as a marker, it doesn't have
 2295: # to "do" anything. Technically it doesn't even have to be registered
 2296: # with the lonxml code, but I leave this here to be explicit about it.
 2297: sub start_condition { return ''; }
 2298: sub end_condition { return ''; }
 2299: 
 2300: sub start_clause {
 2301:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2302: 
 2303:     if ($target ne 'helper') {
 2304:         return '';
 2305:     }
 2306:     
 2307:     my $clause = Apache::lonxml::get_all_text('/clause', $parser);
 2308:     $clause = eval('sub { my $helper = shift; my $state = shift; '
 2309:         . $clause . '}');
 2310:     die 'Error in clause of condition, Perl said: ' . $@ if $@;
 2311:     if (!&$clause($helper, $paramHash)) {
 2312:         # Discard all text until the /condition.
 2313:         &Apache::lonxml::get_all_text('/condition', $parser);
 2314:     }
 2315: }
 2316: 
 2317: sub end_clause { return ''; }
 2318: 
 2319: =pod
 2320: 
 2321: =head2 General-purpose tag: <eval>
 2322: 
 2323: The <eval> tag will be evaluated as a subroutine call passed in the
 2324: current helper object and state hash as described in <condition> above,
 2325: but is expected to return a string to be printed directly to the
 2326: screen. This is useful for dynamically generating messages. 
 2327: 
 2328: =cut
 2329: 
 2330: # This is basically a type of message.
 2331: # Programmatically setting $paramHash->{NEXTSTATE} would work, though
 2332: # it's probably bad form.
 2333: 
 2334: sub start_eval {
 2335:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2336: 
 2337:     if ($target ne 'helper') {
 2338:         return '';
 2339:     }
 2340:     
 2341:     my $program = Apache::lonxml::get_all_text('/eval', $parser);
 2342:     $program = eval('sub { my $helper = shift; my $state = shift; '
 2343:         . $program . '}');
 2344:     die 'Error in eval code, Perl said: ' . $@ if $@;
 2345:     $paramHash->{MESSAGE_TEXT} = &$program($helper, $paramHash);
 2346: }
 2347: 
 2348: sub end_eval { 
 2349:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2350: 
 2351:     if ($target ne 'helper') {
 2352:         return '';
 2353:     }
 2354: 
 2355:     Apache::lonhelper::message->new();
 2356: }
 2357: 
 2358: 1;
 2359: 
 2360: package Apache::lonhelper::parmwizfinal;
 2361: 
 2362: # This is the final state for the parmwizard. It is not generally useful,
 2363: # so it is not perldoc'ed. It does its own processing.
 2364: # It is represented with <parmwizfinal />, and
 2365: # should later be moved to lonparmset.pm .
 2366: 
 2367: no strict;
 2368: @ISA = ('Apache::lonhelper::element');
 2369: use strict;
 2370: 
 2371: BEGIN {
 2372:     &Apache::lonhelper::register('Apache::lonhelper::parmwizfinal',
 2373:                                  ('parmwizfinal'));
 2374: }
 2375: 
 2376: use Time::localtime;
 2377: 
 2378: sub new {
 2379:     my $ref = Apache::lonhelper::choices->new();
 2380:     bless ($ref);
 2381: }
 2382: 
 2383: sub start_parmwizfinal { return ''; }
 2384: 
 2385: sub end_parmwizfinal {
 2386:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
 2387: 
 2388:     if ($target ne 'helper') {
 2389:         return '';
 2390:     }
 2391:     Apache::lonhelper::parmwizfinal->new();
 2392: }
 2393: 
 2394: # Renders a form that, when submitted, will form the input to lonparmset.pm
 2395: sub render {
 2396:     my $self = shift;
 2397:     my $vars = $helper->{VARS};
 2398: 
 2399:     # FIXME: Unify my designators with the standard ones
 2400:     my %dateTypeHash = ('open_date' => "Opening Date",
 2401:                         'due_date' => "Due Date",
 2402:                         'answer_date' => "Answer Date");
 2403:     my %parmTypeHash = ('open_date' => "0_opendate",
 2404:                         'due_date' => "0_duedate",
 2405:                         'answer_date' => "0_answerdate");
 2406:     
 2407:     my $result = "<form name='helpform' method='get' action='/adm/parmset'>\n";
 2408:     $result .= '<p>Confirm that this information is correct, then click &quot;Finish Wizard&quot; to complete setting the parameter.<ul>';
 2409:     my $affectedResourceId = "";
 2410:     my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}};
 2411:     my $level = "";
 2412:     
 2413:     # Print the type of manipulation:
 2414:     $result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}}
 2415:                . "</b></li>\n";
 2416:     if ($vars->{ACTION_TYPE} eq 'due_date' || 
 2417:         $vars->{ACTION_TYPE} eq 'answer_date') {
 2418:         # for due dates, we default to "date end" type entries
 2419:         $result .= "<input type='hidden' name='recent_date_end' " .
 2420:             "value='" . $vars->{PARM_DATE} . "' />\n";
 2421:         $result .= "<input type='hidden' name='pres_value' " . 
 2422:             "value='" . $vars->{PARM_DATE} . "' />\n";
 2423:         $result .= "<input type='hidden' name='pres_type' " .
 2424:             "value='date_end' />\n";
 2425:     } elsif ($vars->{ACTION_TYPE} eq 'open_date') {
 2426:         $result .= "<input type='hidden' name='recent_date_start' ".
 2427:             "value='" . $vars->{PARM_DATE} . "' />\n";
 2428:         $result .= "<input type='hidden' name='pres_value' " .
 2429:             "value='" . $vars->{PARM_DATE} . "' />\n";
 2430:         $result .= "<input type='hidden' name='pres_type' " .
 2431:             "value='date_start' />\n";
 2432:     } 
 2433:     
 2434:     # Print the granularity, depending on the action
 2435:     if ($vars->{GRANULARITY} eq 'whole_course') {
 2436:         $result .= '<li>for <b>all resources in the course</b></li>';
 2437:         $level = 9; # general course, see lonparmset.pm perldoc
 2438:         $affectedResourceId = "0.0";
 2439:     } elsif ($vars->{GRANULARITY} eq 'map') {
 2440:         my $navmap = Apache::lonnavmaps::navmap->new(
 2441:                            $ENV{"request.course.fn"}.".db",
 2442:                            $ENV{"request.course.fn"}."_parms.db", 0, 0);
 2443:         my $res = $navmap->getById($vars->{RESOURCE_ID});
 2444:         my $title = $res->compTitle();
 2445:         $navmap->untieHashes();
 2446:         $result .= "<li>for the map named <b>$title</b></li>";
 2447:         $level = 8;
 2448:         $affectedResourceId = $vars->{RESOURCE_ID};
 2449:     } else {
 2450:         my $navmap = Apache::lonnavmaps::navmap->new(
 2451:                            $ENV{"request.course.fn"}.".db",
 2452:                            $ENV{"request.course.fn"}."_parms.db", 0, 0);
 2453:         my $res = $navmap->getById($vars->{RESOURCE_ID});
 2454:         my $title = $res->compTitle();
 2455:         $navmap->untieHashes();
 2456:         $result .= "<li>for the resource named <b>$title</b></li>";
 2457:         $level = 7;
 2458:         $affectedResourceId = $vars->{RESOURCE_ID};
 2459:     }
 2460: 
 2461:     # Print targets
 2462:     if ($vars->{TARGETS} eq 'course') {
 2463:         $result .= '<li>for <b>all students in course</b></li>';
 2464:     } elsif ($vars->{TARGETS} eq 'section') {
 2465:         my $section = $vars->{SECTION_NAME};
 2466:         $result .= "<li>for section <b>$section</b></li>";
 2467:         $level -= 3;
 2468:         $result .= "<input type='hidden' name='csec' value='" .
 2469:             HTML::Entities::encode($section) . "' />\n";
 2470:     } else {
 2471:         # FIXME: This is probably wasteful! Store the name!
 2472:         my $classlist = Apache::loncoursedata::get_classlist();
 2473:         my $name = $classlist->{$vars->{USER_NAME}}->[6];
 2474:         $result .= "<li>for <b>$name</b></li>";
 2475:         $level -= 6;
 2476:         my ($uname, $udom) = split /:/, $vars->{USER_NAME};
 2477:         $result .= "<input type='hidden' name='uname' value='".
 2478:             HTML::Entities::encode($uname) . "' />\n";
 2479:         $result .= "<input type='hidden' name='udom' value='".
 2480:             HTML::Entities::encode($udom) . "' />\n";
 2481:     }
 2482: 
 2483:     # Print value
 2484:     $result .= "<li>to <b>" . ctime($vars->{PARM_DATE}) . "</b> (" .
 2485:         Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}) 
 2486:         . ")</li>\n";
 2487: 
 2488:     # print pres_marker
 2489:     $result .= "\n<input type='hidden' name='pres_marker'" .
 2490:         " value='$affectedResourceId&$parm_name&$level' />\n";
 2491: 
 2492:     $result .= "<br /><br /><center><input type='submit' value='Finish Helper' /></center></form>\n";
 2493: 
 2494:     return $result;
 2495: }
 2496:     
 2497: sub overrideForm {
 2498:     return 1;
 2499: }
 2500: 
 2501: 1;
 2502: 
 2503: __END__
 2504: