File:  [LON-CAPA] / loncom / interface / lonhelper.pm
Revision 1.39: download - view: text, annotated - select for diffs
Thu Jun 19 19:28:52 2003 UTC (20 years, 11 months ago) by bowersj2
Branches: MAIN
CVS tags: HEAD
"student" option now allows a parameter that allows you to select
course personnel as well, but this will have a problem with multiple
roles for the same person. Still, this is an improvement, if not a final
fix...

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>