--- loncom/interface/lonhelper.pm 2003/03/21 18:11:11 1.1 +++ loncom/interface/lonhelper.pm 2003/04/11 18:16:04 1.8 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # .helper XML handler to implement the LON-CAPA helper # -# $Id: lonhelper.pm,v 1.1 2003/03/21 18:11:11 bowersj2 Exp $ +# $Id: lonhelper.pm,v 1.8 2003/04/11 18:16:04 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,8 +30,1781 @@ # (.helper handler # +=pod + +=head1 lonhelper - HTML Helper framework for LON-CAPA + +Helpers, often known as "wizards", are well-established UI widgets that users +feel comfortable with. It can take a complicated multidimensional problem the +user has and turn it into a series of bite-sized one-dimensional questions. + +For developers, helpers provide an easy way to bundle little bits of functionality +for the user, without having to write the tedious state-maintenence code. + +Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers +directory and having the .helper file extension. For examples, see that directory. + +All classes are in the Apache::lonhelper namespace. + +=head2 lonhelper XML file format + +A helper consists of a top-level tag which contains a series of states. +Each state contains one or more state elements, which are what the user sees, like +messages, resource selections, or date queries. + +The helper tag is required to have one attribute, "title", which is the name +of the helper itself, such as "Parameter helper". + +=head2 State tags + +State tags are required to have an attribute "name", which is the symbolic +name of the state and will not be directly seen by the user. The helper is +required to have one state named "START", which is the state the helper +will start with. By convention, this state should clearly describe what +the helper will do for the user, and may also include the first information +entry the user needs to do for the helper. + +State tags are also required to have an attribute "title", which is the +human name of the state, and will be displayed as the header on top of +the screen for the user. + +=head2 Example Helper Skeleton + +An example of the tags so far: + + + + + + + + + +Of course this does nothing. In order for the wizard to do something, it is +necessary to put actual elements into the wizard. Documentation for each +of these elements follows. + +=cut + package Apache::lonhelper; +use Apache::Constants qw(:common); +use Apache::File; +use Apache::lonxml; + +# Register all the tags with the helper, so the helper can +# push and pop them + +my @helperTags; + +sub register { + my ($namespace, @tags) = @_; + + for my $tag (@tags) { + push @helperTags, [$namespace, $tag]; + } +} + +BEGIN { + Apache::lonxml::register('Apache::lonhelper', + ('helper')); + register('Apache::lonhelper', ('state')); +} + +# Since all helpers are only three levels deep (helper tag, state tag, +# substate type), it's easier and more readble to explicitly track +# those three things directly, rather then futz with the tag stack +# every time. +my $helper; +my $state; +my $substate; +# To collect parameters, the contents of the subtags are collected +# into this paramHash, then passed to the element object when the +# end of the element tag is located. +my $paramHash; + +sub handler { + my $r = shift; + $ENV{'request.uri'} = $r->uri(); + my $filename = '/home/httpd/html' . $r->uri(); + my $fh = Apache::File->new($filename); + my $file; + read $fh, $file, 100000000; + + Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); + + # Send header, don't cache this page + if ($r->header_only) { + if ($ENV{'browser.mathml'}) { + $r->content_type('text/xml'); + } else { + $r->content_type('text/html'); + } + $r->send_http_header; + return OK; + } + if ($ENV{'browser.mathml'}) { + $r->content_type('text/xml'); + } else { + $r->content_type('text/html'); + } + $r->send_http_header; + $r->rflush(); + + # Discard result, we just want the objects that get created by the + # xml parsing + &Apache::lonxml::xmlparse($r, 'helper', $file); + + $r->print($helper->display()); + return OK; +} + +sub start_helper { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + for my $tagList (@helperTags) { + Apache::lonxml::register($tagList->[0], $tagList->[1]); + } + + $helper = Apache::lonhelper::helper->new($token->[2]{'title'}); + return ''; +} + +sub end_helper { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + for my $tagList (@helperTags) { + Apache::lonxml::deregister($tagList->[0], $tagList->[1]); + } + + return ''; +} + +sub start_state { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $state = Apache::lonhelper::state->new($token->[2]{'name'}, + $token->[2]{'title'}); + return ''; +} + +# don't need this, so ignore it +sub end_state { + return ''; +} + +1; + +package Apache::lonhelper::helper; + +use Digest::MD5 qw(md5_hex); +use HTML::Entities; +use Apache::loncommon; +use Apache::File; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + + $self->{TITLE} = shift; + + # If there is a state from the previous form, use that. If there is no + # state, use the start state parameter. + if (defined $ENV{"form.CURRENT_STATE"}) + { + $self->{STATE} = $ENV{"form.CURRENT_STATE"}; + } + else + { + $self->{STATE} = "START"; + } + + $self->{TOKEN} = $ENV{'form.TOKEN'}; + # If a token was passed, we load that in. Otherwise, we need to create a + # new storage file + # Tried to use standard Tie'd hashes, but you can't seem to take a + # reference to a tied hash and write to it. I'd call that a wart. + if ($self->{TOKEN}) { + # Validate the token before trusting it + if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) { + # Not legit. Return nothing and let all hell break loose. + # User shouldn't be doing that! + return undef; + } + + # Get the hash. + $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file + + my $file = Apache::File->new($self->{FILENAME}); + my $contents = <$file>; + + # Now load in the contents + for my $value (split (/&/, $contents)) { + my ($name, $value) = split(/=/, $value); + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; + $self->{VARS}->{$name} = $value; + } + + $file->close(); + } else { + # Only valid if we're just starting. + if ($self->{STATE} ne 'START') { + return undef; + } + # Must create the storage + $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} . + time() . rand()); + $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); + } + + # OK, we now have our persistent storage. + + if (defined $ENV{"form.RETURN_PAGE"}) + { + $self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"}; + } + else + { + $self->{RETURN_PAGE} = $ENV{REFERER}; + } + + $self->{STATES} = {}; + $self->{DONE} = 0; + + bless($self, $class); + return $self; +} + +# Private function; returns a string to construct the hidden fields +# necessary to have the helper track state. +sub _saveVars { + my $self = shift; + my $result = ""; + $result .= '\n"; + $result .= '\n"; + $result .= '\n"; + + return $result; +} + +# Private function: Create the querystring-like representation of the stored +# data to write to disk. +sub _varsInFile { + my $self = shift; + my @vars = (); + for my $key (keys %{$self->{VARS}}) { + push @vars, &Apache::lonnet::escape($key) . '=' . + &Apache::lonnet::escape($self->{VARS}->{$key}); + } + return join ('&', @vars); +} + +# Use this to declare variables. +# FIXME: Document this +sub declareVar { + my $self = shift; + my $var = shift; + + if (!defined($self->{VARS}->{$var})) { + $self->{VARS}->{$var} = ''; + } + + my $envname = 'form.' . $var . '.forminput'; + if (defined($ENV{$envname})) { + $self->{VARS}->{$var} = $ENV{$envname}; + } +} + +sub changeState { + my $self = shift; + $self->{STATE} = shift; +} + +sub registerState { + my $self = shift; + my $state = shift; + + my $stateName = $state->name(); + $self->{STATES}{$stateName} = $state; +} + +# Done in four phases +# 1: Do the post processing for the previous state. +# 2: Do the preprocessing for the current state. +# 3: Check to see if state changed, if so, postprocess current and move to next. +# Repeat until state stays stable. +# 4: Render the current state to the screen as an HTML page. +sub display { + my $self = shift; + + my $result = ""; + + # Phase 1: Post processing for state of previous screen (which is actually + # the "current state" in terms of the helper variables), if it wasn't the + # beginning state. + if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq "Next ->") { + my $prevState = $self->{STATES}{$self->{STATE}}; + $prevState->postprocess(); + } + + # Note, to handle errors in a state's input that a user must correct, + # do not transition in the postprocess, and force the user to correct + # the error. + + # Phase 2: Preprocess current state + my $startState = $self->{STATE}; + my $state = $self->{STATES}{$startState}; + + # Error checking; it is intended that the developer will have + # checked all paths and the user can't see this! + if (!defined($state)) { + $result .="Error! The state ". $startState ." is not defined."; + return $result; + } + $state->preprocess(); + + # Phase 3: While the current state is different from the previous state, + # keep processing. + while ( $startState ne $self->{STATE} ) + { + $startState = $self->{STATE}; + $state = $self->{STATES}{$startState}; + $state->preprocess(); + } + + # Phase 4: Display. + my $stateTitle = $state->title(); + my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'',''); + + $result .= < + + LON-CAPA Helper: $self->{TITLE} + + $bodytag +HEADER + if (!$state->overrideForm()) { $result.="
"; } + $result .= < +

$stateTitle

+HEADER + + if (!$state->overrideForm()) { + $result .= $self->_saveVars(); + } + $result .= $state->render() . "

 

"; + + if (!$state->overrideForm()) { + $result .= '
'; + if ($self->{STATE} ne $self->{START_STATE}) { + #$result .= '  '; + } + if ($self->{DONE}) { + my $returnPage = $self->{RETURN_PAGE}; + $result .= "End Helper"; + } + else { + $result .= '{VARS}}) { + $result .= "|$key| -> " . $self->{VARS}->{$key} . "
"; + } + + $result .= < + + + + + +FOOTER + + # Handle writing out the vars to the file + my $file = Apache::File->new('>'.$self->{FILENAME}); + print $file $self->_varsInFile(); + + return $result; +} + +1; + +package Apache::lonhelper::state; + +# States bundle things together and are responsible for compositing the +# various elements together. It is not generally necessary for users to +# use the state object directly, so it is not perldoc'ed. + +# Basically, all the states do is pass calls to the elements and aggregate +# the results. + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + + $self->{NAME} = shift; + $self->{TITLE} = shift; + $self->{ELEMENTS} = []; + + bless($self, $class); + + $helper->registerState($self); + + return $self; +} + +sub name { + my $self = shift; + return $self->{NAME}; +} + +sub title { + my $self = shift; + return $self->{TITLE}; +} + +sub preprocess { + my $self = shift; + for my $element (@{$self->{ELEMENTS}}) { + $element->preprocess(); + } +} + +# FIXME: Document that all postprocesses must return a true value or +# the state transition will be overridden +sub postprocess { + my $self = shift; + + # Save the state so we can roll it back if we need to. + my $originalState = $helper->{STATE}; + my $everythingSuccessful = 1; + + for my $element (@{$self->{ELEMENTS}}) { + my $result = $element->postprocess(); + if (!$result) { $everythingSuccessful = 0; } + } + + # If not all the postprocesses were successful, override + # any state transitions that may have occurred. It is the + # responsibility of the states to make sure they have + # error handling in that case. + if (!$everythingSuccessful) { + $helper->{STATE} = $originalState; + } +} + +sub overrideForm { + return 0; +} + +sub addElement { + my $self = shift; + my $element = shift; + + push @{$self->{ELEMENTS}}, $element; +} + +sub render { + my $self = shift; + my @results = (); + + for my $element (@{$self->{ELEMENTS}}) { + push @results, $element->render(); + } + return join("\n", @results); +} + +1; + +package Apache::lonhelper::element; +# Support code for elements + +=pod + +=head2 Element Base Class + +The Apache::lonhelper::element base class provides support methods for +the elements to use, such as a multiple value processer. + +B: + +=over 4 + +=item * process_multiple_choices(formName, varName): Process the form +element named "formName" and place the selected items into the helper +variable named varName. This is for things like checkboxes or +multiple-selection listboxes where the user can select more then +one entry. The selected entries are delimited by triple pipes in +the helper variables, like this: + + CHOICE_1|||CHOICE_2|||CHOICE_3 + +=back + +=cut + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::element', + ('nextstate')); +} + +# Because we use the param hash, this is often a sufficent +# constructor +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $paramHash; + bless($self, $class); + + $self->{PARAMS} = $paramHash; + $self->{STATE} = $state; + $state->addElement($self); + + # Ensure param hash is not reused + $paramHash = {}; + + return $self; +} + +sub start_nextstate { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{NEXTSTATE} = &Apache::lonxml::get_all_text('/nextstate', + $parser); + return ''; +} + +sub end_nextstate { return ''; } + +sub preprocess { + return 1; +} + +sub postprocess { + return 1; +} + +sub render { + return ''; +} + +sub process_multiple_choices { + my $self = shift; + my $formname = shift; + my $var = shift; + + my $formvalue = $ENV{'form.' . $formname}; + if ($formvalue) { + # Must extract values from querystring directly, as there + # may be more then one. + my @values; + for my $formparam (split (/&/, $ENV{QUERY_STRING})) { + my ($name, $value) = split(/=/, $formparam); + if ($name ne $formname) { + next; + } + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; + push @values, $value; + } + $helper->{VARS}->{$var} = join('|||', @values); + } + + return; +} + +1; + +package Apache::lonhelper::message; + +=pod + +=head2 Element: message + +Message elements display the contents of their tags, and +transition directly to the state in the tag. Example: + + + GET_NAME + This is the message the user will see, + HTML allowed. + + +This will display the HTML message and transition to the if +given. The HTML will be directly inserted into the helper, so if you don't +want text to run together, you'll need to manually wrap the +in

tags, or whatever is appropriate for your HTML. + +Message tags do not add in whitespace, so if you want it, you'll need to add +it into states. This is done so you can inline some elements, such as +the element, right between two messages, giving the appearence that +the element appears inline. (Note the elements can not be embedded +within each other.) + +This is also a good template for creating your own new states, as it has +very little code beyond the state template. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::message', + ('message', 'message_text')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_message { + return ''; +} + +sub end_message { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::message->new(); + return ''; +} + +sub start_message_text { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{MESSAGE_TEXT} = &Apache::lonxml::get_all_text('/message_text', + $parser); +} + +sub end_message_text { return 1; } + +sub render { + my $self = shift; + + return $self->{MESSAGE_TEXT}; +} +# If a NEXTSTATE was given, switch to it +sub postprocess { + my $self = shift; + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} +1; + +package Apache::lonhelper::choices; + +=pod + +=head2 Element: choices + +Choice states provide a single choice to the user as a text selection box. +A "choice" is two pieces of text, one which will be displayed to the user +(the "human" value), and one which will be passed back to the program +(the "computer" value). For instance, a human may choose from a list of +resources on disk by title, while your program wants the file name. + + takes an attribute "variable" to control which helper variable +the result is stored in. + + takes an attribute "multichoice" which, if set to a true +value, will allow the user to select multiple choices. + +B + + can have the following subtags: + +=over 4 + +=item * state_name: If given, this will cause the + choice element to transition to the given state after executing. If + this is used, do not pass nextstates to the tag. + +=item * : If the choices are static, + this element will allow you to specify them. Each choice + contains attribute, "computer", as described above. The + content of the tag will be used as the human label. + For example, + Bobby McDormik. + + may optionally contain a 'nextstate' attribute, which +will be the state transisitoned to if the choice is made, if +the choice is not multichoice. + +=back + +To create the choices programmatically, either wrap the choices in + tags (prefered), or use an block inside the +tag. Store the choices in $state->{CHOICES}, which is a list of list +references, where each list has three strings. The first is the human +name, the second is the computer name. and the third is the option +next state. For example: + + + for (my $i = 65; $i < 65 + 26; $i++) { + push @{$state->{CHOICES}}, [chr($i), $i, 'next']; + } + + +This will allow the user to select from the letters A-Z (in ASCII), while +passing the ASCII value back into the helper variables, and the state +will in all cases transition to 'next'. + +You can mix and match methods of creating choices, as long as you always +"push" onto the choice list, rather then wiping it out. (You can even +remove choices programmatically, but that would probably be bad form.) + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::choices', + ('choice', 'choices')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_choices { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + # Need to initialize the choices list, so everything can assume it exists + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; + $paramHash->{CHOICES} = []; + return ''; +} + +sub end_choices { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::choices->new(); + return ''; +} + +sub start_choice { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $computer = $token->[2]{'computer'}; + my $human = &Apache::lonxml::get_all_text('/choice', + $parser); + my $nextstate = $token->[2]{'nextstate'}; + push @{$paramHash->{CHOICES}}, [$human, $computer, $nextstate]; + return ''; +} + +sub end_choice { + return ''; +} + +sub render { + # START HERE: Replace this with correct choices code. + my $self = shift; + my $var = $self->{'variable'}; + my $buttons = ''; + my $result = ''; + + if ($self->{'multichoice'}) { + $result .= < + function checkall(value) { + for (i=0; i +SCRIPT + $buttons = < + + +
  +BUTTONS + } + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '
'; + } + + $result .= $buttons; + + $result .= "\n\n"; + + my $type = "radio"; + if ($self->{'multichoice'}) { $type = 'checkbox'; } + my $checked = 0; + foreach my $choice (@{$self->{CHOICES}}) { + $result .= "\n\n"; + $result .= "\n"; + } + $result .= "
 {'multichoice'} && !$checked) { + $result .= " checked "; + $checked = 1; + } + $result .= "/> " . $choice->[0] . "
\n\n\n"; + $result .= $buttons; + + return $result; +} + +# If a NEXTSTATE was given or a nextstate for this choice was +# given, switch to it +sub postprocess { + my $self = shift; + my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'}; + + if (!$chosenValue) { + $self->{ERROR_MSG} = "You must choose one or more choices to" . + " continue."; + return 0; + } + + if ($self->{'multichoice'}) { + $self->process_multiple_choices($self->{'variable'}.'.forminput', + $self->{'variable'}); + } + + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + foreach my $choice (@{$self->{CHOICES}}) { + if ($choice->[1] eq $chosenValue) { + if (defined($choice->[2])) { + $helper->changeState($choice->[2]); + } + } + } + return 1; +} +1; + +package Apache::lonhelper::date; + +=pod + +=head2 Element: date + +Date elements allow the selection of a date with a drop down list. + +Date elements can take two attributes: + +=over 4 + +=item * B: The name of the variable to store the chosen + date in. Required. + +=item * B: If a true value, the date will show hours + and minutes, as well as month/day/year. If false or missing, + the date will only show the month, day, and year. + +=back + +Date elements contain only an option tag to determine +the next state. + +Example: + + + choose_why + + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +use Time::localtime; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::date', + ('date')); +} + +# Don't need to override the "new" from element +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +my @months = ("January", "February", "March", "April", "May", "June", "July", + "August", "September", "October", "November", "December"); + +# CONSTRUCTION: Construct the message element from the XML +sub start_date { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'hoursminutes'} = $token->[2]{'hoursminutes'}; +} + +sub end_date { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::date->new(); + return ''; +} + +sub render { + my $self = shift; + my $result = ""; + my $var = $self->{'variable'}; + + my $date; + + # Default date: The current hour. + $date = localtime(); + $date->min(0); + + if (defined $self->{ERROR_MSG}) { + $result .= '' . $self->{ERROR_MSG} . '

'; + } + + # Month + my $i; + $result .= "\n"; + + # Day + $result .= ",\n"; + + # Year + $result .= ",\n"; + + # Display Hours and Minutes if they are called for + if ($self->{'hoursminutes'}) { + # Build hour + $result .= " :\n"; + + $result .= "\n"; + } + + return $result; + +} +# If a NEXTSTATE was given, switch to it +sub postprocess { + my $self = shift; + my $var = $self->{'variable'}; + my $month = $ENV{'form.' . $var . 'month'}; + my $day = $ENV{'form.' . $var . 'day'}; + my $year = $ENV{'form.' . $var . 'year'}; + my $min = 0; + my $hour = 0; + if ($self->{'hoursminutes'}) { + $min = $ENV{'form.' . $var . 'minute'}; + $hour = $ENV{'form.' . $var . 'hour'}; + } + + my $chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year); + # Check to make sure that the date was not automatically co-erced into a + # valid date, as we want to flag that as an error + # This happens for "Feb. 31", for instance, which is coerced to March 2 or + # 3, depending on if it's a leapyear + my $checkDate = localtime($chosenDate); + + if ($checkDate->mon != $month || $checkDate->mday != $day || + $checkDate->year + 1900 != $year) { + $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a " + . "date because it doesn't exist. Please enter a valid date."; + return 0; + } + + $helper->{VARS}->{$var} = $chosenDate; + + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} +1; + +package Apache::lonhelper::resource; + +=pod + +=head2 Element: resource + + elements allow the user to select one or multiple resources +from the current course. You can filter out which resources they can view, +and filter out which resources they can select. The course will always +be displayed fully expanded, because of the difficulty of maintaining +selections across folder openings and closings. If this is fixed, then +the user can manipulate the folders. + + takes the standard variable attribute to control what helper +variable stores the results. It also takes a "multichoice" attribute, +which controls whether the user can select more then one resource. + +B + +=over 4 + +=item * : If you want to filter what resources are displayed + to the user, use a filter func. The tag should contain + Perl code that when wrapped with "sub { my $res = shift; " and "}" is + a function that returns true if the resource should be displayed, + and false if it should be skipped. $res is a resource object. + (See Apache::lonnavmaps documentation for information about the + resource object.) + +=item * : Same as , except that controls whether + the given resource can be chosen. (It is almost always a good idea to + show the user the folders, for instance, but you do not always want to + let the user select them.) + +=item * : Standard nextstate behavior. + +=item * : This function controls what is returned by the resource + when the user selects it. Like filterfunc and choicefunc, it should be + a function fragment that when wrapped by "sub { my $res = shift; " and + "}" returns a string representing what you want to have as the value. By + default, the value will be the resource ID of the object ($res->{ID}). + +=back + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::resource', + ('resource', 'filterfunc', + 'choicefunc', 'valuefunc')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_resource { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + return ''; +} + +sub end_resource { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + if (!defined($paramHash->{FILTER_FUNC})) { + $paramHash->{FILTER_FUNC} = sub {return 1;}; + } + if (!defined($paramHash->{CHOICE_FUNC})) { + $paramHash->{CHOICE_FUNC} = sub {return 1;}; + } + if (!defined($paramHash->{VALUE_FUNC})) { + $paramHash->{VALUE_FUNC} = sub {my $res = shift; return $res->{ID}; }; + } + Apache::lonhelper::resource->new(); + return ''; +} + +sub start_filterfunc { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $contents = Apache::lonxml::get_all_text('/filterfunc', + $parser); + $contents = 'sub { my $res = shift; ' . $contents . '}'; + $paramHash->{FILTER_FUNC} = eval $contents; +} + +sub end_filterfunc { return ''; } + +sub start_choicefunc { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $contents = Apache::lonxml::get_all_text('/choicefunc', + $parser); + $contents = 'sub { my $res = shift; ' . $contents . '}'; + $paramHash->{CHOICE_FUNC} = eval $contents; +} + +sub end_choicefunc { return ''; } + +sub start_valuefunc { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $contents = Apache::lonxml::get_all_text('/valuefunc', + $parser); + $contents = 'sub { my $res = shift; ' . $contents . '}'; + $paramHash->{VALUE_FUNC} = eval $contents; +} + +sub end_valuefunc { return ''; } + +# A note, in case I don't get to this before I leave. +# If someone complains about the "Back" button returning them +# to the previous folder state, instead of returning them to +# the previous helper state, the *correct* answer is for the helper +# to keep track of how many times the user has manipulated the folders, +# and feed that to the history.go() call in the helper rendering routines. +# If done correctly, the helper itself can keep track of how many times +# it renders the same states, so it doesn't go in just this state, and +# you can lean on the browser back button to make sure it all chains +# correctly. +# Right now, though, I'm just forcing all folders open. + +sub render { + my $self = shift; + my $result = ""; + my $var = $self->{'variable'}; + my $curVal = $helper->{VARS}->{$var}; + + if (defined $self->{ERROR_MSG}) { + $result .= '' . $self->{ERROR_MSG} . '

'; + } + + my $filterFunc = $self->{FILTER_FUNC}; + my $choiceFunc = $self->{CHOICE_FUNC}; + my $valueFunc = $self->{VALUE_FUNC}; + + # Create the composite function that renders the column on the nav map + # have to admit any language that lets me do this can't be all bad + # - Jeremy (Pythonista) ;-) + my $checked = 0; + my $renderColFunc = sub { + my ($resource, $part, $params) = @_; + + if (!&$choiceFunc($resource)) { + return ' '; + } else { + my $col = ""; + return $col; + } + }; + + $ENV{'form.condition'} = 1; + $result .= + &Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, + Apache::lonnavmaps::resource()], + 'showParts' => 0, + 'url' => $helper->{URL}, + 'filterFunc' => $filterFunc, + 'resource_no_folder_link' => 1 } + ); + + return $result; +} + +sub postprocess { + my $self = shift; + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::student; + +=pod + +=head2 Element: student + +Student elements display a choice of students enrolled in the current +course. Currently it is primitive; this is expected to evolve later. + +Student elements take two attributes: "variable", which means what +it usually does, and "multichoice", which if true allows the user +to select multiple students. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + + + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::student', + ('student')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +sub start_student { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; +} + +sub end_student { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::student->new(); +} + +sub render { + my $self = shift; + my $result = ''; + my $buttons = ''; + + if ($self->{'multichoice'}) { + $result = < + function checkall(value) { + for (i=0; i +SCRIPT + $buttons = < + + +
+BUTTONS + } + + if (defined $self->{ERROR_MSG}) { + $result .= '' . $self->{ERROR_MSG} . '

'; + } + + # Load up the students + my $choices = &Apache::loncoursedata::get_classlist(); + + my @keys = keys %{$choices}; + + # Constants + my $section = Apache::loncoursedata::CL_SECTION(); + my $fullname = Apache::loncoursedata::CL_FULLNAME(); + + # Sort by: Section, name + @keys = sort { + if ($choices->{$a}->[$section] ne $choices->{$b}->[$section]) { + return $choices->{$a}->[$section] cmp $choices->{$b}->[$section]; + } + return $choices->{$a}->[$fullname] cmp $choices->{$b}->[$fullname]; + } @keys; + + my $type = 'radio'; + if ($self->{'multichoice'}) { $type = 'checkbox'; } + $result .= "\n"; + $result .= "". + ""; + + my $checked = 0; + foreach (@keys) { + $result .= "\n"; + } + + $result .= "
Student NameSection
{'multichoice'} && !$checked) { + $result .= " checked "; + $checked = 1; + } + $result .= + " value='" . HTML::Entities::encode($_) + . "' />" + . HTML::Entities::encode($choices->{$_}->[$fullname]) + . "" + . HTML::Entities::encode($choices->{$_}->[$section]) + . "
\n\n"; + $result .= $buttons; + + return $result; +} + +sub postprocess { + my $self = shift; + + my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; + if (!$result) { + $self->{ERROR_MSG} = 'You must choose at least one student '. + 'to continue.'; + return 0; + } + + if ($self->{'multichoice'}) { + $self->process_multiple_choices($self->{'variable'}.'.forminput', + $self->{'variable'}); + } + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::files; + +=pod + +=head2 Element: files + +files allows the users to choose files from a given directory on the +server. It is always multichoice and stores the result as a triple-pipe +delimited entry in the helper variables. + +Since it is extremely unlikely that you can actually code a constant +representing the directory you wish to allow the user to search, +takes a subroutine that returns the name of the directory you wish to +have the user browse. + +files accepts the attribute "variable" to control where the files chosen +are put. It accepts the attribute "multichoice" as the other attribute, +defaulting to false, which if true will allow the user to select more +then one choice. + + accepts three subtags. One is the "nextstate" sub-tag that works +as it does with the other tags. Another is a sub tag that +is Perl code that, when surrounded by "sub {" and "}" will return a +string representing what directory on the server to allow the user to +choose files from. Finally, the subtag should contain Perl +code that when surrounded by "sub { my $filename = shift; " and "}", +returns a true value if the user can pick that file, or false otherwise. +The filename passed to the function will be just the name of the file, +with no path info. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::files', + ('files', 'filechoice', 'filefilter')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +sub start_files { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; +} + +sub end_files { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + if (!defined($paramHash->{FILTER_FUNC})) { + $paramHash->{FILTER_FUNC} = sub { return 1; }; + } + Apache::lonhelper::files->new(); +} + +sub start_filechoice { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + $paramHash->{'filechoice'} = Apache::lonxml::get_all_text('/filechoice', + $parser); +} + +sub end_filechoice { return ''; } + +sub start_filefilter { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $contents = Apache::lonxml::get_all_text('/filefilter', + $parser); + $contents = 'sub { my $filename = shift; ' . $contents . '}'; + $paramHash->{FILTER_FUNC} = eval $contents; +} + +sub end_filefilter { return ''; } + +sub render { + my $self = shift; + my $result = ''; + my $var = $self->{'variable'}; + + my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}'); + my $subdir = &$subdirFunc(); + + my $filterFunc = $self->{FILTER_FUNC}; + my $buttons = ''; + + if ($self->{'multichoice'}) { + $result = < + function checkall(value) { + for (i=0; i +SCRIPT + my $buttons = <   + + +
  +BUTTONS + } + + # Get the list of files in this directory. + my @fileList; + + # If the subdirectory is in local CSTR space + if ($subdir =~ m|/home/([^/]+)/public_html|) { + my $user = $1; + my $domain = $Apache::lonnet::perlvar{'lonDefDomain'}; + @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, ''); + } else { + # local library server resource space + @fileList = &Apache::lonnet::dirlist($subdir, $ENV{'user.domain'}, $ENV{'user.name'}, ''); + } + + $result .= $buttons; + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '

'; + } + + $result .= ''; + + # Keeps track if there are no choices, prints appropriate error + # if there are none. + my $choices = 0; + my $type = 'radio'; + if ($self->{'multichoice'}) { + $type = 'checkbox'; + } + # Print each legitimate file choice. + for my $file (@fileList) { + $file = (split(/&/, $file))[0]; + if ($file eq '.' || $file eq '..') { + next; + } + my $fileName = $subdir .'/'. $file; + if (&$filterFunc($file)) { + $result .= '\n"; + $choices++; + } + } + + $result .= "
' . + "{'multichoice'} && $choices == 0) { + $result .= ' checked'; + } + $result .= "/>" . $file . "
\n"; + + if (!$choices) { + $result .= 'There are no files available to select in this directory. Please go back and select another option.

'; + } + + $result .= $buttons; + + return $result; +} + +sub postprocess { + my $self = shift; + my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; + if (!$result) { + $self->{ERROR_MSG} = 'You must choose at least one file '. + 'to continue.'; + return 0; + } + + if ($self->{'multichoice'}) { + $self->process_multiple_choices($self->{'variable'}.'.forminput', + $self->{'variable'}); + } + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::general; + +=pod + +=head2 General-purpose tag: + +The contents of the exec tag are executed as Perl code, not inside a +safe space, so the full range of $ENV and such is available. The code +will be executed as a subroutine wrapped with the following code: + +"sub { my $helper = shift; my $state = shift;" and + +"}" + +The return value is ignored. + +$helper is the helper object. Feel free to add methods to the helper +object to support whatever manipulation you may need to do (for instance, +overriding the form location if the state is the final state; see +lonparm.helper for an example). + +$state is the $paramHash that has currently been generated and may +be manipulated by the code in exec. Note that the $state is not yet +an actual state B, it is just a hash, so do not expect to +be able to call methods on it. + +=cut + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::general', + 'exec', 'condition', 'clause'); +} + +sub start_exec { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $code = &Apache::lonxml::get_all_text('/exec', $parser); + + $code = eval ('sub { my $helper = shift; my $state = shift; ' . + $code . "}"); + &$code($helper, $paramHash); +} + +sub end_exec { return ''; } + +=pod + +=head2 General-purpose tag: + +The tag allows you to mask out parts of the helper code +depending on some programatically determined condition. The condition +tag contains a tag which contains perl code that when wrapped +with "sub { my $helper = shift; my $state = shift; " and "}", returns +a true value if the XML in the condition should be evaluated as a normal +part of the helper, or false if it should be completely discarded. + +The tag must be the first sub-tag of the tag or +it will not work as expected. + +=cut + +# The condition tag just functions as a marker, it doesn't have +# to "do" anything. Technically it doesn't even have to be registered +# with the lonxml code, but I leave this here to be explicit about it. +sub start_condition { return ''; } +sub end_condition { return ''; } + +sub start_clause { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $clause = Apache::lonxml::get_all_text('/clause', $parser); + $clause = eval('sub { my $helper = shift; my $state = shift; ' + . $clause . '}'); + if (!&$clause($helper, $paramHash)) { + # Discard all text until the /condition. + &Apache::lonxml::get_all_text('/condition', $parser); + } +} + +sub end_clause { return ''; } 1; __END__ +