--- loncom/interface/lonhelper.pm 2003/03/21 18:11:11 1.1 +++ loncom/interface/lonhelper.pm 2018/09/03 20:25:53 1.197.2.2 @@ -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.197.2.2 2018/09/03 20:25:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,13 +25,3999 @@ # # http://www.lon-capa.org/ # -# (Page Handler -# -# (.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 privilege a user must have +to use the helper, or get denied access. See loncom/auth/rolesplain.tab for +useful privs. You may add the modifier &S at the end of the three letter priv +if you want to grant access to users for whom the corresponding privilege is +section-specific. The 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. + +State tags may also optionally have an attribute "help" which should be +the filename of a help file, this will add a blue ? to the title. + +=head2 Example Helper Skeleton + +An example of the tags so far: + + + + + + + + + +Of course this does nothing. In order for the helper to do something, it is +necessary to put actual elements into the helper. Documentation for each +of these elements follows. + +=head1 Creating a Helper With Code, Not XML + +In some situations, such as the printing helper (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; +use Apache::lonnet; +use Apache::longroup; +use Apache::lonselstudent; + + +use LONCAPA; + +# 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 = $r->dir_config('lonDocRoot').$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) { + my ($priv,$modifier) = split(/\&/,$helper->{REQUIRED_PRIV}); + $env{'user.error.msg'} = $env{'request.uri'}.':'.$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'}, + $token->[2]{'help'}); + 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; +use Apache::lonnet; +use LONCAPA; + +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, &escape($key) . '=' . &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; + } + my ($priv,$modifier) = split(/\&/,$self->{REQUIRED_PRIV}); + my $allowed = &Apache::lonnet::allowed($priv,$env{'request.course.id'}); + if ((!$allowed) && ($modifier eq 'S') && ($env{'request.course.sec'} ne '')) { + $allowed = &Apache::lonnet::allowed($priv,$env{'request.course.id'}.'/'. + $env{'request.course.sec'}); + } + return $allowed; +} + +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 $footer = 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=&mt($state->title()); + my $stateHelp= $state->help(); + my $browser_searcher_js = + ''; + + # Breadcrumbs + my $brcrum = [{'href' => '', + 'text' => 'Helper'}]; + # FIXME: Dynamically add context sensitive breadcrumbs + # depending on the caller, + # e.g. printing, parametrization, etc. + # FIXME: Add breadcrumbs to reflect current helper state + + $result .= &Apache::loncommon::start_page($self->{TITLE}, + $browser_searcher_js, + {'bread_crumbs' => $brcrum,}); + + my $previous = HTML::Entities::encode(&mt("Back"), '<>&"'); + my $next = HTML::Entities::encode(&mt("Next"), '<>&"'); + # FIXME: This should be parameterized, not concatenated - Jeremy + + + if (!$state->overrideForm()) { $result.='
'; } + if ($stateHelp) { + $stateHelp = &Apache::loncommon::help_open_topic($stateHelp); + } + + # Prepare buttons + my $buttons; + if (!$state->overrideForm()) { + if ($self->{STATE} ne $self->{START_STATE}) { + #$result .= '  '; + } + $buttons = '

'; # '

'; + if ($self->{DONE}) { + my $returnPage = $self->{RETURN_PAGE}; + $buttons .= ''.&mt('End Helper').''; + } + else { + $buttons .= '' + .' ' + .'' + .''; + } + $buttons .= '

'; # '
'; + } + + + + $result .= '

'.$stateTitle.$stateHelp.'

'; + +# $result .= '
'; + + # Top buttons + $result .= $buttons; + + # Main content of current helper screen + if (!$state->overrideForm()) { + $result .= $self->_saveVars(); + } + $result .= $state->render(); + + # Bottom buttons + $result .= $buttons; + + + #foreach my $key (keys(%{$self->{VARS}})) { + # $result .= "|$key| -> " . $self->{VARS}->{$key} . "
"; + #} + +# $result .= '
'; + + $result .= < +FOOTER + + $result .= $footer.&Apache::loncommon::end_page(); + # 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->{HELP} = 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 help { + my $self = shift; + return $self->{HELP}; +} + +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 helper, 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'}; + } + if (defined($token->[2]{'type'})) { + $paramHash->{TYPE} = $token->[2]{'type'}; + } + 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; + + if ($self->{TYPE} =~ /^\s*warning\s*$/i) { + $self->{MESSAGE_TEXT} = + ''. $self->{MESSAGE_TEXT}.''; + } + if ($self->{TYPE} =~ /^\s*error\s*$/i) { + $self->{MESSAGE_TEXT} = + ''. $self->{MESSAGE_TEXT}.''; + } + 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::helpicon; + +=pod + +=head1 Elements + +=head2 Element: helpiconX + +Helpicon elements add a help icon at the current location. +Example: + + + General Help + + +In this example will generate a help icon to the Help.hlp url with a +description of 'General Help'. The description is not required and if +left out (Example: only the icon will be +added.) + +=head3 Localization + +The description text 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::helpicon', + ('helpicon')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_helpicon { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{HELP_TEXT} = &mtn(&Apache::lonxml::get_all_text('/helpicon', + $parser)); + + $paramHash->{HELP_TEXT} =~s/^\s+//; + $paramHash->{HELP_TEXT} =~s/\s+$//; + + if (defined($token->[2]{'file'})) { + $paramHash->{HELP_FILE} = $token->[2]{'file'}; + } + return ''; +} + +sub end_helpicon { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::helpicon->new(); + return ''; +} + +sub render { + my $self = shift; + + my $text; + if ( $self->{HELP_TEXT} ne '') { + $text=&mtn($self->{HELP_TEXT}); + } + + return &Apache::loncommon::help_open_topic($self->{HELP_FILE}, + $text); +} +sub postprocess { + my $self = shift; + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::skip; + +=pod + +=head1 Elements + +=head2 Element: skipX + +The tag allows you define conditions under which the current state +should be skipped over and define what state to skip to. + + + + + #some code that decides whether to skip the state or not + + FINISH + + A possibly skipped state + + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::skip', + ('skip')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +sub start_skip { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + # let know what text to skip to + $paramHash->{SKIPTAG}='/skip'; + return ''; +} + +sub end_skip { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::skip->new(); + return ''; +} + +sub render { + my $self = shift; + return ''; +} +# If a NEXTSTATE is set, switch to it +sub preprocess { + my ($self) = @_; + + 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. + + may optionally contain a 'relatedvalue' attribute, which +if present will cause a text entry to appear to the right of the +selection. The value of the relatedvalue attribute is a variable +into which the text entry will be stored e.g.: + + +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; +use Apache::lonnet; + +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'}; + my $relatedVar = $token->[2]{'relatedvalue'}; + my $relatedDefault = $token->[2]{'relateddefault'}; + push @{$paramHash->{CHOICES}}, [&mtn($human), $computer, $nextstate, + $evalFlag, $relatedVar, $relatedDefault]; + 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 .= < +// + +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 .= ""; + if ($choice->[4]) { + $result .=''; + } + $result .= "\n"; + } + $result .= "
 [1]}) { + $result .= " checked='checked'"; + } + $result .= qq{ id="id$id"}; + my $choiceLabel = $choice->[0]; + if ($choice->[3]) { # 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]); + } + } + if ($choice->[4]) { + my $varname = $choice->[4]; + $helper->{'VARS'}->{$varname} = $env{'form.'."${varname}_forminput"}; + } + } + 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; +use Apache::lonnet; + +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 Apache::lonnet; +use DateTime; + +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'}; + $paramHash->{'anytime'} = $token->[2]{'anytime'}; +} + +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; + + my $time=time; + my ($anytime,$onclick); + + # first check VARS for a valid new value from the user + # then check DEFAULT_VALUE for a valid default time value + # otherwise pick now as reasonably good time + + if (defined($helper->{VARS}{$var}) + && $helper->{VARS}{$var} > 0) { + $date = &get_date_object($helper->{VARS}{$var}); + } elsif (defined($self->{DEFAULT_VALUE})) { + my $valueFunc = eval($self->{DEFAULT_VALUE}); + die('Error in default value code for variable ' . + $self->{'variable'} . ', Perl said: ' . $@) if $@; + $time = &$valueFunc($helper, $self); + if (lc($time) eq 'anytime') { + $anytime=1; + $date = &get_date_object(time); + $date->set_minute(0); + } elsif (defined($time) && $time ne 0) { + $date = &get_date_object($time); + } else { + # leave date undefined so it'll default to now + } + } + + if (!defined($date)) { + $date = &get_date_object(time); + $date->set_minute(0); + } + + if ($anytime) { + $onclick = "onclick=\"javascript:updateCheck(this.form,'${var}anytime',false)\""; + } + # Default date: The current hour. + + 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"; + } + $result .= ' '.$date->time_zone_short_name().' '; + if ($self->{'anytime'}) { + $result.=(< +// + +CHECK + $result.=" or 

'.$titles{'active'}.'

'; + $result .= &Apache::lonselstudent::render_student_list( $current_members, + "helpform", + "current", + \%defaultUsers, + $self->{'multichoice'}, + $self->{'variable'}, + 1); + + # If activeonly is not set then we can also give the expired students: + # + if (!$self->{'activeonly'} && ((scalar(@$future_members)) > 0)) { + + # And future. + + $result .= '

'.$titles{'future'}.'

'; + + $result .= &Apache::lonselstudent::render_student_list( $future_members, + "helpform", + "future", + \%defaultUsers, + $self->{'multichoice'}, + $self->{'variable'}, + 0); + } + if (!$self->{'activeonly'} && ((scalar(@$expired_members)) > 0)) { + # Past + + $result .= '

'.$titles{'expired'}.'

'; + $result .= &Apache::lonselstudent::render_student_list($expired_members, + "helpform", + "past", + \%defaultUsers, + $self->{'multichoice'}, + $self->{'variable'}, + 0); + } + + + + return $result; +} + +sub postprocess { + my $self = shift; + + my $result = $env{'form.' . $self->{'variable'} . '_forminput'}; + if (!$result && !$self->{'emptyallowed'}) { + if ($self->{'coursepersonnel'}) { + $self->{ERROR_MSG} = + &mt('You must choose at least one user to continue.'); + } else { + $self->{ERROR_MSG} = + &mt('You must choose at least one student to continue.'); + } + return 0; + } + + if (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::files; + +=pod + +=head2 Element: filesX + +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: + +=over 4 + +=item * B: works as it does with the other tags. + +=item * B: When the contents of this tag are surrounded by + "sub {" and "}", will return a string representing what directory + on the server to allow the user to choose files from. + +=item * B: 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. By default, a filter function will be used that will + mask out old versions of files. This function is available as + Apache::lonhelper::files::not_old_version if you want to use it to + composite your own filters. + +=back + +B: You should ensure the user can not somehow +pass something into your code that would allow them to look places +they should not be able to see, like the C directory. However, +the security impact would be minimal, since it would only expose +the existence of files, there should be no way to parlay that into +viewing the files. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; +use Apache::lonlocal; +use Apache::lonnet; +use Apache::lonpubdir; # for getTitleString + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::files', + ('files', 'filechoice', 'filefilter')); +} + +sub not_old_version { + my $file = shift; + + # Given a file name, return false if it is an "old version" of a + # file, or true if it is not. + + if ($file =~ /^.*\.[0-9]+\.[A-Za-z]+(\.meta)?$/) { + return 0; + } + return 1; +} + +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 ''; } + +{ + # 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 $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}; + if (!defined($filterFunc)) { + $filterFunc = ¬_old_version; + } + my $buttons = ''; + my $type = 'radio'; + if ($self->{'multichoice'}) { + $type = 'checkbox'; + } + + if ($self->{'multichoice'}) { + $result = < +// + +SCRIPT + my %lt=&Apache::lonlocal::texthash( + 'saf' => "Select All Files", + 'uaf' => "Unselect All Files"); + $buttons = <   + + +BUTTONS + + %lt=&Apache::lonlocal::texthash( + 'sap' => "Select All Published", + 'uap' => "Unselect All Published"); + if ($helper->{VARS}->{'construction'}) { + $buttons .= < + +
  +BUTTONS + } + } + + # Get the list of files in this directory. + my (@fileList,$listref,$listerror); + + # If the subdirectory is in local CSTR space + my $metadir; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + if ($subdir =~ m{^(?:\Q$londocroot\E)*/priv/[^/]+/[^/]+/(.*)$}) { + my $innerpath=$1; + unless ($subdir=~m{^\Q$londocroot\E}) { + $subdir=$londocroot.$subdir; + } + my ($user,$domain)= + &Apache::lonnet::constructaccess($subdir); + $metadir='/res/'.$domain.'/'.$user.'/'.$innerpath; + ($listref,$listerror) = + &Apache::lonnet::dirlist($subdir,$domain,$user,undef,undef,'/'); + } else { + # local library server resource space + ($listref,$listerror) = + &Apache::lonnet::dirlist($subdir,$env{'user.domain'},$env{'user.name'},undef,undef,'/'); + } + + # Sort the fileList into order + if (ref($listref) eq 'ARRAY') { + @fileList = sort {lc($a) cmp lc($b)} @{$listref}; + } + + $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 = ''; + } + + # Get the title + my $title = Apache::lonpubdir::getTitleString(($metadir?$metadir:$subdir) .'/'. $file); + + # 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" '; + } + my $id = &new_id(); + $result .= '" . + "" . + "" . "\n"; + $choices++; + } + } + + $result .= "
" . + "{'multichoice'} && $choices == 0) { + $result .= ' checked="checked"'; + } + $result .= "/>". + qq{$title$status
\n"; + + if (!$choices) { + $result .= 'There are no files available to select in this directory ('.$subdir.'). 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 ($uname,$udom)=($env{'user.name'},$env{'user.domain'}); + if ($env{'request.role'}=~/^ca\./) { + (undef,$udom,$uname)=split(/\//,$env{'request.role'}); + } + my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my $subdirpart = $constructionSpaceDir; + $subdirpart =~ s{^\Q$docroot/priv/$udom/$uname\E}{}; + my $resdir = $docroot . '/res/' . $udom . '/' . $uname . + $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 (defined($self->{NEXTSTATE})) { + $helper->changeState($self->{NEXTSTATE}); + } + + return 1; +} + +1; + +package Apache::lonhelper::section; + +=pod + +=head2 Element: sectionX + +
allows the user to choose one or more sections from the current +course. + +It takes the standard attributes "variable", "multichoice", +"allowempty" and "nextstate", meaning what they do for most other +elements. + +also takes a boolean 'onlysections' which will restrict this to only +have sections and not include groups + +=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'}; + $paramHash->{'allowempty'} = $token->[2]{'allowempty'}; + if (defined($token->[2]{'nextstate'})) { + $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; + } + + # Populate the CHOICES element + my %choices; + my $usersec = $Apache::lonnet::env{'request.course.sec'}; + + if ($usersec ne '') { + $choices{$usersec} = $usersec; + } else { + my $section = Apache::loncoursedata::CL_SECTION(); + my $classlist = Apache::loncoursedata::get_classlist(); + foreach my $user (keys(%$classlist)) { + my $section_name = $classlist->{$user}[$section]; + if (!$section_name) { + $choices{"No section assigned"} = ""; + } else { + $choices{$section_name} = $section_name; + } + } + + if (exists($choices{"No section assigned"})) { + push(@{$paramHash->{CHOICES}}, + ['No section assigned','No section assigned']); + delete($choices{"No section assigned"}); + } + } + for my $section_name (sort {lc($a) cmp lc($b) } (keys(%choices))) { + push @{$paramHash->{CHOICES}}, [$section_name, $section_name]; + } + return if ($token->[2]{'onlysections'}); + + # add in groups to the end of the list + my %curr_groups = &Apache::longroup::coursegroups(); + foreach my $group_name (sort(keys(%curr_groups))) { + push(@{$paramHash->{CHOICES}}, [$group_name, $group_name]); + } +} + +sub end_section { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::section->new(); +} +1; + +package Apache::lonhelper::group; + +=pod + +=head2 Element: groupX + + allows the user to choose one or more groups from the current course. + +It takes the standard attributes "variable", "multichoice", + "allowempty" and "nextstate", meaning what they do for most other + elements. + +also takes a boolean grouponly, which if true, will restrict choice to +groups in which user is a member, unless user has the mdg priv in the course, +in which case all groups will be possible choices. Defaults to false. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::choices"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::group', + ('group')); +} + +sub new { + my $ref = Apache::lonhelper::choices->new(); + bless($ref); +} + +sub start_group { + 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'}; + $paramHash->{'allowempty'} = $token->[2]{'allowempty'}; + $paramHash->{'grouponly'} = $token->[2]{'grouponly'}; + if (defined($token->[2]{'nextstate'})) { + $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; + } + + # Populate the CHOICES element + my %choices; + + my %curr_groups; + if ((!$paramHash->{'grouponly'}) || (&Apache::lonnet::allowed('mdg',$Apache::lonnet::env{'request.course.id'}))) { + %curr_groups = &Apache::longroup::coursegroups(); + } elsif ($Apache::lonnet::env{'request.course.groups'} ne '') { + map { $curr_groups{$_} = 1; } split(/:/,$Apache::lonnet::env{'request.course.groups'}); + } + foreach my $group_name (sort {lc($a) cmp lc($b)} (keys(%curr_groups))) { + push(@{$paramHash->{CHOICES}}, [$group_name, $group_name]); + } +} + +sub end_group { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::group->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. +Since you could have multiple strings in a helper state, each with its own +validator, all but the last string should have +noproceed='1' so that _all_ validators are evaluated before the next +state can be reached. + +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(); + $ref->{'PROCEED'} = 1; # By default postprocess goes to next state. + 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 ''; + } + my $state = Apache::lonhelper::string->new(); + + + if(&Apache::lonxml::get_param('noproceed', $parstack, $safeeval, undef, 1)) { + $state->noproceed(); + } + + + + return ''; +} + +sub noproceed() { + my $self = shift; + $self->{PROCEED} = 0; +} + +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 validator code; Perl said: ' . $@ if $@; + my $invalid = &$validator($helper, $state, $self, $self->getValue()); + if ($invalid) { + $self->{ERROR_MSG} = $invalid; + return 0; + } + } + + if (defined($self->{'nextstate'}) && $self->{PROCEED}) { + $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; +use Apache::lonnet; + +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. + my $end_tag = $paramHash->{SKIPTAG} || '/condition'; + &Apache::lonxml::get_all_text($end_tag, $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 Save button (Finish Helper) 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; +use Apache::lonnet; +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('Save'); + if ($self->{'restartCourse'}) { + $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 $previous = HTML::Entities::encode(&mt("Back"), '<>&"'); + my $next = HTML::Entities::encode(&mt("Next"), '<>&"'); + $result .= "

\n" . + "\n" . + "" . + "" . + "\n" . + "\n\n" . + "

\n"; + + return $result; +} + +sub overrideForm { + return 1; +} + +1; + +package Apache::lonhelper::parmwizfinal; + +# This is the final state for the parm helper. 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; +use Apache::lonnet; + +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 %realParmName = ('open_date' => "opendate", + 'due_date' => "duedate", + 'answer_date' => "answerdate", + 'tries' => 'maxtries', + 'weight' => '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 [_1]all resources in the course[_2]','','').'
    • '; + if ($vars->{TARGETS} eq 'course') { + $level = 14; # general course, see lonparmset.pm perldoc + } elsif ($vars->{TARGETS} eq 'section') { + $level = 9; + } elsif ($vars->{TARGETS} eq 'group') { + $level = 6; + } else { + $level = 3; + } + $affectedResourceId = "0.0"; + $symb = 'a'; + $paramlevel = 'general'; + } elsif ($vars->{GRANULARITY} eq 'map') { + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + my $res = $navmap->getByMapPc($vars->{RESOURCE_ID}); + my $title = $res->compTitle(); + $symb = $res->symb(); + $resourceString .= '
  • '.&mt('for the map named [_1]',"$title").'
    • '; + } else { + $resourceString .= '
  • '.&mt('for the map ID [_1] (name unavailable)',''.$vars->{RESOURCE_ID}.'').'
    • '; + &Apache::lonnet::logthis('Retrieval of map title failed in lonhelper.pm - could not create navmap object for course.'); + + } + if ($vars->{TARGETS} eq 'course') { + $level = 13; # general course, see lonparmset.pm perldoc + } elsif ($vars->{TARGETS} eq 'section') { + $level = 8; + } elsif ($vars->{TARGETS} eq 'group') { + $level = 5; + } else { + $level = 2; + } + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'map'; + } else { + my $part = $vars->{RESOURCE_ID_part}; + if ($part ne 'All Parts' && $part) { $parm_name=~s/^0/$part/; } else { $part=&mt('All Parts'); } + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + my $res = $navmap->getById($vars->{RESOURCE_ID}); + $symb = $res->symb(); + my $title = $res->compTitle(); + $resourceString .= '
  • '.&mt('for the resource named [_1], part [_2]',"$title","$part").'
    • '; + } else { + $resourceString .= '
  • '.&mt('for the resource ID [_1] (name unavailable), part [_2]',''.$vars->{RESOURCE_ID}.'',"$part").'
    • '; + &Apache::lonnet::logthis('Retrieval of resource title failed in lonhelper.pm - could not create navmap object for course.'); + } + if ($vars->{TARGETS} eq 'course') { + $level = 10; # general course, see lonparmset.pm perldoc + } elsif ($vars->{TARGETS} eq 'section') { + $level = 7; + } elsif ($vars->{TARGETS} eq 'group') { + $level = 4; + } else { + $level = 1; + } + $affectedResourceId = $vars->{RESOURCE_ID}; + $paramlevel = 'full'; + } + + my $result = "
    \n"; + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + if ($vars->{GRANULARITY} eq 'resource') { + $result .= "&\"") . "' />\n"; + } elsif ($vars->{GRANULARITY} eq 'map') { + $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 "Save" 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"; + $result .= "\n"; + } elsif ($vars->{ACTION_TYPE} eq 'weight') { + $result .= "\n"; + } + + $result .= $resourceString; + + # Print targets + if ($vars->{TARGETS} eq 'course') { + $result .= '
    • '.&mt('for [_1]all students in course[_2]','','').'
      • '; + } elsif ($vars->{TARGETS} eq 'section') { + my $section = $vars->{SECTION_NAME}; + $result .= '
    • '.&mt('for section [_1]',"$section").'
      • '; + $result .= "&\"") . "' />\n"; + } elsif ($vars->{TARGETS} eq 'group') { + my $group = $vars->{GROUP_NAME}; + $result .= '
    • '.&mt('for group [_1]',"$group").'
      • '; + $result .= "&\"") . "' />\n"; + } else { + # FIXME: This is probably wasteful! Store the name! + my $classlist = Apache::loncoursedata::get_classlist(); + my ($uname,$udom)=split(':',$vars->{USER_NAME}); + my $name = $classlist->{$uname.':'.$udom}->[6]; + $result .= '
    • '.&mt('for [_1]',"$name").'
      • '; + $result .= "&\"") . "' />\n"; + $result .= "&\"") . "' />\n"; + } + + # Print value + if ($vars->{ACTION_TYPE} ne 'tries' && $vars->{ACTION_TYPE} ne 'weight') { + my $showdate = &Apache::lonlocal::locallocaltime($vars->{PARM_DATE}); + $result .= '
    • '.&mt('to [_1] ([_2])',"".$showdate."",Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}))."
      • \n"; + } + + $result .= '
    '; + +# FIXME: Make previous button working +# Found to be dysfunctional when used to change the selected student +# my $previous = HTML::Entities::encode(&mt("Back"), '<>&"'); + my $buttons .= '

    ' +# .'' + .' ' # Finish Helper + .'

    '."\n"; + + # print pres_marker + $result .= "\n\n"; + + # Make the table appear + $result .= "\n"; + $result .= "\n"; + $result .= "\n"; + + $result .= $buttons; + + return $result; +} + +sub overrideForm { + return 1; +} 1; __END__ +