Annotation of loncom/interface/lonhelper.pm, revision 1.10

1.1       bowersj2    1: # The LearningOnline Network with CAPA
                      2: # .helper XML handler to implement the LON-CAPA helper
                      3: #
1.6       bowersj2    4: # $Id: lonhelper.pm,v 1.5 2003/04/10 18:02:09 bowersj2 Exp $
1.1       bowersj2    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: 
1.3       bowersj2   33: =pod
                     34: 
                     35: =head1 lonhelper - HTML Helper framework for LON-CAPA
                     36: 
                     37: Helpers, often known as "wizards", are well-established UI widgets that users
                     38: feel comfortable with. It can take a complicated multidimensional problem the
                     39: user has and turn it into a series of bite-sized one-dimensional questions.
                     40: 
                     41: For developers, helpers provide an easy way to bundle little bits of functionality
                     42: for the user, without having to write the tedious state-maintenence code.
                     43: 
                     44: Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers 
                     45: directory and having the .helper file extension. For examples, see that directory.
                     46: 
                     47: All classes are in the Apache::lonhelper namespace.
                     48: 
                     49: =head2 lonhelper XML file format
                     50: 
                     51: A helper consists of a top-level <helper> tag which contains a series of states.
                     52: Each state contains one or more state elements, which are what the user sees, like
                     53: messages, resource selections, or date queries.
                     54: 
                     55: The helper tag is required to have one attribute, "title", which is the name
                     56: of the helper itself, such as "Parameter helper". 
                     57: 
                     58: =head2 State tags
                     59: 
                     60: State tags are required to have an attribute "name", which is the symbolic
1.7       bowersj2   61: name of the state and will not be directly seen by the user. The helper is
                     62: required to have one state named "START", which is the state the helper
1.5       bowersj2   63: will start with. By convention, this state should clearly describe what
1.3       bowersj2   64: the helper will do for the user, and may also include the first information
                     65: entry the user needs to do for the helper.
                     66: 
                     67: State tags are also required to have an attribute "title", which is the
                     68: human name of the state, and will be displayed as the header on top of 
                     69: the screen for the user.
                     70: 
                     71: =head2 Example Helper Skeleton
                     72: 
                     73: An example of the tags so far:
                     74: 
                     75:  <helper title="Example Helper">
                     76:    <state name="START" title="Demonstrating the Example Helper">
                     77:      <!-- notice this is the START state the wizard requires -->
                     78:      </state>
                     79:    <state name="GET_NAME" title="Enter Student Name">
                     80:      </state>
                     81:    </helper>
                     82: 
                     83: Of course this does nothing. In order for the wizard to do something, it is
                     84: necessary to put actual elements into the wizard. Documentation for each
                     85: of these elements follows.
                     86: 
                     87: =cut
                     88: 
1.1       bowersj2   89: package Apache::lonhelper;
1.2       bowersj2   90: use Apache::Constants qw(:common);
                     91: use Apache::File;
1.3       bowersj2   92: use Apache::lonxml;
1.2       bowersj2   93: 
1.7       bowersj2   94: # Register all the tags with the helper, so the helper can 
                     95: # push and pop them
                     96: 
                     97: my @helperTags;
                     98: 
                     99: sub register {
                    100:     my ($namespace, @tags) = @_;
                    101: 
                    102:     for my $tag (@tags) {
                    103:         push @helperTags, [$namespace, $tag];
                    104:     }
                    105: }
                    106: 
1.2       bowersj2  107: BEGIN {
1.7       bowersj2  108:     Apache::lonxml::register('Apache::lonhelper', 
                    109:                              ('helper'));
                    110:       register('Apache::lonhelper', ('state'));
1.2       bowersj2  111: }
                    112: 
1.7       bowersj2  113: # Since all helpers are only three levels deep (helper tag, state tag, 
1.3       bowersj2  114: # substate type), it's easier and more readble to explicitly track 
                    115: # those three things directly, rather then futz with the tag stack 
                    116: # every time.
                    117: my $helper;
                    118: my $state;
                    119: my $substate;
1.4       bowersj2  120: # To collect parameters, the contents of the subtags are collected
                    121: # into this paramHash, then passed to the element object when the 
                    122: # end of the element tag is located.
                    123: my $paramHash; 
1.2       bowersj2  124: 
                    125: sub handler {
1.3       bowersj2  126:     my $r = shift;
1.2       bowersj2  127:     $ENV{'request.uri'} = $r->uri();
                    128:     my $filename = '/home/httpd/html' . $r->uri();
                    129:     my $fh = Apache::File->new($filename);
                    130:     my $file;
1.3       bowersj2  131:     read $fh, $file, 100000000;
                    132: 
                    133:     Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
                    134: 
                    135:     # Send header, don't cache this page
                    136:     if ($r->header_only) {
                    137:         if ($ENV{'browser.mathml'}) {
                    138:             $r->content_type('text/xml');
                    139:         } else {
                    140:             $r->content_type('text/html');
                    141:         }
                    142:         $r->send_http_header;
                    143:         return OK;
                    144:     }
                    145:     if ($ENV{'browser.mathml'}) {
                    146:         $r->content_type('text/xml');
                    147:     } else {
                    148:         $r->content_type('text/html');
                    149:     }
                    150:     $r->send_http_header;
                    151:     $r->rflush();
1.2       bowersj2  152: 
1.3       bowersj2  153:     # Discard result, we just want the objects that get created by the
                    154:     # xml parsing
                    155:     &Apache::lonxml::xmlparse($r, 'helper', $file);
1.2       bowersj2  156: 
1.3       bowersj2  157:     $r->print($helper->display());
1.7       bowersj2  158:    return OK;
1.2       bowersj2  159: }
                    160: 
                    161: sub start_helper {
                    162:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    163: 
                    164:     if ($target ne 'helper') {
                    165:         return '';
                    166:     }
1.7       bowersj2  167: 
                    168:     for my $tagList (@helperTags) {
                    169:         Apache::lonxml::register($tagList->[0], $tagList->[1]);
                    170:     }
1.2       bowersj2  171:     
1.3       bowersj2  172:     $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
1.4       bowersj2  173:     return '';
1.2       bowersj2  174: }
                    175: 
                    176: sub end_helper {
                    177:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    178:     
1.3       bowersj2  179:     if ($target ne 'helper') {
                    180:         return '';
                    181:     }
1.7       bowersj2  182: 
                    183:     for my $tagList (@helperTags) {
                    184:         Apache::lonxml::deregister($tagList->[0], $tagList->[1]);
                    185:     }
                    186: 
1.4       bowersj2  187:     return '';
1.2       bowersj2  188: }
1.1       bowersj2  189: 
1.3       bowersj2  190: sub start_state {
                    191:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    192: 
                    193:     if ($target ne 'helper') {
                    194:         return '';
                    195:     }
                    196: 
                    197:     $state = Apache::lonhelper::state->new($token->[2]{'name'},
                    198:                                            $token->[2]{'title'});
                    199:     return '';
                    200: }
                    201: 
                    202: # don't need this, so ignore it
                    203: sub end_state {
                    204:     return '';
                    205: }
                    206: 
1.1       bowersj2  207: 1;
                    208: 
1.3       bowersj2  209: package Apache::lonhelper::helper;
                    210: 
                    211: use Digest::MD5 qw(md5_hex);
                    212: use HTML::Entities;
                    213: use Apache::loncommon;
                    214: use Apache::File;
                    215: 
                    216: sub new {
                    217:     my $proto = shift;
                    218:     my $class = ref($proto) || $proto;
                    219:     my $self = {};
                    220: 
                    221:     $self->{TITLE} = shift;
                    222:     
                    223:     # If there is a state from the previous form, use that. If there is no
                    224:     # state, use the start state parameter.
                    225:     if (defined $ENV{"form.CURRENT_STATE"})
                    226:     {
                    227: 	$self->{STATE} = $ENV{"form.CURRENT_STATE"};
                    228:     }
                    229:     else
                    230:     {
                    231: 	$self->{STATE} = "START";
                    232:     }
                    233: 
                    234:     $self->{TOKEN} = $ENV{'form.TOKEN'};
                    235:     # If a token was passed, we load that in. Otherwise, we need to create a 
                    236:     # new storage file
                    237:     # Tried to use standard Tie'd hashes, but you can't seem to take a 
                    238:     # reference to a tied hash and write to it. I'd call that a wart.
                    239:     if ($self->{TOKEN}) {
                    240:         # Validate the token before trusting it
                    241:         if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) {
                    242:             # Not legit. Return nothing and let all hell break loose.
                    243:             # User shouldn't be doing that!
                    244:             return undef;
                    245:         }
                    246: 
                    247:         # Get the hash.
                    248:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file
                    249:         
                    250:         my $file = Apache::File->new($self->{FILENAME});
                    251:         my $contents = <$file>;
1.5       bowersj2  252: 
                    253:         # Now load in the contents
                    254:         for my $value (split (/&/, $contents)) {
                    255:             my ($name, $value) = split(/=/, $value);
                    256:             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                    257:             $self->{VARS}->{$name} = $value;
                    258:         }
                    259: 
1.3       bowersj2  260:         $file->close();
                    261:     } else {
                    262:         # Only valid if we're just starting.
                    263:         if ($self->{STATE} ne 'START') {
                    264:             return undef;
                    265:         }
                    266:         # Must create the storage
                    267:         $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} .
                    268:                                  time() . rand());
                    269:         $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN});
                    270:     }
                    271: 
                    272:     # OK, we now have our persistent storage.
                    273: 
                    274:     if (defined $ENV{"form.RETURN_PAGE"})
                    275:     {
                    276: 	$self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"};
                    277:     }
                    278:     else
                    279:     {
                    280: 	$self->{RETURN_PAGE} = $ENV{REFERER};
                    281:     }
                    282: 
                    283:     $self->{STATES} = {};
                    284:     $self->{DONE} = 0;
                    285: 
1.9       bowersj2  286:     # Used by various helpers for various things; see lonparm.helper
                    287:     # for an example.
                    288:     $self->{DATA} = {};
                    289: 
1.3       bowersj2  290:     bless($self, $class);
                    291:     return $self;
                    292: }
                    293: 
                    294: # Private function; returns a string to construct the hidden fields
                    295: # necessary to have the helper track state.
                    296: sub _saveVars {
                    297:     my $self = shift;
                    298:     my $result = "";
                    299:     $result .= '<input type="hidden" name="CURRENT_STATE" value="' .
                    300:         HTML::Entities::encode($self->{STATE}) . "\" />\n";
                    301:     $result .= '<input type="hidden" name="TOKEN" value="' .
                    302:         $self->{TOKEN} . "\" />\n";
                    303:     $result .= '<input type="hidden" name="RETURN_PAGE" value="' .
                    304:         HTML::Entities::encode($self->{RETURN_PAGE}) . "\" />\n";
                    305: 
                    306:     return $result;
                    307: }
                    308: 
                    309: # Private function: Create the querystring-like representation of the stored
                    310: # data to write to disk.
                    311: sub _varsInFile {
                    312:     my $self = shift;
                    313:     my @vars = ();
                    314:     for my $key (keys %{$self->{VARS}}) {
                    315:         push @vars, &Apache::lonnet::escape($key) . '=' .
                    316:             &Apache::lonnet::escape($self->{VARS}->{$key});
                    317:     }
                    318:     return join ('&', @vars);
                    319: }
                    320: 
1.5       bowersj2  321: # Use this to declare variables.
                    322: # FIXME: Document this
                    323: sub declareVar {
                    324:     my $self = shift;
                    325:     my $var = shift;
                    326: 
                    327:     if (!defined($self->{VARS}->{$var})) {
                    328:         $self->{VARS}->{$var} = '';
                    329:     }
                    330: 
                    331:     my $envname = 'form.' . $var . '.forminput';
                    332:     if (defined($ENV{$envname})) {
                    333:         $self->{VARS}->{$var} = $ENV{$envname};
                    334:     }
                    335: }
                    336: 
1.3       bowersj2  337: sub changeState {
                    338:     my $self = shift;
                    339:     $self->{STATE} = shift;
                    340: }
                    341: 
                    342: sub registerState {
                    343:     my $self = shift;
                    344:     my $state = shift;
                    345: 
                    346:     my $stateName = $state->name();
                    347:     $self->{STATES}{$stateName} = $state;
                    348: }
                    349: 
                    350: # Done in four phases
                    351: # 1: Do the post processing for the previous state.
                    352: # 2: Do the preprocessing for the current state.
                    353: # 3: Check to see if state changed, if so, postprocess current and move to next.
                    354: #    Repeat until state stays stable.
                    355: # 4: Render the current state to the screen as an HTML page.
                    356: sub display {
                    357:     my $self = shift;
                    358: 
                    359:     my $result = "";
                    360: 
                    361:     # Phase 1: Post processing for state of previous screen (which is actually
                    362:     # the "current state" in terms of the helper variables), if it wasn't the 
                    363:     # beginning state.
                    364:     if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq "Next ->") {
                    365: 	my $prevState = $self->{STATES}{$self->{STATE}};
                    366:             $prevState->postprocess();
                    367:     }
                    368:     
                    369:     # Note, to handle errors in a state's input that a user must correct,
                    370:     # do not transition in the postprocess, and force the user to correct
                    371:     # the error.
                    372: 
                    373:     # Phase 2: Preprocess current state
                    374:     my $startState = $self->{STATE};
                    375:     my $state = $self->{STATES}{$startState};
                    376:     
                    377:     # Error checking; it is intended that the developer will have
                    378:     # checked all paths and the user can't see this!
                    379:     if (!defined($state)) {
                    380:         $result .="Error! The state ". $startState ." is not defined.";
                    381:         return $result;
                    382:     }
                    383:     $state->preprocess();
                    384: 
                    385:     # Phase 3: While the current state is different from the previous state,
                    386:     # keep processing.
                    387:     while ( $startState ne $self->{STATE} )
                    388:     {
                    389: 	$startState = $self->{STATE};
                    390: 	$state = $self->{STATES}{$startState};
                    391: 	$state->preprocess();
                    392:     }
                    393: 
                    394:     # Phase 4: Display.
                    395:     my $stateTitle = $state->title();
                    396:     my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'','');
                    397: 
                    398:     $result .= <<HEADER;
                    399: <html>
                    400:     <head>
                    401:         <title>LON-CAPA Helper: $self->{TITLE}</title>
                    402:     </head>
                    403:     $bodytag
                    404: HEADER
                    405:     if (!$state->overrideForm()) { $result.="<form name='wizform' method='GET'>"; }
                    406:     $result .= <<HEADER;
                    407:         <table border="0"><tr><td>
                    408:         <h2><i>$stateTitle</i></h2>
                    409: HEADER
                    410: 
                    411:     if (!$state->overrideForm()) {
                    412:         $result .= $self->_saveVars();
                    413:     }
                    414:     $result .= $state->render() . "<p>&nbsp;</p>";
                    415: 
                    416:     if (!$state->overrideForm()) {
                    417:         $result .= '<center>';
                    418:         if ($self->{STATE} ne $self->{START_STATE}) {
                    419:             #$result .= '<input name="SUBMIT" type="submit" value="&lt;- Previous" />&nbsp;&nbsp;';
                    420:         }
                    421:         if ($self->{DONE}) {
                    422:             my $returnPage = $self->{RETURN_PAGE};
                    423:             $result .= "<a href=\"$returnPage\">End Helper</a>";
                    424:         }
                    425:         else {
                    426:             $result .= '<input name="back" type="button" ';
                    427:             $result .= 'value="&lt;- Previous" onclick="history.go(-1)" /> ';
                    428:             $result .= '<input name="SUBMIT" type="submit" value="Next -&gt;" />';
                    429:         }
                    430:         $result .= "</center>\n";
                    431:     }
                    432: 
1.5       bowersj2  433:     foreach my $key (keys %{$self->{VARS}}) {
                    434:         $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />";
                    435:     }
                    436: 
1.3       bowersj2  437:     $result .= <<FOOTER;
                    438:               </td>
                    439:             </tr>
                    440:           </table>
                    441:         </form>
                    442:     </body>
                    443: </html>
                    444: FOOTER
                    445: 
                    446:     # Handle writing out the vars to the file
                    447:     my $file = Apache::File->new('>'.$self->{FILENAME});
                    448:     print $file $self->_varsInFile();
                    449: 
                    450:     return $result;
                    451: }
                    452: 
                    453: 1;
                    454: 
                    455: package Apache::lonhelper::state;
                    456: 
                    457: # States bundle things together and are responsible for compositing the
1.4       bowersj2  458: # various elements together. It is not generally necessary for users to
                    459: # use the state object directly, so it is not perldoc'ed.
                    460: 
                    461: # Basically, all the states do is pass calls to the elements and aggregate
                    462: # the results.
1.3       bowersj2  463: 
                    464: sub new {
                    465:     my $proto = shift;
                    466:     my $class = ref($proto) || $proto;
                    467:     my $self = {};
                    468: 
                    469:     $self->{NAME} = shift;
                    470:     $self->{TITLE} = shift;
                    471:     $self->{ELEMENTS} = [];
                    472: 
                    473:     bless($self, $class);
                    474: 
                    475:     $helper->registerState($self);
                    476: 
                    477:     return $self;
                    478: }
                    479: 
                    480: sub name {
                    481:     my $self = shift;
                    482:     return $self->{NAME};
                    483: }
                    484: 
                    485: sub title {
                    486:     my $self = shift;
                    487:     return $self->{TITLE};
                    488: }
                    489: 
1.4       bowersj2  490: sub preprocess {
                    491:     my $self = shift;
                    492:     for my $element (@{$self->{ELEMENTS}}) {
                    493:         $element->preprocess();
                    494:     }
                    495: }
                    496: 
1.6       bowersj2  497: # FIXME: Document that all postprocesses must return a true value or
                    498: # the state transition will be overridden
1.4       bowersj2  499: sub postprocess {
                    500:     my $self = shift;
1.6       bowersj2  501: 
                    502:     # Save the state so we can roll it back if we need to.
                    503:     my $originalState = $helper->{STATE};
                    504:     my $everythingSuccessful = 1;
                    505: 
1.4       bowersj2  506:     for my $element (@{$self->{ELEMENTS}}) {
1.6       bowersj2  507:         my $result = $element->postprocess();
                    508:         if (!$result) { $everythingSuccessful = 0; }
                    509:     }
                    510: 
                    511:     # If not all the postprocesses were successful, override
                    512:     # any state transitions that may have occurred. It is the
                    513:     # responsibility of the states to make sure they have 
                    514:     # error handling in that case.
                    515:     if (!$everythingSuccessful) {
                    516:         $helper->{STATE} = $originalState;
1.4       bowersj2  517:     }
                    518: }
                    519: 
                    520: sub overrideForm {
                    521:     return 0;
                    522: }
                    523: 
                    524: sub addElement {
                    525:     my $self = shift;
                    526:     my $element = shift;
                    527:     
                    528:     push @{$self->{ELEMENTS}}, $element;
                    529: }
                    530: 
                    531: sub render {
                    532:     my $self = shift;
                    533:     my @results = ();
                    534: 
                    535:     for my $element (@{$self->{ELEMENTS}}) {
                    536:         push @results, $element->render();
                    537:     }
                    538:     return join("\n", @results);
                    539: }
                    540: 
                    541: 1;
                    542: 
                    543: package Apache::lonhelper::element;
                    544: # Support code for elements
                    545: 
                    546: =pod
                    547: 
                    548: =head2 Element Base Class
                    549: 
                    550: The Apache::lonhelper::element base class provides support methods for
                    551: the elements to use, such as a multiple value processer.
                    552: 
                    553: B<Methods>:
                    554: 
                    555: =over 4
                    556: 
                    557: =item * process_multiple_choices(formName, varName): Process the form 
                    558: element named "formName" and place the selected items into the helper 
                    559: variable named varName. This is for things like checkboxes or 
                    560: multiple-selection listboxes where the user can select more then 
                    561: one entry. The selected entries are delimited by triple pipes in 
1.5       bowersj2  562: the helper variables, like this:  
                    563: 
                    564:  CHOICE_1|||CHOICE_2|||CHOICE_3
1.4       bowersj2  565: 
                    566: =back
                    567: 
                    568: =cut
                    569: 
1.5       bowersj2  570: BEGIN {
1.7       bowersj2  571:     &Apache::lonhelper::register('Apache::lonhelper::element',
                    572:                                  ('nextstate'));
1.5       bowersj2  573: }
                    574: 
1.4       bowersj2  575: # Because we use the param hash, this is often a sufficent
                    576: # constructor
                    577: sub new {
                    578:     my $proto = shift;
                    579:     my $class = ref($proto) || $proto;
                    580:     my $self = $paramHash;
                    581:     bless($self, $class);
                    582: 
                    583:     $self->{PARAMS} = $paramHash;
                    584:     $self->{STATE} = $state;
                    585:     $state->addElement($self);
                    586:     
                    587:     # Ensure param hash is not reused
                    588:     $paramHash = {};
                    589: 
                    590:     return $self;
                    591: }   
                    592: 
1.5       bowersj2  593: sub start_nextstate {
                    594:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    595: 
                    596:     if ($target ne 'helper') {
                    597:         return '';
                    598:     }
                    599:     
                    600:     $paramHash->{NEXTSTATE} = &Apache::lonxml::get_all_text('/nextstate',
                    601:                                                              $parser);
                    602:     return '';
                    603: }
                    604: 
                    605: sub end_nextstate { return ''; }
                    606: 
1.4       bowersj2  607: sub preprocess {
                    608:     return 1;
                    609: }
                    610: 
                    611: sub postprocess {
                    612:     return 1;
                    613: }
                    614: 
                    615: sub render {
                    616:     return '';
                    617: }
                    618: 
1.3       bowersj2  619: sub process_multiple_choices {
                    620:     my $self = shift;
                    621:     my $formname = shift;
                    622:     my $var = shift;
                    623: 
                    624:     my $formvalue = $ENV{'form.' . $formname};
                    625:     if ($formvalue) {
1.5       bowersj2  626:         # Must extract values from querystring directly, as there
1.3       bowersj2  627:         # may be more then one.
                    628:         my @values;
1.5       bowersj2  629:         for my $formparam (split (/&/, $ENV{QUERY_STRING})) {
1.3       bowersj2  630:             my ($name, $value) = split(/=/, $formparam);
                    631:             if ($name ne $formname) {
                    632:                 next;
                    633:             }
                    634:             $value =~ tr/+/ /;
                    635:             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                    636:             push @values, $value;
                    637:         }
1.5       bowersj2  638:         $helper->{VARS}->{$var} = join('|||', @values);
1.3       bowersj2  639:     }
                    640:     
                    641:     return;
                    642: }
                    643: 
1.4       bowersj2  644: 1;
                    645: 
                    646: package Apache::lonhelper::message;
                    647: 
                    648: =pod
                    649: 
                    650: =head2 Element: message
                    651: 
                    652: Message elements display the contents of their <message_text> tags, and
1.5       bowersj2  653: transition directly to the state in the <nextstate> tag. Example:
1.4       bowersj2  654: 
                    655:  <message>
1.5       bowersj2  656:    <nextstate>GET_NAME</nextstate>
1.4       bowersj2  657:    <message_text>This is the <b>message</b> the user will see, 
                    658:                  <i>HTML allowed</i>.</message_text>
                    659:    </message>
                    660: 
1.5       bowersj2  661: This will display the HTML message and transition to the <nextstate> if
1.7       bowersj2  662: given. The HTML will be directly inserted into the helper, so if you don't
1.4       bowersj2  663: want text to run together, you'll need to manually wrap the <message_text>
                    664: in <p> tags, or whatever is appropriate for your HTML.
                    665: 
1.5       bowersj2  666: Message tags do not add in whitespace, so if you want it, you'll need to add
                    667: it into states. This is done so you can inline some elements, such as 
                    668: the <date> element, right between two messages, giving the appearence that 
                    669: the <date> element appears inline. (Note the elements can not be embedded
                    670: within each other.)
                    671: 
1.4       bowersj2  672: This is also a good template for creating your own new states, as it has
                    673: very little code beyond the state template.
                    674: 
                    675: =cut
                    676: 
                    677: no strict;
                    678: @ISA = ("Apache::lonhelper::element");
                    679: use strict;
                    680: 
                    681: BEGIN {
1.7       bowersj2  682:     &Apache::lonhelper::register('Apache::lonhelper::message',
1.10    ! bowersj2  683:                               ('message'));
1.3       bowersj2  684: }
                    685: 
1.5       bowersj2  686: sub new {
                    687:     my $ref = Apache::lonhelper::element->new();
                    688:     bless($ref);
                    689: }
1.4       bowersj2  690: 
                    691: # CONSTRUCTION: Construct the message element from the XML
                    692: sub start_message {
                    693:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    694: 
                    695:     if ($target ne 'helper') {
                    696:         return '';
                    697:     }
1.10    ! bowersj2  698: 
        !           699:     $paramHash->{MESSAGE_TEXT} = &Apache::lonxml::get_all_text('/message',
        !           700:                                                                $parser);
        !           701: 
        !           702:     if (defined($token->[2]{'nextstate'})) {
        !           703:         $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'};
        !           704:     }
1.4       bowersj2  705:     return '';
1.3       bowersj2  706: }
                    707: 
1.10    ! bowersj2  708: sub end_message {
1.4       bowersj2  709:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    710: 
                    711:     if ($target ne 'helper') {
                    712:         return '';
                    713:     }
1.10    ! bowersj2  714:     Apache::lonhelper::message->new();
        !           715:     return '';
1.5       bowersj2  716: }
                    717: 
                    718: sub render {
                    719:     my $self = shift;
                    720: 
                    721:     return $self->{MESSAGE_TEXT};
                    722: }
                    723: # If a NEXTSTATE was given, switch to it
                    724: sub postprocess {
                    725:     my $self = shift;
                    726:     if (defined($self->{NEXTSTATE})) {
                    727:         $helper->changeState($self->{NEXTSTATE});
                    728:     }
1.6       bowersj2  729: 
                    730:     return 1;
1.5       bowersj2  731: }
                    732: 1;
                    733: 
                    734: package Apache::lonhelper::choices;
                    735: 
                    736: =pod
                    737: 
                    738: =head2 Element: choices
                    739: 
                    740: Choice states provide a single choice to the user as a text selection box.
                    741: A "choice" is two pieces of text, one which will be displayed to the user
                    742: (the "human" value), and one which will be passed back to the program
                    743: (the "computer" value). For instance, a human may choose from a list of
                    744: resources on disk by title, while your program wants the file name.
                    745: 
                    746: <choices> takes an attribute "variable" to control which helper variable
                    747: the result is stored in.
                    748: 
                    749: <choices> takes an attribute "multichoice" which, if set to a true
                    750: value, will allow the user to select multiple choices.
                    751: 
                    752: B<SUB-TAGS>
                    753: 
                    754: <choices> can have the following subtags:
                    755: 
                    756: =over 4
                    757: 
                    758: =item * <nextstate>state_name</nextstate>: If given, this will cause the
                    759:       choice element to transition to the given state after executing. If
                    760:       this is used, do not pass nextstates to the <choice> tag.
                    761: 
                    762: =item * <choice />: If the choices are static,
                    763:       this element will allow you to specify them. Each choice
                    764:       contains  attribute, "computer", as described above. The
                    765:       content of the tag will be used as the human label.
                    766:       For example,  
                    767:       <choice computer='234-12-7312'>Bobby McDormik</choice>.
                    768: 
                    769: <choice> may optionally contain a 'nextstate' attribute, which
                    770: will be the state transisitoned to if the choice is made, if
                    771: the choice is not multichoice.
                    772: 
                    773: =back
                    774: 
                    775: To create the choices programmatically, either wrap the choices in 
                    776: <condition> tags (prefered), or use an <exec> block inside the <choice>
                    777: tag. Store the choices in $state->{CHOICES}, which is a list of list
                    778: references, where each list has three strings. The first is the human
                    779: name, the second is the computer name. and the third is the option
                    780: next state. For example:
                    781: 
                    782:  <exec>
                    783:     for (my $i = 65; $i < 65 + 26; $i++) {
                    784:         push @{$state->{CHOICES}}, [chr($i), $i, 'next'];
                    785:     }
                    786:  </exec>
                    787: 
                    788: This will allow the user to select from the letters A-Z (in ASCII), while
                    789: passing the ASCII value back into the helper variables, and the state
                    790: will in all cases transition to 'next'.
                    791: 
                    792: You can mix and match methods of creating choices, as long as you always 
                    793: "push" onto the choice list, rather then wiping it out. (You can even 
                    794: remove choices programmatically, but that would probably be bad form.)
                    795: 
                    796: =cut
                    797: 
                    798: no strict;
                    799: @ISA = ("Apache::lonhelper::element");
                    800: use strict;
                    801: 
                    802: BEGIN {
1.7       bowersj2  803:     &Apache::lonhelper::register('Apache::lonhelper::choices',
1.5       bowersj2  804:                               ('choice', 'choices'));
                    805: }
                    806: 
                    807: sub new {
                    808:     my $ref = Apache::lonhelper::element->new();
                    809:     bless($ref);
                    810: }
                    811: 
                    812: # CONSTRUCTION: Construct the message element from the XML
                    813: sub start_choices {
                    814:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    815: 
                    816:     if ($target ne 'helper') {
                    817:         return '';
                    818:     }
                    819: 
                    820:     # Need to initialize the choices list, so everything can assume it exists
                    821:     $paramHash->{'variable'} = $token->[2]{'variable'};
                    822:     $helper->declareVar($paramHash->{'variable'});
                    823:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
                    824:     $paramHash->{CHOICES} = [];
                    825:     return '';
                    826: }
                    827: 
                    828: sub end_choices {
                    829:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    830: 
                    831:     if ($target ne 'helper') {
                    832:         return '';
                    833:     }
                    834:     Apache::lonhelper::choices->new();
                    835:     return '';
                    836: }
                    837: 
                    838: sub start_choice {
                    839:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    840: 
                    841:     if ($target ne 'helper') {
                    842:         return '';
                    843:     }
                    844: 
                    845:     my $computer = $token->[2]{'computer'};
                    846:     my $human = &Apache::lonxml::get_all_text('/choice',
                    847:                                               $parser);
                    848:     my $nextstate = $token->[2]{'nextstate'};
                    849:     push @{$paramHash->{CHOICES}}, [$human, $computer, $nextstate];
                    850:     return '';
                    851: }
                    852: 
                    853: sub end_choice {
                    854:     return '';
                    855: }
                    856: 
                    857: sub render {
                    858:     # START HERE: Replace this with correct choices code.
                    859:     my $self = shift;
                    860:     my $var = $self->{'variable'};
                    861:     my $buttons = '';
                    862:     my $result = '';
                    863: 
                    864:     if ($self->{'multichoice'}) {
1.6       bowersj2  865:         $result .= <<SCRIPT;
1.5       bowersj2  866: <script>
                    867:     function checkall(value) {
                    868: 	for (i=0; i<document.forms.wizform.elements.length; i++) {
                    869:             document.forms.wizform.elements[i].checked=value;
                    870:         }
                    871:     }
                    872: </script>
                    873: SCRIPT
                    874:         $buttons = <<BUTTONS;
                    875: <br />
                    876: <input type="button" onclick="checkall(true)" value="Select All" />
                    877: <input type="button" onclick="checkall(false)" value="Unselect All" />
1.6       bowersj2  878: <br />&nbsp;
1.5       bowersj2  879: BUTTONS
                    880:     }
                    881: 
                    882:     if (defined $self->{ERROR_MSG}) {
1.6       bowersj2  883:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />';
1.5       bowersj2  884:     }
                    885: 
                    886:     $result .= $buttons;
1.6       bowersj2  887:     
1.5       bowersj2  888:     $result .= "<table>\n\n";
                    889: 
                    890:     my $type = "radio";
                    891:     if ($self->{'multichoice'}) { $type = 'checkbox'; }
                    892:     my $checked = 0;
                    893:     foreach my $choice (@{$self->{CHOICES}}) {
                    894:         $result .= "<tr>\n<td width='20'>&nbsp;</td>\n";
                    895:         $result .= "<td valign='top'><input type='$type' name='$var.forminput'"
                    896:             . "' value='" . 
                    897:             HTML::Entities::encode($choice->[1]) 
                    898:             . "'";
                    899:         if (!$self->{'multichoice'} && !$checked) {
                    900:             $result .= " checked ";
                    901:             $checked = 1;
                    902:         }
                    903:         $result .= "/></td><td> " . $choice->[0] . "</td></tr>\n";
                    904:     }
                    905:     $result .= "</table>\n\n\n";
                    906:     $result .= $buttons;
                    907: 
                    908:     return $result;
                    909: }
                    910: 
                    911: # If a NEXTSTATE was given or a nextstate for this choice was
                    912: # given, switch to it
                    913: sub postprocess {
                    914:     my $self = shift;
                    915:     my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};
                    916: 
1.6       bowersj2  917:     if (!$chosenValue) {
                    918:         $self->{ERROR_MSG} = "You must choose one or more choices to" .
                    919:             " continue.";
                    920:         return 0;
                    921:     }
                    922: 
                    923:     if ($self->{'multichoice'}) {
                    924:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
                    925:                                         $self->{'variable'});
                    926:     }
                    927: 
1.5       bowersj2  928:     if (defined($self->{NEXTSTATE})) {
                    929:         $helper->changeState($self->{NEXTSTATE});
                    930:     }
                    931:     
                    932:     foreach my $choice (@{$self->{CHOICES}}) {
                    933:         if ($choice->[1] eq $chosenValue) {
                    934:             if (defined($choice->[2])) {
                    935:                 $helper->changeState($choice->[2]);
                    936:             }
                    937:         }
                    938:     }
1.6       bowersj2  939:     return 1;
1.5       bowersj2  940: }
                    941: 1;
                    942: 
                    943: package Apache::lonhelper::date;
                    944: 
                    945: =pod
                    946: 
                    947: =head2 Element: date
                    948: 
                    949: Date elements allow the selection of a date with a drop down list.
                    950: 
                    951: Date elements can take two attributes:
                    952: 
                    953: =over 4
                    954: 
                    955: =item * B<variable>: The name of the variable to store the chosen
                    956:         date in. Required.
                    957: 
                    958: =item * B<hoursminutes>: If a true value, the date will show hours
                    959:         and minutes, as well as month/day/year. If false or missing,
                    960:         the date will only show the month, day, and year.
                    961: 
                    962: =back
                    963: 
                    964: Date elements contain only an option <nextstate> tag to determine
                    965: the next state.
                    966: 
                    967: Example:
                    968: 
                    969:  <date variable="DUE_DATE" hoursminutes="1">
                    970:    <nextstate>choose_why</nextstate>
                    971:    </date>
                    972: 
                    973: =cut
                    974: 
                    975: no strict;
                    976: @ISA = ("Apache::lonhelper::element");
                    977: use strict;
                    978: 
                    979: use Time::localtime;
                    980: 
                    981: BEGIN {
1.7       bowersj2  982:     &Apache::lonhelper::register('Apache::lonhelper::date',
1.5       bowersj2  983:                               ('date'));
                    984: }
                    985: 
                    986: # Don't need to override the "new" from element
                    987: sub new {
                    988:     my $ref = Apache::lonhelper::element->new();
                    989:     bless($ref);
                    990: }
                    991: 
                    992: my @months = ("January", "February", "March", "April", "May", "June", "July",
                    993: 	      "August", "September", "October", "November", "December");
                    994: 
                    995: # CONSTRUCTION: Construct the message element from the XML
                    996: sub start_date {
                    997:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    998: 
                    999:     if ($target ne 'helper') {
                   1000:         return '';
                   1001:     }
                   1002: 
                   1003:     $paramHash->{'variable'} = $token->[2]{'variable'};
                   1004:     $helper->declareVar($paramHash->{'variable'});
                   1005:     $paramHash->{'hoursminutes'} = $token->[2]{'hoursminutes'};
                   1006: }
                   1007: 
                   1008: sub end_date {
                   1009:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1010: 
                   1011:     if ($target ne 'helper') {
                   1012:         return '';
                   1013:     }
                   1014:     Apache::lonhelper::date->new();
                   1015:     return '';
                   1016: }
                   1017: 
                   1018: sub render {
                   1019:     my $self = shift;
                   1020:     my $result = "";
                   1021:     my $var = $self->{'variable'};
                   1022: 
                   1023:     my $date;
                   1024:     
                   1025:     # Default date: The current hour.
                   1026:     $date = localtime();
                   1027:     $date->min(0);
                   1028: 
                   1029:     if (defined $self->{ERROR_MSG}) {
                   1030:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
                   1031:     }
                   1032: 
                   1033:     # Month
                   1034:     my $i;
                   1035:     $result .= "<select name='${var}month'>\n";
                   1036:     for ($i = 0; $i < 12; $i++) {
                   1037:         if ($i == $date->mon) {
                   1038:             $result .= "<option value='$i' selected>";
                   1039:         } else {
                   1040:             $result .= "<option value='$i'>";
                   1041:         }
                   1042:         $result .= $months[$i] . "</option>\n";
                   1043:     }
                   1044:     $result .= "</select>\n";
                   1045: 
                   1046:     # Day
                   1047:     $result .= "<select name='${var}day'>\n";
                   1048:     for ($i = 1; $i < 32; $i++) {
                   1049:         if ($i == $date->mday) {
                   1050:             $result .= '<option selected>';
                   1051:         } else {
                   1052:             $result .= '<option>';
                   1053:         }
                   1054:         $result .= "$i</option>\n";
                   1055:     }
                   1056:     $result .= "</select>,\n";
                   1057: 
                   1058:     # Year
                   1059:     $result .= "<select name='${var}year'>\n";
                   1060:     for ($i = 2000; $i < 2030; $i++) { # update this after 64-bit dates
                   1061:         if ($date->year + 1900 == $i) {
                   1062:             $result .= "<option selected>";
                   1063:         } else {
                   1064:             $result .= "<option>";
                   1065:         }
                   1066:         $result .= "$i</option>\n";
                   1067:     }
                   1068:     $result .= "</select>,\n";
                   1069: 
                   1070:     # Display Hours and Minutes if they are called for
                   1071:     if ($self->{'hoursminutes'}) {
                   1072:         # Build hour
                   1073:         $result .= "<select name='${var}hour'>\n";
                   1074:         $result .= "<option " . ($date->hour == 0 ? 'selected ':'') .
                   1075:             " value='0'>midnight</option>\n";
                   1076:         for ($i = 1; $i < 12; $i++) {
                   1077:             if ($date->hour == $i) {
                   1078:                 $result .= "<option selected value='$i'>$i a.m.</option>\n";
                   1079:             } else {
                   1080:                 $result .= "<option value='$i'>$i a.m</option>\n";
                   1081:             }
                   1082:         }
                   1083:         $result .= "<option " . ($date->hour == 12 ? 'selected ':'') .
                   1084:             " value='12'>noon</option>\n";
                   1085:         for ($i = 13; $i < 24; $i++) {
                   1086:             my $printedHour = $i - 12;
                   1087:             if ($date->hour == $i) {
                   1088:                 $result .= "<option selected value='$i'>$printedHour p.m.</option>\n";
                   1089:             } else {
                   1090:                 $result .= "<option value='$i'>$printedHour p.m.</option>\n";
                   1091:             }
                   1092:         }
                   1093: 
                   1094:         $result .= "</select> :\n";
                   1095: 
                   1096:         $result .= "<select name='${var}minute'>\n";
                   1097:         for ($i = 0; $i < 60; $i++) {
                   1098:             my $printedMinute = $i;
                   1099:             if ($i < 10) {
                   1100:                 $printedMinute = "0" . $printedMinute;
                   1101:             }
                   1102:             if ($date->min == $i) {
                   1103:                 $result .= "<option selected>";
                   1104:             } else {
                   1105:                 $result .= "<option>";
                   1106:             }
                   1107:             $result .= "$printedMinute</option>\n";
                   1108:         }
                   1109:         $result .= "</select>\n";
                   1110:     }
                   1111: 
                   1112:     return $result;
                   1113: 
                   1114: }
                   1115: # If a NEXTSTATE was given, switch to it
                   1116: sub postprocess {
                   1117:     my $self = shift;
                   1118:     my $var = $self->{'variable'};
                   1119:     my $month = $ENV{'form.' . $var . 'month'}; 
                   1120:     my $day = $ENV{'form.' . $var . 'day'}; 
                   1121:     my $year = $ENV{'form.' . $var . 'year'}; 
                   1122:     my $min = 0; 
                   1123:     my $hour = 0;
                   1124:     if ($self->{'hoursminutes'}) {
                   1125:         $min = $ENV{'form.' . $var . 'minute'};
                   1126:         $hour = $ENV{'form.' . $var . 'hour'};
                   1127:     }
                   1128: 
                   1129:     my $chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year);
                   1130:     # Check to make sure that the date was not automatically co-erced into a 
                   1131:     # valid date, as we want to flag that as an error
                   1132:     # This happens for "Feb. 31", for instance, which is coerced to March 2 or
                   1133:     # 3, depending on if it's a leapyear
                   1134:     my $checkDate = localtime($chosenDate);
                   1135: 
                   1136:     if ($checkDate->mon != $month || $checkDate->mday != $day ||
                   1137:         $checkDate->year + 1900 != $year) {
                   1138:         $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a "
                   1139:             . "date because it doesn't exist. Please enter a valid date.";
1.6       bowersj2 1140:         return 0;
1.5       bowersj2 1141:     }
                   1142: 
                   1143:     $helper->{VARS}->{$var} = $chosenDate;
                   1144: 
                   1145:     if (defined($self->{NEXTSTATE})) {
                   1146:         $helper->changeState($self->{NEXTSTATE});
                   1147:     }
1.6       bowersj2 1148: 
                   1149:     return 1;
1.5       bowersj2 1150: }
                   1151: 1;
                   1152: 
                   1153: package Apache::lonhelper::resource;
                   1154: 
                   1155: =pod
                   1156: 
                   1157: =head2 Element: resource
                   1158: 
                   1159: <resource> elements allow the user to select one or multiple resources
                   1160: from the current course. You can filter out which resources they can view,
                   1161: and filter out which resources they can select. The course will always
                   1162: be displayed fully expanded, because of the difficulty of maintaining
                   1163: selections across folder openings and closings. If this is fixed, then
                   1164: the user can manipulate the folders.
                   1165: 
                   1166: <resource> takes the standard variable attribute to control what helper
                   1167: variable stores the results. It also takes a "multichoice" attribute,
                   1168: which controls whether the user can select more then one resource.
                   1169: 
                   1170: B<SUB-TAGS>
                   1171: 
                   1172: =over 4
                   1173: 
                   1174: =item * <filterfunc>: If you want to filter what resources are displayed
                   1175:   to the user, use a filter func. The <filterfunc> tag should contain
                   1176:   Perl code that when wrapped with "sub { my $res = shift; " and "}" is 
                   1177:   a function that returns true if the resource should be displayed, 
                   1178:   and false if it should be skipped. $res is a resource object. 
                   1179:   (See Apache::lonnavmaps documentation for information about the 
                   1180:   resource object.)
                   1181: 
                   1182: =item * <choicefunc>: Same as <filterfunc>, except that controls whether
                   1183:   the given resource can be chosen. (It is almost always a good idea to
                   1184:   show the user the folders, for instance, but you do not always want to 
                   1185:   let the user select them.)
                   1186: 
                   1187: =item * <nextstate>: Standard nextstate behavior.
                   1188: 
                   1189: =item * <valuefunc>: This function controls what is returned by the resource
                   1190:   when the user selects it. Like filterfunc and choicefunc, it should be
                   1191:   a function fragment that when wrapped by "sub { my $res = shift; " and
                   1192:   "}" returns a string representing what you want to have as the value. By
                   1193:   default, the value will be the resource ID of the object ($res->{ID}).
                   1194: 
                   1195: =back
                   1196: 
                   1197: =cut
                   1198: 
                   1199: no strict;
                   1200: @ISA = ("Apache::lonhelper::element");
                   1201: use strict;
                   1202: 
                   1203: BEGIN {
1.7       bowersj2 1204:     &Apache::lonhelper::register('Apache::lonhelper::resource',
1.5       bowersj2 1205:                               ('resource', 'filterfunc', 
                   1206:                                'choicefunc', 'valuefunc'));
                   1207: }
                   1208: 
                   1209: sub new {
                   1210:     my $ref = Apache::lonhelper::element->new();
                   1211:     bless($ref);
                   1212: }
                   1213: 
                   1214: # CONSTRUCTION: Construct the message element from the XML
                   1215: sub start_resource {
                   1216:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1217: 
                   1218:     if ($target ne 'helper') {
                   1219:         return '';
                   1220:     }
                   1221: 
                   1222:     $paramHash->{'variable'} = $token->[2]{'variable'};
                   1223:     $helper->declareVar($paramHash->{'variable'});
                   1224:     return '';
                   1225: }
                   1226: 
                   1227: sub end_resource {
                   1228:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1229: 
                   1230:     if ($target ne 'helper') {
                   1231:         return '';
                   1232:     }
                   1233:     if (!defined($paramHash->{FILTER_FUNC})) {
                   1234:         $paramHash->{FILTER_FUNC} = sub {return 1;};
                   1235:     }
                   1236:     if (!defined($paramHash->{CHOICE_FUNC})) {
                   1237:         $paramHash->{CHOICE_FUNC} = sub {return 1;};
                   1238:     }
                   1239:     if (!defined($paramHash->{VALUE_FUNC})) {
                   1240:         $paramHash->{VALUE_FUNC} = sub {my $res = shift; return $res->{ID}; };
                   1241:     }
                   1242:     Apache::lonhelper::resource->new();
1.4       bowersj2 1243:     return '';
                   1244: }
                   1245: 
1.5       bowersj2 1246: sub start_filterfunc {
                   1247:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1248: 
                   1249:     if ($target ne 'helper') {
                   1250:         return '';
                   1251:     }
                   1252: 
                   1253:     my $contents = Apache::lonxml::get_all_text('/filterfunc',
                   1254:                                                 $parser);
                   1255:     $contents = 'sub { my $res = shift; ' . $contents . '}';
                   1256:     $paramHash->{FILTER_FUNC} = eval $contents;
                   1257: }
                   1258: 
                   1259: sub end_filterfunc { return ''; }
                   1260: 
                   1261: sub start_choicefunc {
                   1262:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1263: 
                   1264:     if ($target ne 'helper') {
                   1265:         return '';
                   1266:     }
                   1267: 
                   1268:     my $contents = Apache::lonxml::get_all_text('/choicefunc',
                   1269:                                                 $parser);
                   1270:     $contents = 'sub { my $res = shift; ' . $contents . '}';
                   1271:     $paramHash->{CHOICE_FUNC} = eval $contents;
                   1272: }
                   1273: 
                   1274: sub end_choicefunc { return ''; }
                   1275: 
                   1276: sub start_valuefunc {
                   1277:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1278: 
                   1279:     if ($target ne 'helper') {
                   1280:         return '';
                   1281:     }
                   1282: 
                   1283:     my $contents = Apache::lonxml::get_all_text('/valuefunc',
                   1284:                                                 $parser);
                   1285:     $contents = 'sub { my $res = shift; ' . $contents . '}';
                   1286:     $paramHash->{VALUE_FUNC} = eval $contents;
                   1287: }
                   1288: 
                   1289: sub end_valuefunc { return ''; }
                   1290: 
                   1291: # A note, in case I don't get to this before I leave.
                   1292: # If someone complains about the "Back" button returning them
                   1293: # to the previous folder state, instead of returning them to
                   1294: # the previous helper state, the *correct* answer is for the helper
                   1295: # to keep track of how many times the user has manipulated the folders,
                   1296: # and feed that to the history.go() call in the helper rendering routines.
                   1297: # If done correctly, the helper itself can keep track of how many times
                   1298: # it renders the same states, so it doesn't go in just this state, and
                   1299: # you can lean on the browser back button to make sure it all chains
                   1300: # correctly.
                   1301: # Right now, though, I'm just forcing all folders open.
                   1302: 
                   1303: sub render {
                   1304:     my $self = shift;
                   1305:     my $result = "";
                   1306:     my $var = $self->{'variable'};
                   1307:     my $curVal = $helper->{VARS}->{$var};
                   1308: 
                   1309:     if (defined $self->{ERROR_MSG}) {
                   1310:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
                   1311:     }
                   1312: 
                   1313:     my $filterFunc = $self->{FILTER_FUNC};
                   1314:     my $choiceFunc = $self->{CHOICE_FUNC};
                   1315:     my $valueFunc = $self->{VALUE_FUNC};
                   1316: 
                   1317:     # Create the composite function that renders the column on the nav map
                   1318:     # have to admit any language that lets me do this can't be all bad
                   1319:     #  - Jeremy (Pythonista) ;-)
                   1320:     my $checked = 0;
                   1321:     my $renderColFunc = sub {
                   1322:         my ($resource, $part, $params) = @_;
                   1323:         
                   1324:         if (!&$choiceFunc($resource)) {
                   1325:             return '<td>&nbsp;</td>';
                   1326:         } else {
                   1327:             my $col = "<td><input type='radio' name='${var}.forminput' ";
                   1328:             if (!$checked) {
                   1329:                 $col .= "checked ";
                   1330:                 $checked = 1;
                   1331:             }
                   1332:             $col .= "value='" . 
                   1333:                 HTML::Entities::encode(&$valueFunc($resource)) 
                   1334:                 . "' /></td>";
                   1335:             return $col;
                   1336:         }
                   1337:     };
                   1338: 
                   1339:     $ENV{'form.condition'} = 1;
                   1340:     $result .= 
                   1341:         &Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, 
                   1342:                                                   Apache::lonnavmaps::resource()],
                   1343:                                        'showParts' => 0,
                   1344:                                        'url' => $helper->{URL},
                   1345:                                        'filterFunc' => $filterFunc,
                   1346:                                        'resource_no_folder_link' => 1 }
                   1347:                                        );
                   1348:                                                 
                   1349:     return $result;
                   1350: }
                   1351:     
                   1352: sub postprocess {
                   1353:     my $self = shift;
                   1354:     if (defined($self->{NEXTSTATE})) {
                   1355:         $helper->changeState($self->{NEXTSTATE});
                   1356:     }
1.6       bowersj2 1357: 
                   1358:     return 1;
1.5       bowersj2 1359: }
                   1360: 
                   1361: 1;
                   1362: 
                   1363: package Apache::lonhelper::student;
                   1364: 
                   1365: =pod
                   1366: 
                   1367: =head2 Element: student
                   1368: 
                   1369: Student elements display a choice of students enrolled in the current
                   1370: course. Currently it is primitive; this is expected to evolve later.
                   1371: 
                   1372: Student elements take two attributes: "variable", which means what
                   1373: it usually does, and "multichoice", which if true allows the user
                   1374: to select multiple students.
                   1375: 
                   1376: =cut
                   1377: 
                   1378: no strict;
                   1379: @ISA = ("Apache::lonhelper::element");
                   1380: use strict;
                   1381: 
                   1382: 
                   1383: 
                   1384: BEGIN {
1.7       bowersj2 1385:     &Apache::lonhelper::register('Apache::lonhelper::student',
1.5       bowersj2 1386:                               ('student'));
                   1387: }
                   1388: 
                   1389: sub new {
                   1390:     my $ref = Apache::lonhelper::element->new();
                   1391:     bless($ref);
                   1392: }
1.4       bowersj2 1393: 
1.5       bowersj2 1394: sub start_student {
1.4       bowersj2 1395:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1396: 
                   1397:     if ($target ne 'helper') {
                   1398:         return '';
                   1399:     }
                   1400: 
1.5       bowersj2 1401:     $paramHash->{'variable'} = $token->[2]{'variable'};
                   1402:     $helper->declareVar($paramHash->{'variable'});
                   1403:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
                   1404: }    
                   1405: 
                   1406: sub end_student {
                   1407:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1408: 
                   1409:     if ($target ne 'helper') {
                   1410:         return '';
                   1411:     }
                   1412:     Apache::lonhelper::student->new();
1.3       bowersj2 1413: }
1.5       bowersj2 1414: 
                   1415: sub render {
                   1416:     my $self = shift;
                   1417:     my $result = '';
                   1418:     my $buttons = '';
                   1419: 
                   1420:     if ($self->{'multichoice'}) {
                   1421:         $result = <<SCRIPT;
                   1422: <script>
                   1423:     function checkall(value) {
                   1424: 	for (i=0; i<document.forms.wizform.elements.length; i++) {
                   1425:             document.forms.wizform.elements[i].checked=value;
                   1426:         }
                   1427:     }
                   1428: </script>
                   1429: SCRIPT
                   1430:         $buttons = <<BUTTONS;
                   1431: <br />
                   1432: <input type="button" onclick="checkall(true)" value="Select All" />
                   1433: <input type="button" onclick="checkall(false)" value="Unselect All" />
                   1434: <br />
                   1435: BUTTONS
                   1436:     }
                   1437: 
                   1438:     if (defined $self->{ERROR_MSG}) {
                   1439:         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
                   1440:     }
                   1441: 
                   1442:     # Load up the students
                   1443:     my $choices = &Apache::loncoursedata::get_classlist();
                   1444: 
                   1445:     my @keys = keys %{$choices};
                   1446: 
                   1447:     # Constants
                   1448:     my $section = Apache::loncoursedata::CL_SECTION();
                   1449:     my $fullname = Apache::loncoursedata::CL_FULLNAME();
                   1450: 
                   1451:     # Sort by: Section, name
                   1452:     @keys = sort {
                   1453:         if ($choices->{$a}->[$section] ne $choices->{$b}->[$section]) {
                   1454:             return $choices->{$a}->[$section] cmp $choices->{$b}->[$section];
                   1455:         }
                   1456:         return $choices->{$a}->[$fullname] cmp $choices->{$b}->[$fullname];
                   1457:     } @keys;
                   1458: 
                   1459:     my $type = 'radio';
                   1460:     if ($self->{'multichoice'}) { $type = 'checkbox'; }
                   1461:     $result .= "<table cellspacing='2' cellpadding='2' border='0'>\n";
                   1462:     $result .= "<tr><td></td><td align='center'><b>Student Name</b></td>".
                   1463:         "<td align='center'><b>Section</b></td></tr>";
                   1464: 
                   1465:     my $checked = 0;
                   1466:     foreach (@keys) {
                   1467:         $result .= "<tr><td><input type='$type' name='" .
                   1468:             $self->{'variable'} . '.forminput' . "'";
                   1469:             
                   1470:         if (!$self->{'multichoice'} && !$checked) {
                   1471:             $result .= " checked ";
                   1472:             $checked = 1;
                   1473:         }
                   1474:         $result .=
                   1475:             " value='" . HTML::Entities::encode($_)
                   1476:             . "' /></td><td>"
                   1477:             . HTML::Entities::encode($choices->{$_}->[$fullname])
                   1478:             . "</td><td align='center'>" 
                   1479:             . HTML::Entities::encode($choices->{$_}->[$section])
                   1480:             . "</td></tr>\n";
                   1481:     }
                   1482: 
                   1483:     $result .= "</table>\n\n";
                   1484:     $result .= $buttons;    
1.4       bowersj2 1485:     
1.5       bowersj2 1486:     return $result;
                   1487: }
                   1488: 
1.6       bowersj2 1489: sub postprocess {
                   1490:     my $self = shift;
                   1491: 
                   1492:     my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
                   1493:     if (!$result) {
                   1494:         $self->{ERROR_MSG} = 'You must choose at least one student '.
                   1495:             'to continue.';
                   1496:         return 0;
                   1497:     }
                   1498: 
                   1499:     if ($self->{'multichoice'}) {
                   1500:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
                   1501:                                         $self->{'variable'});
                   1502:     }
                   1503:     if (defined($self->{NEXTSTATE})) {
                   1504:         $helper->changeState($self->{NEXTSTATE});
                   1505:     }
                   1506: 
                   1507:     return 1;
                   1508: }
                   1509: 
1.5       bowersj2 1510: 1;
                   1511: 
                   1512: package Apache::lonhelper::files;
                   1513: 
                   1514: =pod
                   1515: 
                   1516: =head2 Element: files
                   1517: 
                   1518: files allows the users to choose files from a given directory on the
                   1519: server. It is always multichoice and stores the result as a triple-pipe
                   1520: delimited entry in the helper variables. 
                   1521: 
                   1522: Since it is extremely unlikely that you can actually code a constant
                   1523: representing the directory you wish to allow the user to search, <files>
                   1524: takes a subroutine that returns the name of the directory you wish to
                   1525: have the user browse.
                   1526: 
                   1527: files accepts the attribute "variable" to control where the files chosen
                   1528: are put. It accepts the attribute "multichoice" as the other attribute,
                   1529: defaulting to false, which if true will allow the user to select more
                   1530: then one choice. 
                   1531: 
                   1532: <files> accepts three subtags. One is the "nextstate" sub-tag that works
                   1533: as it does with the other tags. Another is a <filechoice> sub tag that
                   1534: is Perl code that, when surrounded by "sub {" and "}" will return a
                   1535: string representing what directory on the server to allow the user to 
                   1536: choose files from. Finally, the <filefilter> subtag should contain Perl
                   1537: code that when surrounded by "sub { my $filename = shift; " and "}",
                   1538: returns a true value if the user can pick that file, or false otherwise.
                   1539: The filename passed to the function will be just the name of the file, 
                   1540: with no path info.
                   1541: 
                   1542: =cut
                   1543: 
                   1544: no strict;
                   1545: @ISA = ("Apache::lonhelper::element");
                   1546: use strict;
                   1547: 
                   1548: BEGIN {
1.7       bowersj2 1549:     &Apache::lonhelper::register('Apache::lonhelper::files',
                   1550:                                  ('files', 'filechoice', 'filefilter'));
1.5       bowersj2 1551: }
                   1552: 
                   1553: sub new {
                   1554:     my $ref = Apache::lonhelper::element->new();
                   1555:     bless($ref);
                   1556: }
                   1557: 
                   1558: sub start_files {
                   1559:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1560: 
                   1561:     if ($target ne 'helper') {
                   1562:         return '';
                   1563:     }
                   1564:     $paramHash->{'variable'} = $token->[2]{'variable'};
                   1565:     $helper->declareVar($paramHash->{'variable'});
                   1566:     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
                   1567: }    
                   1568: 
                   1569: sub end_files {
                   1570:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1571: 
                   1572:     if ($target ne 'helper') {
                   1573:         return '';
                   1574:     }
                   1575:     if (!defined($paramHash->{FILTER_FUNC})) {
                   1576:         $paramHash->{FILTER_FUNC} = sub { return 1; };
                   1577:     }
                   1578:     Apache::lonhelper::files->new();
                   1579: }    
                   1580: 
                   1581: sub start_filechoice {
                   1582:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1583: 
                   1584:     if ($target ne 'helper') {
                   1585:         return '';
                   1586:     }
                   1587:     $paramHash->{'filechoice'} = Apache::lonxml::get_all_text('/filechoice',
                   1588:                                                               $parser);
                   1589: }
                   1590: 
                   1591: sub end_filechoice { return ''; }
                   1592: 
                   1593: sub start_filefilter {
                   1594:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1595: 
                   1596:     if ($target ne 'helper') {
                   1597:         return '';
                   1598:     }
                   1599: 
                   1600:     my $contents = Apache::lonxml::get_all_text('/filefilter',
                   1601:                                                 $parser);
                   1602:     $contents = 'sub { my $filename = shift; ' . $contents . '}';
                   1603:     $paramHash->{FILTER_FUNC} = eval $contents;
                   1604: }
                   1605: 
                   1606: sub end_filefilter { return ''; }
1.3       bowersj2 1607: 
                   1608: sub render {
                   1609:     my $self = shift;
1.5       bowersj2 1610:     my $result = '';
                   1611:     my $var = $self->{'variable'};
                   1612:     
                   1613:     my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}');
                   1614:     my $subdir = &$subdirFunc();
                   1615: 
                   1616:     my $filterFunc = $self->{FILTER_FUNC};
                   1617:     my $buttons = '';
                   1618: 
                   1619:     if ($self->{'multichoice'}) {
                   1620:         $result = <<SCRIPT;
                   1621: <script>
                   1622:     function checkall(value) {
                   1623: 	for (i=0; i<document.forms.wizform.elements.length; i++) {
                   1624:             ele = document.forms.wizform.elements[i];
                   1625:             if (ele.type == "checkbox") {
                   1626:                 document.forms.wizform.elements[i].checked=value;
                   1627:             }
                   1628:         }
                   1629:     }
                   1630: </script>
                   1631: SCRIPT
                   1632:         my $buttons = <<BUTTONS;
                   1633: <br /> &nbsp;
                   1634: <input type="button" onclick="checkall(true)" value="Select All" />
                   1635: <input type="button" onclick="checkall(false)" value="Unselect All" />
                   1636: <br /> &nbsp;
                   1637: BUTTONS
                   1638:     }
                   1639: 
                   1640:     # Get the list of files in this directory.
                   1641:     my @fileList;
                   1642: 
                   1643:     # If the subdirectory is in local CSTR space
                   1644:     if ($subdir =~ m|/home/([^/]+)/public_html|) {
                   1645:         my $user = $1;
                   1646:         my $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
                   1647:         @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, '');
                   1648:     } else {
                   1649:         # local library server resource space
                   1650:         @fileList = &Apache::lonnet::dirlist($subdir, $ENV{'user.domain'}, $ENV{'user.name'}, '');
                   1651:     }
1.3       bowersj2 1652: 
1.5       bowersj2 1653:     $result .= $buttons;
                   1654: 
1.6       bowersj2 1655:     if (defined $self->{ERROR_MSG}) {
                   1656:         $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
                   1657:     }
                   1658: 
1.5       bowersj2 1659:     $result .= '<table border="0" cellpadding="1" cellspacing="1">';
                   1660: 
                   1661:     # Keeps track if there are no choices, prints appropriate error
                   1662:     # if there are none. 
                   1663:     my $choices = 0;
                   1664:     my $type = 'radio';
                   1665:     if ($self->{'multichoice'}) {
                   1666:         $type = 'checkbox';
                   1667:     }
                   1668:     # Print each legitimate file choice.
                   1669:     for my $file (@fileList) {
                   1670:         $file = (split(/&/, $file))[0];
                   1671:         if ($file eq '.' || $file eq '..') {
                   1672:             next;
                   1673:         }
                   1674:         my $fileName = $subdir .'/'. $file;
                   1675:         if (&$filterFunc($file)) {
                   1676:             $result .= '<tr><td align="right">' .
                   1677:                 "<input type='$type' name='" . $var
                   1678:             . ".forminput' value='" . HTML::Entities::encode($fileName) .
                   1679:                 "'";
                   1680:             if (!$self->{'multichoice'} && $choices == 0) {
                   1681:                 $result .= ' checked';
                   1682:             }
                   1683:             $result .= "/></td><td>" . $file . "</td></tr>\n";
                   1684:             $choices++;
                   1685:         }
                   1686:     }
                   1687: 
                   1688:     $result .= "</table>\n";
                   1689: 
                   1690:     if (!$choices) {
                   1691:         $result .= '<font color="#FF0000">There are no files available to select in this directory. Please go back and select another option.</font><br /><br />';
                   1692:     }
                   1693: 
                   1694:     $result .= $buttons;
                   1695: 
                   1696:     return $result;
1.4       bowersj2 1697: }
1.5       bowersj2 1698: 
1.4       bowersj2 1699: sub postprocess {
                   1700:     my $self = shift;
1.6       bowersj2 1701:     my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
                   1702:     if (!$result) {
                   1703:         $self->{ERROR_MSG} = 'You must choose at least one file '.
                   1704:             'to continue.';
                   1705:         return 0;
                   1706:     }
                   1707: 
1.5       bowersj2 1708:     if ($self->{'multichoice'}) {
                   1709:         $self->process_multiple_choices($self->{'variable'}.'.forminput',
                   1710:                                         $self->{'variable'});
                   1711:     }
                   1712:     if (defined($self->{NEXTSTATE})) {
                   1713:         $helper->changeState($self->{NEXTSTATE});
1.3       bowersj2 1714:     }
1.6       bowersj2 1715: 
                   1716:     return 1;
1.3       bowersj2 1717: }
1.8       bowersj2 1718: 
                   1719: 1;
                   1720: 
                   1721: package Apache::lonhelper::general;
                   1722: 
                   1723: =pod
                   1724: 
                   1725: =head2 General-purpose tag: <exec>
                   1726: 
                   1727: The contents of the exec tag are executed as Perl code, not inside a 
                   1728: safe space, so the full range of $ENV and such is available. The code
                   1729: will be executed as a subroutine wrapped with the following code:
                   1730: 
                   1731: "sub { my $helper = shift; my $state = shift;" and
                   1732: 
                   1733: "}"
                   1734: 
                   1735: The return value is ignored.
                   1736: 
                   1737: $helper is the helper object. Feel free to add methods to the helper
                   1738: object to support whatever manipulation you may need to do (for instance,
                   1739: overriding the form location if the state is the final state; see 
                   1740: lonparm.helper for an example).
                   1741: 
                   1742: $state is the $paramHash that has currently been generated and may
                   1743: be manipulated by the code in exec. Note that the $state is not yet
                   1744: an actual state B<object>, it is just a hash, so do not expect to
                   1745: be able to call methods on it.
                   1746: 
                   1747: =cut
                   1748: 
                   1749: BEGIN {
                   1750:     &Apache::lonhelper::register('Apache::lonhelper::general',
                   1751:                                  'exec', 'condition', 'clause');
                   1752: }
                   1753: 
                   1754: sub start_exec {
                   1755:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1756: 
                   1757:     if ($target ne 'helper') {
                   1758:         return '';
                   1759:     }
                   1760:     
                   1761:     my $code = &Apache::lonxml::get_all_text('/exec', $parser);
                   1762:     
                   1763:     $code = eval ('sub { my $helper = shift; my $state = shift; ' .
                   1764:         $code . "}");
                   1765:     &$code($helper, $paramHash);
                   1766: }
                   1767: 
                   1768: sub end_exec { return ''; }
                   1769: 
                   1770: =pod
                   1771: 
                   1772: =head2 General-purpose tag: <condition>
                   1773: 
                   1774: The <condition> tag allows you to mask out parts of the helper code
                   1775: depending on some programatically determined condition. The condition
                   1776: tag contains a tag <clause> which contains perl code that when wrapped
                   1777: with "sub { my $helper = shift; my $state = shift; " and "}", returns
                   1778: a true value if the XML in the condition should be evaluated as a normal
                   1779: part of the helper, or false if it should be completely discarded.
                   1780: 
                   1781: The <clause> tag must be the first sub-tag of the <condition> tag or
                   1782: it will not work as expected.
                   1783: 
                   1784: =cut
                   1785: 
                   1786: # The condition tag just functions as a marker, it doesn't have
                   1787: # to "do" anything. Technically it doesn't even have to be registered
                   1788: # with the lonxml code, but I leave this here to be explicit about it.
                   1789: sub start_condition { return ''; }
                   1790: sub end_condition { return ''; }
                   1791: 
                   1792: sub start_clause {
                   1793:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   1794: 
                   1795:     if ($target ne 'helper') {
                   1796:         return '';
                   1797:     }
                   1798:     
                   1799:     my $clause = Apache::lonxml::get_all_text('/clause', $parser);
                   1800:     $clause = eval('sub { my $helper = shift; my $state = shift; '
                   1801:         . $clause . '}');
                   1802:     if (!&$clause($helper, $paramHash)) {
                   1803:         # Discard all text until the /condition.
                   1804:         &Apache::lonxml::get_all_text('/condition', $parser);
                   1805:     }
                   1806: }
                   1807: 
                   1808: sub end_clause { return ''; }
1.5       bowersj2 1809: 
1.4       bowersj2 1810: 1;
1.3       bowersj2 1811: 
1.1       bowersj2 1812: __END__
1.3       bowersj2 1813: 

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