--- loncom/interface/lonhelper.pm 2003/03/21 18:11:11 1.1 +++ loncom/interface/lonhelper.pm 2003/05/12 19:33:57 1.27 @@ -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.27 2003/05/12 19:33:57 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,8 +30,2597 @@ # (.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. + +=head2 Creating a Helper With Code, Not XML + +In some situations, such as the printing wizard (see lonprintout.pm), +writing the helper in XML would be too complicated, because of scope +issues or the fact that the code actually outweighs the XML. It is +possible to create a helper via code, though it is a little odd. + +Creating a helper via code is more like issuing commands to create +a helper then normal code writing. For instance, elements will automatically +be added to the last state created, so it's important to create the +states in the correct order. + +First, create a new helper: + + use Apache::lonhelper; + + my $helper = Apache::lonhelper::new->("Helper Title"); + +Next you'll need to manually add states to the helper: + + Apache::lonhelper::state->new("STATE_NAME", "State's Human Title"); + +You don't need to save a reference to it because all elements up until +the next state creation will automatically be added to this state. + +Elements are created by populating the $paramHash in +Apache::lonhelper::paramhash. To prevent namespace issues, retrieve +a reference to that has with getParamHash: + + my $paramHash = Apache::lonhelper::getParamHash(); + +You will need to do this for each state you create. + +Populate the $paramHash with the parameters for the element you wish +to add next; the easiest way to find out what those entries are is +to read the code. Some common ones are 'variable' to record the variable +to store the results in, and NEXTSTATE to record a next state transition. + +Then create your element: + + $paramHash->{MESSAGETEXT} = "This is a message."; + Apache::lonhelper::message->new(); + +The creation will take the $paramHash and bless it into a +Apache::lonhelper::message object. To create the next element, you need +to get a reference to the new, empty $paramHash: + + $paramHash = Apache::lonhelper::getParamHash(); + +and you can repeat creating elements that way. You can add states +and elements as needed. + +See lonprintout.pm, subroutine printHelper for an example of this, where +we dynamically add some states to prevent security problems, for instance. + +Normally the machinery in the XML format is sufficient; dynamically +adding states can easily be done by wrapping the state in a +tag. This should only be used when the code dominates the XML content, +the code is so complicated that it is difficult to get access to +all of the information you need because of scoping issues, or so much +of the information used is persistent because would-be or + blocks that using the {DATA} mechanism results in hard-to-read +and -maintain code. + +It is possible to do some of the work with an XML fragment parsed by +lonxml; again, see lonprintout.pm for an example. In that case it is +imperative that you call B +before parsing XML fragments and B +when you are done. See lonprintout.pm for examples of this usage in the +printHelper subroutine. + +=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; + +# Note from Jeremy 5-8-2003: It is *vital* that the real handler be called +# as a subroutine from the handler, or very mysterious things might happen. +# I don't know exactly why, but it seems that the scope where the Apache +# server enters the perl handler is treated differently from the rest of +# the handler. This also seems to manifest itself in the debugger as entering +# the perl handler in seemingly random places (sometimes it starts in the +# compiling phase, sometimes in the handler execution phase where it runs +# the code and stepping into the "1;" the module ends with goes into the handler, +# sometimes starting directly with the handler); I think the cause is related. +# In the debugger, this means that breakpoints are ignored until you step into +# a function and get out of what must be a "faked up scope" in the Apache-> +# mod_perl connection. In this code, it was manifesting itself in the existence +# of two seperate file-scoped $helper variables, one set to the value of the +# helper in the helper constructor, and one referenced by the handler on the +# "$helper->process()" line. The second was therefore never set, and was still +# undefined when I tried to call process on it. +# By pushing the "real handler" down into the "real scope", everybody except the +# actual handler function directly below this comment gets the same $helper and +# everybody is happy. +# The upshot of all of this is that for safety when a handler is using +# file-scoped variables in LON-CAPA, the handler should be pushed down one +# call level, as I do here, to ensure that the top-level handler function does +# not get a different file scope from the rest of the code. +sub handler { + my $r = shift; + return real_handler($r); +} + +# For debugging purposes, one can send a second parameter into this +# function, the 'uri' of the helper you wish to have rendered, and +# call this from other handlers. +sub real_handler { + my $r = shift; + my $uri = shift; + if (!defined($uri)) { $uri = $r->uri(); } + $ENV{'request.uri'} = $uri; + my $filename = '/home/httpd/html' . $uri; + my $fh = Apache::File->new($filename); + my $file; + read $fh, $file, 100000000; + + + # 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); + + $helper->process(); + + $r->print($helper->display()); + return OK; +} + +sub registerHelperTags { + for my $tagList (@helperTags) { + Apache::lonxml::register($tagList->[0], $tagList->[1]); + } +} + +sub unregisterHelperTags { + for my $tagList (@helperTags) { + Apache::lonxml::deregister($tagList->[0], $tagList->[1]); + } +} + +sub start_helper { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + registerHelperTags(); + + Apache::lonhelper::helper->new($token->[2]{'title'}); + return ''; +} + +sub end_helper { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + unregisterHelperTags(); + + return ''; +} + +sub start_state { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + Apache::lonhelper::state->new($token->[2]{'name'}, + $token->[2]{'title'}); + return ''; +} + +# Use this to get the param hash from other files. +sub getParamHash { + return $paramHash; +} + +# Use this to get the helper, if implementing elements in other files +# (like lonprintout.pm) +sub getHelper { + return $helper; +} + +# 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; + + Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); + + # 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; + + # Used by various helpers for various things; see lonparm.helper + # for an example. + $self->{DATA} = {}; + + $helper = $self; + + # Establish the $paramHash + $paramHash = {}; + + 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; +} + +sub process { + my $self = shift; + + # 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}; + + # For debugging, print something here to determine if you're going + # to an undefined state. + if (!defined($state)) { + return; + } + $state->preprocess(); + + # Phase 3: While the current state is different from the previous state, + # keep processing. + while ( $startState ne $self->{STATE} && + defined($self->{STATES}->{$self->{STATE}}) ) + { + $startState = $self->{STATE}; + $state = $self->{STATES}->{$startState}; + $state->preprocess(); + } + + return; +} + +# 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 $state = $self->{STATES}{$self->{STATE}}; + + my $result = ""; + + if (!defined($state)) { + $result = "Error: state '$state' not defined!"; + return $result; + } + + # 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); + + $state = $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; + } +} + +# Override the form if any element wants to. +# two elements overriding the form will make a mess, but that should +# be considered helper author error ;-) +sub overrideForm { + my $self = shift; + for my $element (@{$self->{ELEMENTS}}) { + if ($element->overrideForm()) { + return 1; + } + } + 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 + +B + +Each element can contain a "finalcode" tag that, when the special FINAL +helper state is used, will be executed, surrounded by "sub { my $helper = shift;" +and "}". It is expected to return a string describing what it did, which +may be an empty string. See course initialization helper for an example. This is +generally intended for helpers like the course initialization helper, which consist +of several panels, each of which is performing some sort of bite-sized functionality. + +B + +Each element that accepts user input can contain a "defaultvalue" tag that, +when surrounded by "sub { my $helper = shift; my $state = shift; " and "}", +will form a subroutine that when called will provide a default value for +the element. How this value is interpreted by the element is specific to +the element itself, and possibly the settings the element has (such as +multichoice vs. single choice for tags). + +This is also intended for things like the course initialization wizard, where the +user is setting various parameters. By correctly grabbing current settings +and including them into the helper, it allows the user to come back to the +helper later and re-execute it, without needing to worry about overwriting +some setting accidentally. + +Again, see the course initialization helper for examples. + +=cut + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::element', + ('nextstate', 'finalcode', + 'defaultvalue')); +} + +# 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 start_finalcode { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode', + $parser); + return ''; +} + +sub end_finalcode { return ''; } + +sub start_defaultvalue { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue', + $parser); + $paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' . + $paramHash->{DEFAULT_VALUE} . '}'; + return ''; +} + +sub end_defaultvalue { return ''; } + +sub preprocess { + return 1; +} + +sub postprocess { + return 1; +} + +sub render { + return ''; +} + +sub overrideForm { + return 0; +} + +sub process_multiple_choices { + my $self = shift; + my $formname = shift; + my $var = shift; + + # Must extract values from data 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')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_message { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{MESSAGE_TEXT} = &Apache::lonxml::get_all_text('/message', + $parser); + + if (defined($token->[2]{'nextstate'})) { + $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; + } + return ''; +} + +sub end_message { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::message->new(); + return ''; +} + +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. + + takes an attribute "allowempty" which, if set to a true +value, will allow the user to select none of the choices without raising +an error message. + +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. + + can take a parameter "eval", which if set to + a true value, will cause the contents of the tag to be + evaluated as it would be in an tag; see tag + below. + + 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.) + +B + +Choices supports default values both in multichoice and single choice mode. +In single choice mode, have the defaultvalue tag's function return the +computer value of the box you want checked. If the function returns a value +that does not correspond to any of the choices, the default behavior of selecting +the first choice will be preserved. + +For multichoice, return a string with the computer values you want checked, +delimited by triple pipes. Note this matches how the result of the +tag is stored in the {VARS} hash. + +=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'} if (!defined($paramHash->{'variable'})); + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; + $paramHash->{'allowempty'} = $token->[2]{'allowempty'}; + $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'}; + my $evalFlag = $token->[2]{'eval'}; + push @{$paramHash->{CHOICES}}, [$human, $computer, $nextstate, + $evalFlag]; + 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, checkName) { + for (i=0; i +SCRIPT + } + + # Only print "select all" and "unselect all" if there are five or + # more choices; fewer then that and it looks silly. + if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) { + $buttons = < + + +
  +BUTTONS + } + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '
'; + } + + $result .= $buttons; + + $result .= "\n\n"; + + my %checkedChoices; + my $checkedChoicesFunc; + + if (defined($self->{DEFAULT_VALUE})) { + $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); + die 'Error in default value code for variable ' . + {'variable'} . ', Perl said:' . $@ if $@; + } else { + $checkedChoicesFunc = sub { return ''; }; + } + + # Process which choices should be checked. + if ($self->{'multichoice'}) { + for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) { + $checkedChoices{$selectedChoice} = 1; + } + } else { + # single choice + my $selectedChoice = &$checkedChoicesFunc($helper, $self); + + my $foundChoice = 0; + + # check that the choice is in the list of choices. + for my $choice (@{$self->{CHOICES}}) { + if ($choice->[1] eq $selectedChoice) { + $checkedChoices{$choice->[1]} = 1; + $foundChoice = 1; + } + } + + # If we couldn't find the choice, pick the first one + if (!$foundChoice) { + $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1; + } + } + + my $type = "radio"; + if ($self->{'multichoice'}) { $type = 'checkbox'; } + foreach my $choice (@{$self->{CHOICES}}) { + $result .= "\n\n"; + $result .= "\n"; + } + $result .= "
 [1]}) { + $result .= " checked "; + } + my $choiceLabel = $choice->[0]; + if ($choice->[4]) { # if we need to evaluate this choice + $choiceLabel = "sub { my $helper = shift; my $state = shift;" . + $choiceLabel . "}"; + $choiceLabel = eval($choiceLabel); + $choiceLabel = &$choiceLabel($helper, $self); + } + $result .= "/> " . $choiceLabel . "
\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 (!defined($chosenValue) && !$self->{'allowempty'}) { + $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. The +"toponly" attribute controls whether the resource display shows just the +resources in that sequence, or recurses into all sub-sequences, defaulting +to false. + +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}). + +=item * : If the URL of a map is given here, only that map + will be displayed, instead of the whole course. + +=back + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::resource', + ('resource', 'filterfunc', + 'choicefunc', 'valuefunc', + 'mapurl')); +} + +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'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; + $paramHash->{'toponly'} = $token->[2]{'toponly'}; + 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 ''; } + +sub start_mapurl { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $contents = Apache::lonxml::get_all_text('/mapurl', + $parser); + $paramHash->{MAP_URL} = $contents; +} + +sub end_mapurl { 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}; + + my $buttons = ''; + + if ($self->{'multichoice'}) { + $result = < + function checkall(value, checkName) { + for (i=0; i +SCRIPT + $buttons = <   + + +
  +BUTTONS + } + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '

'; + } + + $result .= $buttons; + + my $filterFunc = $self->{FILTER_FUNC}; + my $choiceFunc = $self->{CHOICE_FUNC}; + my $valueFunc = $self->{VALUE_FUNC}; + my $mapUrl = $self->{MAP_URL}; + my $multichoice = $self->{'multichoice'}; + + # 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) = @_; + + my $inputType; + if ($multichoice) { $inputType = 'checkbox'; } + else {$inputType = 'radio'; } + + if (!&$choiceFunc($resource)) { + return ' '; + } else { + my $col = ""; + return $col; + } + }; + + $ENV{'form.condition'} = !$self->{'toponly'}; + $result .= + &Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, + Apache::lonnavmaps::resource()], + 'showParts' => 0, + 'filterFunc' => $filterFunc, + 'resource_no_folder_link' => 1, + 'iterator_map' => $mapUrl } + ); + + $result .= $buttons; + + return $result; +} + +sub postprocess { + my $self = shift; + + if ($self->{'multichoice'}) { + $self->process_multiple_choices($self->{'variable'}.'.forminput', + $self->{'variable'}); + } + + if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) { + $self->{ERROR_MSG} = 'You must choose at least one resource to continue.'; + return 0; + } + + 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'}; + if (defined($token->[2]{'nextstate'})) { + $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; + } + +} + +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 = ''; + my $var = $self->{'variable'}; + + if ($self->{'multichoice'}) { + $result = < + function checkall(value, checkName) { + 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($_ . ':' . $choices->{$_}->[$section]) + . "' />" + . 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'} . '}'); + die 'Error in resource filter code for variable ' . + {'variable'} . ', Perl said:' . $@ if $@; + + my $subdir = &$subdirFunc(); + + my $filterFunc = $self->{FILTER_FUNC}; + my $buttons = ''; + my $type = 'radio'; + if ($self->{'multichoice'}) { + $type = 'checkbox'; + } + + if ($self->{'multichoice'}) { + $result = < + function checkall(value, checkName) { + for (i=0; i +SCRIPT + $buttons = <   + + +BUTTONS + + if ($helper->{VARS}->{'construction'}) { + $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; + # 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)) { + my $status; + my $color; + if ($helper->{VARS}->{'construction'}) { + ($status, $color) = @{fileState($subdir, $file)}; + } else { + $status = ''; + $color = ''; + } + + # Netscape 4 is stupid and there's nowhere to put the + # information on the input tag that the file is Published, + # Unpublished, etc. In *real* browsers we can just say + # "class='Published'" and check the className attribute of + # the input tag, but Netscape 4 is too stupid to understand + # that attribute, and un-comprehended attributes are not + # reflected into the object model. So instead, what I do + # is either have or don't have an "onclick" handler that + # does nothing, give Published files the onclick handler, and + # have the checker scripts check for that. Stupid and clumsy, + # and only gives us binary "yes/no" information (at least I + # couldn't figure out how to reach into the event handler's + # actual code to retreive a value), but it works well enough + # here. + + my $onclick = ''; + if ($status eq 'Published' && $helper->{VARS}->{'construction'}) { + $onclick = 'onclick="a=1" '; + } + $result .= '\n"; + $choices++; + } + } + + $result .= "
" . + "{'multichoice'} && $choices == 0) { + $result .= ' checked'; + } + $result .= "/>" . $file . + "$status
\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; +} + +# Determine the state of the file: Published, unpublished, modified. +# Return the color it should be in and a label as a two-element array +# reference. +# Logic lifted from lonpubdir.pm, even though I don't know that it's still +# the most right thing to do. + +sub fileState { + my $constructionSpaceDir = shift; + my $file = shift; + + my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my $subdirpart = $constructionSpaceDir; + $subdirpart =~ s/^\/home\/$ENV{'user.name'}\/public_html//; + my $resdir = $docroot . '/res/' . $ENV{'user.domain'} . '/' . $ENV{'user.name'} . + $subdirpart; + + my @constructionSpaceFileStat = stat($constructionSpaceDir . '/' . $file); + my @resourceSpaceFileStat = stat($resdir . '/' . $file); + if (!@resourceSpaceFileStat) { + return ['Unpublished', '#FFCCCC']; + } + + my $constructionSpaceFileModified = $constructionSpaceFileStat[9]; + my $resourceSpaceFileModified = $resourceSpaceFileStat[9]; + + if ($constructionSpaceFileModified > $resourceSpaceFileModified) { + return ['Modified', '#FFFFCC']; + } + return ['Published', '#CCFFCC']; +} + +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::section; + +=pod + +=head2 Element: section + +

allows the user to choose one or more sections from the current +course. + +It takes the standard attributes "variable", "multichoice", and +"nextstate", meaning what they do for most other elements. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::choices"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::section', + ('section')); +} + +sub new { + my $ref = Apache::lonhelper::choices->new(); + bless($ref); +} + +sub start_section { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{CHOICES} = []; + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; + if (defined($token->[2]{'nextstate'})) { + $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; + } + + # Populate the CHOICES element + my %choices; + + my $section = Apache::loncoursedata::CL_SECTION(); + my $classlist = Apache::loncoursedata::get_classlist(); + foreach (keys %$classlist) { + my $sectionName = $classlist->{$_}->[$section]; + if (!$sectionName) { + $choices{"No section assigned"} = ""; + } else { + $choices{$sectionName} = $sectionName; + } + } + + for my $sectionName (sort(keys(%choices))) { + + push @{$paramHash->{CHOICES}}, [$sectionName, $sectionName]; + } +} + +sub end_section { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::section->new(); +} +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', + 'eval'); +} + +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 . "}"); + die 'Error in , Perl said: '. $@ if $@; + &$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 . '}'); + die 'Error in clause of condition, Perl said: ' . $@ if $@; + if (!&$clause($helper, $paramHash)) { + # Discard all text until the /condition. + &Apache::lonxml::get_all_text('/condition', $parser); + } +} + +sub end_clause { return ''; } + +=pod + +=head2 General-purpose tag: + +The tag will be evaluated as a subroutine call passed in the +current helper object and state hash as described in above, +but is expected to return a string to be printed directly to the +screen. This is useful for dynamically generating messages. + +=cut + +# This is basically a type of message. +# Programmatically setting $paramHash->{NEXTSTATE} would work, though +# it's probably bad form. + +sub start_eval { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + my $program = Apache::lonxml::get_all_text('/eval', $parser); + $program = eval('sub { my $helper = shift; my $state = shift; ' + . $program . '}'); + die 'Error in eval code, Perl said: ' . $@ if $@; + $paramHash->{MESSAGE_TEXT} = &$program($helper, $paramHash); +} + +sub end_eval { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + Apache::lonhelper::message->new(); +} + +1; + +package Apache::lonhelper::final; + +=pod + +=head2 Element: final + + is a special element that works with helpers that use the +tag. It goes through all the states and elements, executing the +snippets and collecting the results. Finally, it takes the user out of the +helper, going to a provided page. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::final', + ('final', 'exitpage')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +sub start_final { return ''; } + +sub end_final { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + Apache::lonhelper::final->new(); + + return ''; +} + +sub start_exitpage { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{EXIT_PAGE} = &Apache::lonxml::get_all_text('/exitpage', + $parser); + + return ''; +} + +sub end_exitpage { return ''; } + +sub render { + my $self = shift; + + my @results; + + # Collect all the results + for my $stateName (keys %{$helper->{STATES}}) { + my $state = $helper->{STATES}->{$stateName}; + + for my $element (@{$state->{ELEMENTS}}) { + if (defined($element->{FINAL_CODE})) { + # Compile the code. + my $code = 'sub { my $helper = shift; ' . $element->{FINAL_CODE} . + '}'; + $code = eval($code); + die 'Error while executing final code for element with var ' . + $element->{'variable'} . ', Perl said: ' . $@ if $@; + + my $result = &$code($helper); + if ($result) { + push @results, $result; + } + } + } + } + + if (scalar(@results) == 0) { + return ''; + } + + my $result = "
    \n"; + for my $re (@results) { + $result .= '
  • ' . $re . "
    • \n"; + } + return $result . '
'; +} + +1; + +package Apache::lonhelper::parmwizfinal; + +# This is the final state for the parmwizard. It is not generally useful, +# so it is not perldoc'ed. It does its own processing. +# It is represented with , and +# should later be moved to lonparmset.pm . + +no strict; +@ISA = ('Apache::lonhelper::element'); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::parmwizfinal', + ('parmwizfinal')); +} + +use Time::localtime; + +sub new { + my $ref = Apache::lonhelper::choices->new(); + bless ($ref); +} + +sub start_parmwizfinal { return ''; } + +sub end_parmwizfinal { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::parmwizfinal->new(); +} + +# Renders a form that, when submitted, will form the input to lonparmset.pm +sub render { + my $self = shift; + my $vars = $helper->{VARS}; + + # FIXME: Unify my designators with the standard ones + my %dateTypeHash = ('open_date' => "Opening Date", + 'due_date' => "Due Date", + 'answer_date' => "Answer Date"); + my %parmTypeHash = ('open_date' => "0_opendate", + 'due_date' => "0_duedate", + 'answer_date' => "0_answerdate"); + + my $affectedResourceId = ""; + my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; + my $level = ""; + my $resourceString; + my $symb; + my $paramlevel; + + # Print the granularity, depending on the action + if ($vars->{GRANULARITY} eq 'whole_course') { + $resourceString .= '
  • for all resources in the course
    • '; + $level = 9; # general course, see lonparmset.pm perldoc + $affectedResourceId = "0.0"; + $symb = 'a'; + $paramlevel = 'general'; + } elsif ($vars->{GRANULARITY} eq 'map') { + my $navmap = Apache::lonnavmaps::navmap->new( + $ENV{"request.course.fn"}.".db", + $ENV{"request.course.fn"}."_parms.db", 0, 0); + my $res = $navmap->getById($vars->{RESOURCE_ID}); + my $title = $res->compTitle(); + $symb = $res->symb(); + $navmap->untieHashes(); + $resourceString .= "
  • for the map named $title
    • "; + $level = 8; + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'map'; + } else { + my $navmap = Apache::lonnavmaps::navmap->new( + $ENV{"request.course.fn"}.".db", + $ENV{"request.course.fn"}."_parms.db", 0, 0); + my $res = $navmap->getById($vars->{RESOURCE_ID}); + $symb = $res->symb(); + my $title = $res->compTitle(); + $navmap->untieHashes(); + $resourceString .= "
  • for the resource named $title
    • "; + $level = 7; + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'full'; + } + + my $result = "
    \n"; + $result .= '

    Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.

      '; + + # Print the type of manipulation: + $result .= '
    • Setting the ' . $dateTypeHash{$vars->{ACTION_TYPE}} + . "
      • \n"; + if ($vars->{ACTION_TYPE} eq 'due_date' || + $vars->{ACTION_TYPE} eq 'answer_date') { + # for due dates, we default to "date end" type entries + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + } elsif ($vars->{ACTION_TYPE} eq 'open_date') { + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + } + + $result .= $resourceString; + + # Print targets + if ($vars->{TARGETS} eq 'course') { + $result .= '
    • for all students in course
      • '; + } elsif ($vars->{TARGETS} eq 'section') { + my $section = $vars->{SECTION_NAME}; + $result .= "
    • for section $section
      • "; + $level -= 3; + $result .= "\n"; + } else { + # FIXME: This is probably wasteful! Store the name! + my $classlist = Apache::loncoursedata::get_classlist(); + my $username = $vars->{USER_NAME}; + # Chop off everything after the last colon (section) + $username = substr($username, 0, rindex($username, ':')); + my $name = $classlist->{$username}->[6]; + $result .= "
    • for $name
      • "; + $level -= 6; + my ($uname, $udom) = split /:/, $vars->{USER_NAME}; + $result .= "\n"; + $result .= "\n"; + } + + # Print value + $result .= "
    • to " . ctime($vars->{PARM_DATE}) . " (" . + Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}) + . ")
      • \n"; + + # print pres_marker + $result .= "\n\n"; + + # Make the table appear + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + + $result .= "

      \n"; + + return $result; +} + +sub overrideForm { + return 1; +} 1; __END__ +