--- loncom/interface/lonhelper.pm 2003/03/21 18:11:11 1.1 +++ loncom/interface/lonhelper.pm 2005/02/17 08:29:42 1.96 @@ -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.96 2005/02/17 08:29:42 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,8 +30,3374 @@ # (.helper handler # +=pod + +=head1 NAME + +lonhelper - implements helper framework + +=head1 SYNOPSIS + +lonhelper implements the helper framework for LON-CAPA, and provides + many generally useful components for that framework. + +Helpers are little programs which present the user with a sequence of + simple choices, instead of one monolithic multi-dimensional + choice. They are also referred to as "wizards", "druids", and + other potentially trademarked or semantically-loaded words. + +=head1 OVERVIEWX + +Helpers 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. + +=head1 lonhelper XML file formatX + +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". The helper tag may optionally +have a "requiredpriv" attribute, specifying the priviledge a user must have +to use the helper, or get denied access. See loncom/auth/rolesplain.tab for +useful privs. Default is full access, which is often wrong! + +=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. + +=head1 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 would-be or + blocks using the {DATA} mechanism results in hard-to-read +and -maintain code. (See course.initialization.helper for a borderline +case.) + +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. + +=head2 Localization + +The helper framework tries to handle as much localization as +possible. The text is always run through +Apache::lonlocal::normalize_string, so be sure to run the keys through +that function for maximum usefulness and robustness. + +=cut + package Apache::lonhelper; +use Apache::Constants qw(:common); +use Apache::File; +use Apache::lonxml; +use Apache::lonlocal; + +# 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 separate 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. Using the debugger, one could actually +# see the two different $helper variables, as hashes at completely +# different addresses. 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 ($ENV{'browser.mathml'}) { + &Apache::loncommon::content_type($r,'text/xml'); + } else { + &Apache::loncommon::content_type($r,'text/html'); + } + $r->send_http_header; + return OK if $r->header_only; + $r->rflush(); + + # Discard result, we just want the objects that get created by the + # xml parsing + &Apache::lonxml::xmlparse($r, 'helper', $file); + + my $allowed = $helper->allowedCheck(); + if (!$allowed) { + $ENV{'user.error.msg'} = $ENV{'request.uri'}.':'.$helper->{REQUIRED_PRIV}. + ":0:0:Permission denied to access this helper."; + return HTTP_NOT_ACCEPTABLE; + } + + $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'}, $token->[2]{'requiredpriv'}); + 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; +use Apache::lonlocal; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + + $self->{TITLE} = shift; + $self->{REQUIRED_PRIV} = 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; + + # 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})) { + if (ref($ENV{$envname})) { + $self->{VARS}->{$var} = join('|||', @{$ENV{$envname}}); + } else { + $self->{VARS}->{$var} = $ENV{$envname}; + } + } +} + +sub allowedCheck { + my $self = shift; + + if (!defined($self->{REQUIRED_PRIV})) { + return 1; + } + + return Apache::lonnet::allowed($self->{REQUIRED_PRIV}, $ENV{'request.course.id'}); +} + +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 &mt("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 $html=&Apache::lonxml::xmlbegin(); + my $stateTitle=&mt($state->title()); + my $helperTitle = &mt($self->{TITLE}); + my $bodytag = &Apache::loncommon::bodytag($helperTitle,'',''); + my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"'); + my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"'); + # FIXME: This should be parameterized, not concatenated - Jeremy + my $loncapaHelper = &mt("LON-CAPA Helper:"); + + $result .= < + $loncapaHelper: $helperTitle + + $bodytag +HEADER + if (!$state->overrideForm()) { $result.="
"; } + $result .= < +

$stateTitle

+HEADER + + $result .= "
"; + + if (!$state->overrideForm()) { + $result .= $self->_saveVars(); + } + $result .= $state->render(); + + $result .= ""; + + # Warning: Copy and pasted from below, because it's too much trouble to + # turn this into a subroutine + if (!$state->overrideForm()) { + if ($self->{STATE} ne $self->{START_STATE}) { + #$result .= '  '; + } + if ($self->{DONE}) { + my $returnPage = $self->{RETURN_PAGE}; + $result .= "" . &mt("End Helper") . ""; + } + else { + $result .= ' '; + $result .= ''; + } + } + + $result .= "
"; + + # Warning: Copy and pasted from above, because it's too much trouble to + # turn this into a subroutine + if (!$state->overrideForm()) { + if ($self->{STATE} ne $self->{START_STATE}) { + #$result .= '  '; + } + if ($self->{DONE}) { + my $returnPage = $self->{RETURN_PAGE}; + $result .= "" . &mt('End Helper') . ""; + } + else { + $result .= ' '; + $result .= ''; + } + } + + #foreach my $key (keys %{$self->{VARS}}) { + # $result .= "|$key| -> " . $self->{VARS}->{$key} . "
"; + #} + + $result .= "
"; + + $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 + +=head1 Element Base Class + +The Apache::lonhelper::element base class provides support for elements +and defines some generally useful tags for use in elements. + +=head2 finalcode tagX + +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. + +=head2 defaultvalue tagX + +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. + +=head2 validator tagX + +Some elements that accepts user input can contain a "validator" tag that, +when surrounded by "sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift " +and "}", where "$val" is the value the user entered, will form a subroutine +that when called will verify whether the given input is valid or not. If it +is valid, the routine will return a false value. If invalid, the routine +will return an error message to be displayed for the user. + +Consult the documentation for each element to see whether it supports this +tag. + +=head2 getValue methodX + +If the element stores the name of the variable in a 'variable' member, which +the provided ones all do, you can retreive the value of the variable by calling +this method. + +=cut + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::element', + ('nextstate', 'finalcode', + 'defaultvalue', 'validator')); +} + +# 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 ''; } + +# Validators may need to take language specifications +sub start_validator { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{VALIDATOR} = &Apache::lonxml::get_all_text('/validator', + $parser); + $paramHash->{VALIDATOR} = 'sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift;' . + $paramHash->{VALIDATOR} . '}'; + return ''; +} + +sub end_validator { return ''; } + +sub preprocess { + return 1; +} + +sub postprocess { + return 1; +} + +sub render { + return ''; +} + +sub overrideForm { + return 0; +} + +sub getValue { + my $self = shift; + return $helper->{VARS}->{$self->{'variable'}}; +} + +1; + +package Apache::lonhelper::message; + +=pod + +=head1 Elements + +=head2 Element: messageX + +Message elements display their contents, and +transition directly to the state in the attribute. Example: + + + This is the message the user will see, + HTML allowed. + + +This will display the HTML message and transition to the 'nextstate' 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 message text +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. + +=head3 Localization + +The contents of the message tag will be run through the +normalize_string function and that will be used as a call to &mt. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; +use Apache::lonlocal; + +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} = &mtn(&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 &mtn($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: choicesX + +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. + +=head3 SUB-TAGS + + can have the following subtags:X + +=over 4 + +=item * state_name: If given, this will cause the + choice element to transition to the given state after executing. + This will override the passed to (if any). + +=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 transistioned to if the choice is made, if +the choice is not multichoice. This will override the nextstate +passed to the parent C tag. + +=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.) + +=head3 defaultvalue support + +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; +use Apache::lonlocal; + +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 = &mt(&Apache::lonxml::get_all_text('/choice', + $parser)); + my $nextstate = $token->[2]{'nextstate'}; + my $evalFlag = $token->[2]{'eval'}; + push @{$paramHash->{CHOICES}}, [&mtn($human), $computer, $nextstate, + $evalFlag]; + return ''; +} + +sub end_choice { + return ''; +} + +{ + # used to generate unique id attributes for tags. + # internal use only. + my $id = 0; + sub new_id { return $id++; } +} + +sub render { + 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) { + my %lt=&Apache::lonlocal::texthash( + 'sa' => "Select All", + 'ua' => "Unselect All"); + $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 ' . + $self->{'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}}) { + my $id = &new_id(); + $result .= "\n\n"; + $result .= "\n"; + } + $result .= "
 [1]}) { + $result .= " checked "; + } + $result .= qq{id="$id"}; + 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 .= "/> ".qq{
\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} = + &mt("You must choose one or more choices to continue."); + return 0; + } + + if (ref($chosenValue)) { + $helper->{VARS}->{$self->{'variable'}} = join('|||', @$chosenValue); + } + + 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::dropdown; + +=pod + +=head2 Element: dropdownX + +A drop-down provides a drop-down box instead of a radio button +box. Because most people do not know how to use a multi-select +drop-down box, that option is not allowed. Otherwise, the arguments +are the same as "choices", except "allowempty" is also meaningless. + + takes an attribute "variable" to control which helper variable +the result is stored in. + +=head3 SUB-TAGS + +, which acts just as it does in the "choices" element. + +=cut + +# This really ought to be a sibling class to "choice" which is itself +# a child of some abstract class.... *shrug* + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; +use Apache::lonlocal; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::dropdown', + ('dropdown')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_dropdown { + 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->{CHOICES} = []; + return ''; +} + +sub end_dropdown { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::dropdown->new(); + return ''; +} + +sub render { + my $self = shift; + my $var = $self->{'variable'}; + my $result = ''; + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '
'; + } + + my %checkedChoices; + my $checkedChoicesFunc; + + if (defined($self->{DEFAULT_VALUE})) { + $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); + die 'Error in default value code for variable ' . + $self->{'variable'} . ', Perl said: ' . $@ if $@; + } else { + $checkedChoicesFunc = sub { return ''; }; + } + + # 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; + } + + $result .= "\n"; + + 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 (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: dateX + +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 Apache::lonlocal; # A localization nightmare + +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'}) { + # This needs parameterization for times. + my $am = &mt('a.m.'); + my $pm = &mt('p.m.'); + # 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; + eval {$chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year);}; + my $error = $@; + + # 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 leap year + my $checkDate = localtime($chosenDate); + + if ($error || $checkDate->mon != $month || $checkDate->mday != $day || + $checkDate->year + 1900 != $year) { + unless (Apache::lonlocal::current_language()== ~/^en/) { + $self->{ERROR_MSG} = &mt("Invalid date entry"); + return 0; + } + # LOCALIZATION FIXME: Needs to be parameterized + $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: resourceX + + 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"X 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. The "suppressEmptySequences" attribute reflects the +suppressEmptySequences argument to the render routine, which will cause +folders that have all of their contained resources filtered out to also +be filtered out. The 'addstatus' attribute, if true, will add the icon +and long status display columns to the display. The 'addparts' +attribute will add in a part selector beside problems that have more +than 1 part. + +=head3 SUB-TAGS + +=over 4 + +=item * X: 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 * X: 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 * X: 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 * X: If the URL of a map is given here, only that map + will be displayed, instead of the whole course. If the attribute + "evaluate" is given and is true, the contents of the mapurl will be + evaluated with "sub { my $helper = shift; my $state = shift;" and + "}", with the return value used as the mapurl. + +=back + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::resource', + ('resource', 'filterfunc', + 'choicefunc', 'valuefunc', + 'mapurl','option')); +} + +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->{'suppressEmptySequences'} = $token->[2]{'suppressEmptySequences'}; + $paramHash->{'toponly'} = $token->[2]{'toponly'}; + $paramHash->{'addstatus'} = $token->[2]{'addstatus'}; + $paramHash->{'addparts'} = $token->[2]{'addparts'}; + if ($paramHash->{'addparts'}) { + $helper->declareVar($paramHash->{'variable'}.'_part'); + } + $paramHash->{'closeallpages'} = $token->[2]{'closeallpages'}; + 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->{EVAL_MAP_URL} = $token->[2]{'evaluate'}; + $paramHash->{MAP_URL} = $contents; +} + +sub end_mapurl { return ''; } + + +sub start_option { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + if (!defined($paramHash->{OPTION_TEXTS})) { + $paramHash->{OPTION_TEXTS} = [ ]; + $paramHash->{OPTION_VARS} = [ ]; + + } + # OPTION_TEXTS is a list of the text attribute + # values used to create column headings. + # OPTION_VARS is a list of the variable names, used to create the checkbox + # inputs. + # We're ok with empty elements. as place holders + # Although the 'variable' element should really exist. + # + + my $option_texts = $paramHash->{OPTION_TEXTS}; + my $option_vars = $paramHash->{OPTION_VARS}; + push(@$option_texts, $token->[2]{'text'}); + push(@$option_vars, $token->[2]{'variable'}); + + # Need to create and declare the option variables as well to make them + # persistent. + # + my $varname = $token->[2]{'variable'}; + $helper->declareVar($varname); + + + return ''; +} + +sub end_option { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + 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 + my %lt=&Apache::lonlocal::texthash( + 'sar' => "Select All Resources", + 'uar' => "Unselect All Resources"); + + $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 $multichoice = $self->{'multichoice'}; + my $option_vars = $self->{OPTION_VARS}; + my $option_texts = $self->{OPTION_TEXTS}; + my $addparts = $self->{'addparts'}; + my $headings_done = 0; + + # Evaluate the map url as needed + my $mapUrl; + if ($self->{EVAL_MAP_URL}) { + my $mapUrlFunc = eval('sub { my $helper = shift; my $state = shift; ' . + $self->{MAP_URL} . '}'); + $mapUrl = &$mapUrlFunc($helper, $self); + } else { + $mapUrl = $self->{MAP_URL}; + } + + # 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 $result = ""; + + if(!$headings_done) { + if ($option_texts) { + foreach my $text (@$option_texts) { + $result .= "$text"; + } + } + $result .= "Select"; + $result .= ""; # Close off the extra row and start a new one. + $headings_done = 1; + } + + my $inputType; + if ($multichoice) { $inputType = 'checkbox'; } + else {$inputType = 'radio'; } + + if (!&$choiceFunc($resource)) { + $result .= ' '; + return $result; + } else { + my $col = ""; + my $resource_name = + HTML::Entities::encode(&$valueFunc($resource),"<>&\"'"); + if($option_vars) { + foreach my $option_var (@$option_vars) { + $col .= + " "; + } + } + + $col .= ""; + + return $result.$col; + } + }; + my $renderPartsFunc = sub { + my ($resource, $part, $params) = @_; + my $col= ""; + my $id=$resource->{ID}; + my $resource_name = + &HTML::Entities::encode(&$valueFunc($resource),"<>&\"'"); + if ($addparts && (scalar(@{$resource->parts}) > 1)) { + $col .= ""; + } + $col .= ""; + }; + $result.=(< + function updateRadio(form,name,value) { + var radiobutton=form[name]; + for (var i=0; i

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::string; + +=pod + +=head2 Element: stringX + +string elements provide a string entry field for the user. string elements +take the usual 'variable' and 'nextstate' parameters. string elements +also pass through 'maxlength' and 'size' attributes to the input tag. + +string honors the defaultvalue tag, if given. + +string honors the validation function, if given. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; +use Apache::lonlocal; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::string', + ('string')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_string { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'nextstate'} = $token->[2]{'nextstate'}; + $paramHash->{'maxlength'} = $token->[2]{'maxlength'}; + $paramHash->{'size'} = $token->[2]{'size'}; + + return ''; +} + +sub end_string { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::string->new(); + return ''; +} + +sub render { + my $self = shift; + my $result = ''; + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '

'; + } + + $result .= '{'size'})) { + $result .= ' size="' . $self->{'size'} . '"'; + } + if (defined($self->{'maxlength'})) { + $result .= ' maxlength="' . $self->{'maxlength'} . '"'; + } + + if (defined($self->{DEFAULT_VALUE})) { + my $valueFunc = eval($self->{DEFAULT_VALUE}); + die 'Error in default value code for variable ' . + $self->{'variable'} . ', Perl said: ' . $@ if $@; + $result .= ' value="' . &$valueFunc($helper, $self) . '"'; + } + + $result .= ' />'; + + return $result; +} + +# If a NEXTSTATE was given, switch to it +sub postprocess { + my $self = shift; + + if (defined($self->{VALIDATOR})) { + my $validator = eval($self->{VALIDATOR}); + die 'Died during evaluation of evaulation code; Perl said: ' . $@ if $@; + my $invalid = &$validator($helper, $state, $self, $self->getValue()); + if ($invalid) { + $self->{ERROR_MSG} = $invalid; + return 0; + } + } + + if (defined($self->{'nextstate'})) { + $helper->changeState($self->{'nextstate'}); + } + + return 1; +} + +1; + +package Apache::lonhelper::general; + +=pod + +=head2 General-purpose tag: X + +The contents of the exec tag are executed as Perl code, B 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 +parameter.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 + +use Apache::lonlocal; + +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: X + +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: finalX + + is a special element that works with helpers that use the +tagX. 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. + +If the parameter "restartCourse" is true, this will override the buttons and +will make a "Finish Helper" button that will re-initialize the course for them, +which is useful for the Course Initialization helper so the users never see +the old values taking effect. + +If the parameter "restartCourse" is not true a 'Finish' Button will be +presented that takes the user back to whatever was defined as + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; +use Apache::lonlocal; +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::final', + ('final', 'exitpage')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +sub start_final { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'restartCourse'} = $token->[2]{'restartCourse'}; + + 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; my $element = 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, $element); + if ($result) { + push @results, $result; + } + } + } + } + + my $result; + + if (scalar(@results) != 0) { + $result .= "
    \n"; + for my $re (@results) { + $result .= '
  • ' . $re . "
    • \n"; + } + + if (!@results) { + $result .= '
  • ' . + &mt('No changes were made to current settings.') . '
    • '; + } + + $result .= '
'; + } + + my $actionURL = $self->{EXIT_PAGE}; + my $targetURL = ''; + my $finish=&mt('Finish'); + if ($self->{'restartCourse'}) { + my $actionURL = '/adm/roles'; + $targetURL = '/adm/menu'; + if ($ENV{'course.'.$ENV{'request.course.id'}.'.url'}=~/^uploaded/) { + $targetURL = '/adm/coursedocs'; + } else { + $targetURL = '/adm/navmaps'; + } + if ($ENV{'course.'.$ENV{'request.course.id'}.'.clonedfrom'}) { + $targetURL = '/adm/parmset?overview=1'; + } + my $finish=&mt('Finish Course Initialization'); + } + my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"'); + my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"'); + $result .= "
\n" . + "
\n" . + "" . + "" . + "\n" . + "\n\n" . + "
"; + + return $result; +} + +sub overrideForm { + return 1; +} + +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; +use Apache::lonlocal; + +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", + 'tries' => 'number of tries', + 'weight' => 'problem weight' + ); + my %parmTypeHash = ('open_date' => "0_opendate", + 'due_date' => "0_duedate", + 'answer_date' => "0_answerdate", + 'tries' => '0_maxtries', + 'weight' => '0_weight' ); + + 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 .= '
  • '.&mt('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(); + my $res = $navmap->getByMapPc($vars->{RESOURCE_ID}); + my $title = $res->compTitle(); + $symb = $res->symb(); + $resourceString .= '
  • '.&mt('for the map named [_1]',"$title").'
    • '; + $level = 8; + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'map'; + } else { + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getById($vars->{RESOURCE_ID}); + my $part = $vars->{RESOURCE_ID_part}; + if ($part ne 'All Parts' && $part) { $parm_name=~s/^0/$part/; } else { $part=&mt('All Parts'); } + $symb = $res->symb(); + my $title = $res->compTitle(); + $resourceString .= '
  • '.&mt('for the resource named [_1] part [_2]',"$title","$part").'
    • '; + $level = 7; + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'full'; + } + + my $result = "
    \n"; + if ($vars->{GRANULARITY} eq 'resource') { + $result .= "&\"") . "' />\n"; + $result .= "&\"") . "' />\n"; + my $part = $vars->{RESOURCE_ID_part}; + if ($part eq 'All Parts' || !$part) { $part=0; } + $result .= "&\"") . "' />\n"; + } + $result .= '

    '.&mt('Confirm that this information is correct, then click "Finish Helper" to complete setting the parameter.').'

      '; + + # Print the type of manipulation: + my $extra; + if ($vars->{ACTION_TYPE} eq 'tries') { + $extra = $vars->{TRIES}; + } + if ($vars->{ACTION_TYPE} eq 'weight') { + $extra = $vars->{WEIGHT}; + } + $result .= "
    • "; + my $what = &mt($dateTypeHash{$vars->{ACTION_TYPE}}); + if ($extra) { + $result .= &mt('Setting the [_1] to [_2]',"$what",$extra); + } else { + $result .= &mt('Setting the [_1]',"$what"); + } + $result .= "
      • \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"; + } elsif ($vars->{ACTION_TYPE} eq 'tries') { + $result .= "\n"; + } elsif ($vars->{ACTION_TYPE} eq 'weight') { + $result .= "\n"; + } + + $result .= $resourceString; + + # Print targets + if ($vars->{TARGETS} eq 'course') { + $result .= '
    • '.&mt('for all students in course').'
      • '; + } elsif ($vars->{TARGETS} eq 'section') { + my $section = $vars->{SECTION_NAME}; + $result .= '
    • '.&mt('for section [_1]',"$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 .= '
    • '.&mt('for [_1]',"$name").'
      • '; + $level -= 6; + my ($uname, $udom) = split /:/, $vars->{USER_NAME}; + $result .= "&\"") . "' />\n"; + $result .= "&\"") . "' />\n"; + } + + # Print value + if ($vars->{ACTION_TYPE} ne 'tries' && $vars->{ACTION_TYPE} ne 'weight') { + $result .= '
    • '.&mt('to [_1] ([_2])',"".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__ +