version 1.13, 2003/04/30 15:18:36
|
version 1.29, 2003/05/14 20:16:56
|
Line 149 of the information used is persistent be
|
Line 149 of the information used is persistent be
|
and -maintain code. |
and -maintain code. |
|
|
It is possible to do some of the work with an XML fragment parsed by |
It is possible to do some of the work with an XML fragment parsed by |
lonxml; again, see lonprintout.pm for an example. |
lonxml; again, see lonprintout.pm for an example. In that case it is |
|
imperative that you call B<Apache::lonhelper::registerHelperTags()> |
|
before parsing XML fragments and B<Apache::lonhelper::unregisterHelperTags()> |
|
when you are done. See lonprintout.pm for examples of this usage in the |
|
printHelper subroutine. |
|
|
=cut |
=cut |
|
|
Line 189 my $substate;
|
Line 193 my $substate;
|
# end of the element tag is located. |
# end of the element tag is located. |
my $paramHash; |
my $paramHash; |
|
|
|
# Note from Jeremy 5-8-2003: It is *vital* that the real handler be called |
|
# as a subroutine from the handler, or very mysterious things might happen. |
|
# I don't know exactly why, but it seems that the scope where the Apache |
|
# server enters the perl handler is treated differently from the rest of |
|
# the handler. This also seems to manifest itself in the debugger as entering |
|
# the perl handler in seemingly random places (sometimes it starts in the |
|
# compiling phase, sometimes in the handler execution phase where it runs |
|
# the code and stepping into the "1;" the module ends with goes into the handler, |
|
# sometimes starting directly with the handler); I think the cause is related. |
|
# In the debugger, this means that breakpoints are ignored until you step into |
|
# a function and get out of what must be a "faked up scope" in the Apache-> |
|
# mod_perl connection. In this code, it was manifesting itself in the existence |
|
# of two seperate file-scoped $helper variables, one set to the value of the |
|
# helper in the helper constructor, and one referenced by the handler on the |
|
# "$helper->process()" line. The second was therefore never set, and was still |
|
# undefined when I tried to call process on it. |
|
# By pushing the "real handler" down into the "real scope", everybody except the |
|
# actual handler function directly below this comment gets the same $helper and |
|
# everybody is happy. |
|
# The upshot of all of this is that for safety when a handler is using |
|
# file-scoped variables in LON-CAPA, the handler should be pushed down one |
|
# call level, as I do here, to ensure that the top-level handler function does |
|
# not get a different file scope from the rest of the code. |
|
sub handler { |
|
my $r = shift; |
|
return real_handler($r); |
|
} |
|
|
# For debugging purposes, one can send a second parameter into this |
# For debugging purposes, one can send a second parameter into this |
# function, the 'uri' of the helper you wish to have rendered, and |
# function, the 'uri' of the helper you wish to have rendered, and |
# call this from other handlers. |
# call this from other handlers. |
sub handler { |
sub real_handler { |
my $r = shift; |
my $r = shift; |
my $uri = shift; |
my $uri = shift; |
if (!defined($uri)) { $uri = $r->uri(); } |
if (!defined($uri)) { $uri = $r->uri(); } |
Line 202 sub handler {
|
Line 234 sub handler {
|
my $file; |
my $file; |
read $fh, $file, 100000000; |
read $fh, $file, 100000000; |
|
|
Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); |
|
|
|
# Send header, don't cache this page |
# Send header, don't cache this page |
if ($r->header_only) { |
if ($r->header_only) { |
Line 428 sub declareVar {
|
Line 459 sub declareVar {
|
|
|
my $envname = 'form.' . $var . '.forminput'; |
my $envname = 'form.' . $var . '.forminput'; |
if (defined($ENV{$envname})) { |
if (defined($ENV{$envname})) { |
$self->{VARS}->{$var} = $ENV{$envname}; |
if (ref($ENV{$envname})) { |
|
$self->{VARS}->{$var} = join('|||', @{$ENV{$envname}}); |
|
} else { |
|
$self->{VARS}->{$var} = $ENV{$envname}; |
|
} |
} |
} |
} |
} |
|
|
Line 462 sub process {
|
Line 497 sub process {
|
|
|
# Phase 2: Preprocess current state |
# Phase 2: Preprocess current state |
my $startState = $self->{STATE}; |
my $startState = $self->{STATE}; |
my $state = $self->{STATES}{$startState}; |
my $state = $self->{STATES}->{$startState}; |
|
|
# For debugging, print something here to determine if you're going |
# For debugging, print something here to determine if you're going |
# to an undefined state. |
# to an undefined state. |
Line 473 sub process {
|
Line 508 sub process {
|
|
|
# Phase 3: While the current state is different from the previous state, |
# Phase 3: While the current state is different from the previous state, |
# keep processing. |
# keep processing. |
while ( $startState ne $self->{STATE} ) |
while ( $startState ne $self->{STATE} && |
|
defined($self->{STATES}->{$self->{STATE}}) ) |
{ |
{ |
$startState = $self->{STATE}; |
$startState = $self->{STATE}; |
$state = $self->{STATES}{$startState}; |
$state = $self->{STATES}->{$startState}; |
$state->preprocess(); |
$state->preprocess(); |
} |
} |
|
|
Line 495 sub display {
|
Line 531 sub display {
|
|
|
my $result = ""; |
my $result = ""; |
|
|
|
if (!defined($state)) { |
|
$result = "<font color='#ff0000'>Error: state '$state' not defined!</font>"; |
|
return $result; |
|
} |
|
|
# Phase 4: Display. |
# Phase 4: Display. |
my $stateTitle = $state->title(); |
my $stateTitle = $state->title(); |
my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'',''); |
my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'',''); |
Line 506 sub display {
|
Line 547 sub display {
|
</head> |
</head> |
$bodytag |
$bodytag |
HEADER |
HEADER |
if (!$state->overrideForm()) { $result.="<form name='wizform' method='GET'>"; } |
if (!$state->overrideForm()) { $result.="<form name='helpform' method='POST'>"; } |
$result .= <<HEADER; |
$result .= <<HEADER; |
<table border="0"><tr><td> |
<table border="0"><tr><td> |
<h2><i>$stateTitle</i></h2> |
<h2><i>$stateTitle</i></h2> |
Line 643 sub addElement {
|
Line 684 sub addElement {
|
push @{$self->{ELEMENTS}}, $element; |
push @{$self->{ELEMENTS}}, $element; |
} |
} |
|
|
|
use Data::Dumper; |
sub render { |
sub render { |
my $self = shift; |
my $self = shift; |
my @results = (); |
my @results = (); |
Line 650 sub render {
|
Line 692 sub render {
|
for my $element (@{$self->{ELEMENTS}}) { |
for my $element (@{$self->{ELEMENTS}}) { |
push @results, $element->render(); |
push @results, $element->render(); |
} |
} |
|
|
return join("\n", @results); |
return join("\n", @results); |
} |
} |
|
|
Line 662 package Apache::lonhelper::element;
|
Line 705 package Apache::lonhelper::element;
|
|
|
=head2 Element Base Class |
=head2 Element Base Class |
|
|
The Apache::lonhelper::element base class provides support methods for |
The Apache::lonhelper::element base class provides support for elements |
the elements to use, such as a multiple value processer. |
and defines some generally useful tags for use in elements. |
|
|
B<Methods>: |
B<finalcode tag> |
|
|
=over 4 |
Each element can contain a "finalcode" tag that, when the special FINAL |
|
helper state is used, will be executed, surrounded by "sub { my $helper = shift;" |
|
and "}". It is expected to return a string describing what it did, which |
|
may be an empty string. See course initialization helper for an example. This is |
|
generally intended for helpers like the course initialization helper, which consist |
|
of several panels, each of which is performing some sort of bite-sized functionality. |
|
|
|
B<defaultvalue tag> |
|
|
|
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 <choices> 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. |
|
|
=item * process_multiple_choices(formName, varName): Process the form |
Again, see the course initialization helper for examples. |
element named "formName" and place the selected items into the helper |
|
variable named varName. This is for things like checkboxes or |
|
multiple-selection listboxes where the user can select more then |
|
one entry. The selected entries are delimited by triple pipes in |
|
the helper variables, like this: |
|
|
|
CHOICE_1|||CHOICE_2|||CHOICE_3 |
|
|
|
=back |
|
|
|
=cut |
=cut |
|
|
BEGIN { |
BEGIN { |
&Apache::lonhelper::register('Apache::lonhelper::element', |
&Apache::lonhelper::register('Apache::lonhelper::element', |
('nextstate')); |
('nextstate', 'finalcode', |
|
'defaultvalue')); |
} |
} |
|
|
# Because we use the param hash, this is often a sufficent |
# Because we use the param hash, this is often a sufficent |
Line 719 sub start_nextstate {
|
Line 774 sub start_nextstate {
|
|
|
sub end_nextstate { return ''; } |
sub end_nextstate { return ''; } |
|
|
|
sub start_finalcode { |
|
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
|
|
|
if ($target ne 'helper') { |
|
return ''; |
|
} |
|
|
|
$paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode', |
|
$parser); |
|
return ''; |
|
} |
|
|
|
sub end_finalcode { return ''; } |
|
|
|
sub start_defaultvalue { |
|
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
|
|
|
if ($target ne 'helper') { |
|
return ''; |
|
} |
|
|
|
$paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue', |
|
$parser); |
|
$paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' . |
|
$paramHash->{DEFAULT_VALUE} . '}'; |
|
return ''; |
|
} |
|
|
|
sub end_defaultvalue { return ''; } |
|
|
sub preprocess { |
sub preprocess { |
return 1; |
return 1; |
} |
} |
Line 735 sub overrideForm {
|
Line 820 sub overrideForm {
|
return 0; |
return 0; |
} |
} |
|
|
sub process_multiple_choices { |
|
my $self = shift; |
|
my $formname = shift; |
|
my $var = shift; |
|
|
|
my $formvalue = $ENV{'form.' . $formname}; |
|
if ($formvalue) { |
|
# Must extract values from querystring directly, as there |
|
# may be more then one. |
|
my @values; |
|
for my $formparam (split (/&/, $ENV{QUERY_STRING})) { |
|
my ($name, $value) = split(/=/, $formparam); |
|
if ($name ne $formname) { |
|
next; |
|
} |
|
$value =~ tr/+/ /; |
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; |
|
push @values, $value; |
|
} |
|
$helper->{VARS}->{$var} = join('|||', @values); |
|
} |
|
|
|
return; |
|
} |
|
|
|
1; |
1; |
|
|
package Apache::lonhelper::message; |
package Apache::lonhelper::message; |
Line 868 the result is stored in.
|
Line 928 the result is stored in.
|
<choices> takes an attribute "multichoice" which, if set to a true |
<choices> takes an attribute "multichoice" which, if set to a true |
value, will allow the user to select multiple choices. |
value, will allow the user to select multiple choices. |
|
|
|
<choices> takes an attribute "allowempty" which, if set to a true |
|
value, will allow the user to select none of the choices without raising |
|
an error message. |
|
|
B<SUB-TAGS> |
B<SUB-TAGS> |
|
|
<choices> can have the following subtags: |
<choices> can have the following subtags: |
Line 917 You can mix and match methods of creatin
|
Line 981 You can mix and match methods of creatin
|
"push" onto the choice list, rather then wiping it out. (You can even |
"push" onto the choice list, rather then wiping it out. (You can even |
remove choices programmatically, but that would probably be bad form.) |
remove choices programmatically, but that would probably be bad form.) |
|
|
|
B<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 <choices> |
|
tag is stored in the {VARS} hash. |
|
|
=cut |
=cut |
|
|
no strict; |
no strict; |
Line 942 sub start_choices {
|
Line 1018 sub start_choices {
|
} |
} |
|
|
# Need to initialize the choices list, so everything can assume it exists |
# Need to initialize the choices list, so everything can assume it exists |
$paramHash->{'variable'} = $token->[2]{'variable'}; |
$paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'})); |
$helper->declareVar($paramHash->{'variable'}); |
$helper->declareVar($paramHash->{'variable'}); |
$paramHash->{'multichoice'} = $token->[2]{'multichoice'}; |
$paramHash->{'multichoice'} = $token->[2]{'multichoice'}; |
|
$paramHash->{'allowempty'} = $token->[2]{'allowempty'}; |
$paramHash->{CHOICES} = []; |
$paramHash->{CHOICES} = []; |
return ''; |
return ''; |
} |
} |
Line 990 sub render {
|
Line 1067 sub render {
|
if ($self->{'multichoice'}) { |
if ($self->{'multichoice'}) { |
$result .= <<SCRIPT; |
$result .= <<SCRIPT; |
<script> |
<script> |
function checkall(value) { |
function checkall(value, checkName) { |
for (i=0; i<document.forms.wizform.elements.length; i++) { |
for (i=0; i<document.forms.helpform.elements.length; i++) { |
document.forms.wizform.elements[i].checked=value; |
ele = document.forms.helpform.elements[i]; |
|
if (ele.name == checkName + '.forminput') { |
|
document.forms.helpform.elements[i].checked=value; |
|
} |
} |
} |
} |
} |
</script> |
</script> |
SCRIPT |
SCRIPT |
|
} |
|
|
|
# Only print "select all" and "unselect all" if there are five or |
|
# more choices; fewer then that and it looks silly. |
|
if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) { |
$buttons = <<BUTTONS; |
$buttons = <<BUTTONS; |
<br /> |
<br /> |
<input type="button" onclick="checkall(true)" value="Select All" /> |
<input type="button" onclick="checkall(true, '$var')" value="Select All" /> |
<input type="button" onclick="checkall(false)" value="Unselect All" /> |
<input type="button" onclick="checkall(false, '$var')" value="Unselect All" /> |
<br /> |
<br /> |
BUTTONS |
BUTTONS |
} |
} |
Line 1013 BUTTONS
|
Line 1098 BUTTONS
|
|
|
$result .= "<table>\n\n"; |
$result .= "<table>\n\n"; |
|
|
|
my %checkedChoices; |
|
my $checkedChoicesFunc; |
|
|
|
if (defined($self->{DEFAULT_VALUE})) { |
|
$checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); |
|
die 'Error in default value code for variable ' . |
|
{'variable'} . ', Perl said:' . $@ if $@; |
|
} else { |
|
$checkedChoicesFunc = sub { return ''; }; |
|
} |
|
|
|
# Process which choices should be checked. |
|
if ($self->{'multichoice'}) { |
|
for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) { |
|
$checkedChoices{$selectedChoice} = 1; |
|
} |
|
} else { |
|
# single choice |
|
my $selectedChoice = &$checkedChoicesFunc($helper, $self); |
|
|
|
my $foundChoice = 0; |
|
|
|
# check that the choice is in the list of choices. |
|
for my $choice (@{$self->{CHOICES}}) { |
|
if ($choice->[1] eq $selectedChoice) { |
|
$checkedChoices{$choice->[1]} = 1; |
|
$foundChoice = 1; |
|
} |
|
} |
|
|
|
# If we couldn't find the choice, pick the first one |
|
if (!$foundChoice) { |
|
$checkedChoices{$self->{CHOICES}->[0]->[1]} = 1; |
|
} |
|
} |
|
|
my $type = "radio"; |
my $type = "radio"; |
if ($self->{'multichoice'}) { $type = 'checkbox'; } |
if ($self->{'multichoice'}) { $type = 'checkbox'; } |
my $checked = 0; |
|
foreach my $choice (@{$self->{CHOICES}}) { |
foreach my $choice (@{$self->{CHOICES}}) { |
$result .= "<tr>\n<td width='20'> </td>\n"; |
$result .= "<tr>\n<td width='20'> </td>\n"; |
$result .= "<td valign='top'><input type='$type' name='$var.forminput'" |
$result .= "<td valign='top'><input type='$type' name='$var.forminput'" |
. "' value='" . |
. "' value='" . |
HTML::Entities::encode($choice->[1]) |
HTML::Entities::encode($choice->[1]) |
. "'"; |
. "'"; |
if (!$self->{'multichoice'} && !$checked) { |
if ($checkedChoices{$choice->[1]}) { |
$result .= " checked "; |
$result .= " checked "; |
$checked = 1; |
|
} |
} |
my $choiceLabel = $choice->[0]; |
my $choiceLabel = $choice->[0]; |
if ($choice->[4]) { # if we need to evaluate this choice |
if ($choice->[4]) { # if we need to evaluate this choice |
Line 1047 sub postprocess {
|
Line 1166 sub postprocess {
|
my $self = shift; |
my $self = shift; |
my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'}; |
my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'}; |
|
|
if (!$chosenValue) { |
if (!defined($chosenValue) && !$self->{'allowempty'}) { |
$self->{ERROR_MSG} = "You must choose one or more choices to" . |
$self->{ERROR_MSG} = "You must choose one or more choices to" . |
" continue."; |
" continue."; |
return 0; |
return 0; |
} |
} |
|
|
if ($self->{'multichoice'}) { |
if (ref($chosenValue)) { |
$self->process_multiple_choices($self->{'variable'}.'.forminput', |
$helper->{VARS}->{$self->{'variable'}} = join('|||', @$chosenValue); |
$self->{'variable'}); |
|
} |
} |
|
|
if (defined($self->{NEXTSTATE})) { |
if (defined($self->{NEXTSTATE})) { |
Line 1298 the user can manipulate the folders.
|
Line 1416 the user can manipulate the folders.
|
|
|
<resource> takes the standard variable attribute to control what helper |
<resource> takes the standard variable attribute to control what helper |
variable stores the results. It also takes a "multichoice" attribute, |
variable stores the results. It also takes a "multichoice" attribute, |
which controls whether the user can select more then one resource. |
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. |
|
|
B<SUB-TAGS> |
B<SUB-TAGS> |
|
|
Line 1358 sub start_resource {
|
Line 1482 sub start_resource {
|
|
|
$paramHash->{'variable'} = $token->[2]{'variable'}; |
$paramHash->{'variable'} = $token->[2]{'variable'}; |
$helper->declareVar($paramHash->{'variable'}); |
$helper->declareVar($paramHash->{'variable'}); |
|
$paramHash->{'multichoice'} = $token->[2]{'multichoice'}; |
|
$paramHash->{'suppressEmptySequences'} = $token->[2]{'suppressEmptySequences'}; |
|
$paramHash->{'toponly'} = $token->[2]{'toponly'}; |
return ''; |
return ''; |
} |
} |
|
|
Line 1434 sub start_mapurl {
|
Line 1561 sub start_mapurl {
|
|
|
my $contents = Apache::lonxml::get_all_text('/mapurl', |
my $contents = Apache::lonxml::get_all_text('/mapurl', |
$parser); |
$parser); |
$paramHash->{MAP_URL} = eval $contents; |
$paramHash->{MAP_URL} = $contents; |
} |
} |
|
|
sub end_mapurl { return ''; } |
sub end_mapurl { return ''; } |
Line 1457 sub render {
|
Line 1584 sub render {
|
my $var = $self->{'variable'}; |
my $var = $self->{'variable'}; |
my $curVal = $helper->{VARS}->{$var}; |
my $curVal = $helper->{VARS}->{$var}; |
|
|
|
my $buttons = ''; |
|
|
|
if ($self->{'multichoice'}) { |
|
$result = <<SCRIPT; |
|
<script> |
|
function checkall(value, checkName) { |
|
for (i=0; i<document.forms.helpform.elements.length; i++) { |
|
ele = document.forms.helpform.elements[i]; |
|
if (ele.name == checkName + '.forminput') { |
|
document.forms.helpform.elements[i].checked=value; |
|
} |
|
} |
|
} |
|
</script> |
|
SCRIPT |
|
$buttons = <<BUTTONS; |
|
<br /> |
|
<input type="button" onclick="checkall(true, '$var')" value="Select All Resources" /> |
|
<input type="button" onclick="checkall(false, '$var')" value="Unselect All Resources" /> |
|
<br /> |
|
BUTTONS |
|
} |
|
|
if (defined $self->{ERROR_MSG}) { |
if (defined $self->{ERROR_MSG}) { |
$result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
} |
} |
|
|
|
$result .= $buttons; |
|
|
my $filterFunc = $self->{FILTER_FUNC}; |
my $filterFunc = $self->{FILTER_FUNC}; |
my $choiceFunc = $self->{CHOICE_FUNC}; |
my $choiceFunc = $self->{CHOICE_FUNC}; |
my $valueFunc = $self->{VALUE_FUNC}; |
my $valueFunc = $self->{VALUE_FUNC}; |
my $mapUrl = $self->{MAP_URL}; |
my $mapUrl = $self->{MAP_URL}; |
|
my $multichoice = $self->{'multichoice'}; |
|
|
# Create the composite function that renders the column on the nav map |
# 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 |
# have to admit any language that lets me do this can't be all bad |
Line 1472 sub render {
|
Line 1625 sub render {
|
my $checked = 0; |
my $checked = 0; |
my $renderColFunc = sub { |
my $renderColFunc = sub { |
my ($resource, $part, $params) = @_; |
my ($resource, $part, $params) = @_; |
|
|
|
my $inputType; |
|
if ($multichoice) { $inputType = 'checkbox'; } |
|
else {$inputType = 'radio'; } |
|
|
if (!&$choiceFunc($resource)) { |
if (!&$choiceFunc($resource)) { |
return '<td> </td>'; |
return '<td> </td>'; |
} else { |
} else { |
my $col = "<td><input type='radio' name='${var}.forminput' "; |
my $col = "<td><input type='$inputType' name='${var}.forminput' "; |
if (!$checked) { |
if (!$checked && !$multichoice) { |
$col .= "checked "; |
$col .= "checked "; |
$checked = 1; |
$checked = 1; |
} |
} |
Line 1488 sub render {
|
Line 1645 sub render {
|
} |
} |
}; |
}; |
|
|
$ENV{'form.condition'} = 1; |
$ENV{'form.condition'} = !$self->{'toponly'}; |
$result .= |
$result .= |
&Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, |
&Apache::lonnavmaps::render( { 'cols' => [$renderColFunc, |
Apache::lonnavmaps::resource()], |
Apache::lonnavmaps::resource()], |
'showParts' => 0, |
'showParts' => 0, |
'filterFunc' => $filterFunc, |
'filterFunc' => $filterFunc, |
'resource_no_folder_link' => 1, |
'resource_no_folder_link' => 1, |
|
'suppressEmptySequences' => $self->{'suppressEmptySequences'}, |
'iterator_map' => $mapUrl } |
'iterator_map' => $mapUrl } |
); |
); |
|
|
|
$result .= $buttons; |
|
|
return $result; |
return $result; |
} |
} |
|
|
sub postprocess { |
sub postprocess { |
my $self = shift; |
my $self = shift; |
|
|
|
if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) { |
|
$self->{ERROR_MSG} = 'You must choose at least one resource to continue.'; |
|
return 0; |
|
} |
|
|
if (defined($self->{NEXTSTATE})) { |
if (defined($self->{NEXTSTATE})) { |
$helper->changeState($self->{NEXTSTATE}); |
$helper->changeState($self->{NEXTSTATE}); |
} |
} |
Line 1572 sub render {
|
Line 1738 sub render {
|
my $self = shift; |
my $self = shift; |
my $result = ''; |
my $result = ''; |
my $buttons = ''; |
my $buttons = ''; |
|
my $var = $self->{'variable'}; |
|
|
if ($self->{'multichoice'}) { |
if ($self->{'multichoice'}) { |
$result = <<SCRIPT; |
$result = <<SCRIPT; |
<script> |
<script> |
function checkall(value) { |
function checkall(value, checkName) { |
for (i=0; i<document.forms.wizform.elements.length; i++) { |
for (i=0; i<document.forms.helpform.elements.length; i++) { |
document.forms.wizform.elements[i].checked=value; |
ele = document.forms.helpform.elements[i]; |
|
if (ele.name == checkName + '.forminput') { |
|
document.forms.helpform.elements[i].checked=value; |
|
} |
} |
} |
} |
} |
</script> |
</script> |
SCRIPT |
SCRIPT |
$buttons = <<BUTTONS; |
$buttons = <<BUTTONS; |
<br /> |
<br /> |
<input type="button" onclick="checkall(true)" value="Select All" /> |
<input type="button" onclick="checkall(true, '$var')" value="Select All Students" /> |
<input type="button" onclick="checkall(false)" value="Unselect All" /> |
<input type="button" onclick="checkall(false, '$var')" value="Unselect All Students" /> |
<br /> |
<br /> |
BUTTONS |
BUTTONS |
} |
} |
Line 1627 BUTTONS
|
Line 1797 BUTTONS
|
$checked = 1; |
$checked = 1; |
} |
} |
$result .= |
$result .= |
" value='" . HTML::Entities::encode($_) |
" value='" . HTML::Entities::encode($_ . ':' . $choices->{$_}->[$section]) |
. "' /></td><td>" |
. "' /></td><td>" |
. HTML::Entities::encode($choices->{$_}->[$fullname]) |
. HTML::Entities::encode($choices->{$_}->[$fullname]) |
. "</td><td align='center'>" |
. "</td><td align='center'>" |
Line 1651 sub postprocess {
|
Line 1821 sub postprocess {
|
return 0; |
return 0; |
} |
} |
|
|
if ($self->{'multichoice'}) { |
|
$self->process_multiple_choices($self->{'variable'}.'.forminput', |
|
$self->{'variable'}); |
|
} |
|
if (defined($self->{NEXTSTATE})) { |
if (defined($self->{NEXTSTATE})) { |
$helper->changeState($self->{NEXTSTATE}); |
$helper->changeState($self->{NEXTSTATE}); |
} |
} |
Line 1773 sub render {
|
Line 1939 sub render {
|
|
|
my $filterFunc = $self->{FILTER_FUNC}; |
my $filterFunc = $self->{FILTER_FUNC}; |
my $buttons = ''; |
my $buttons = ''; |
|
my $type = 'radio'; |
|
if ($self->{'multichoice'}) { |
|
$type = 'checkbox'; |
|
} |
|
|
if ($self->{'multichoice'}) { |
if ($self->{'multichoice'}) { |
$result = <<SCRIPT; |
$result = <<SCRIPT; |
<script> |
<script> |
function checkall(value) { |
function checkall(value, checkName) { |
for (i=0; i<document.forms.wizform.elements.length; i++) { |
for (i=0; i<document.forms.helpform.elements.length; i++) { |
ele = document.forms.wizform.elements[i]; |
ele = document.forms.helpform.elements[i]; |
if (ele.type == "checkbox") { |
if (ele.name == checkName + '.forminput') { |
document.forms.wizform.elements[i].checked=value; |
document.forms.helpform.elements[i].checked=value; |
|
} |
|
} |
|
} |
|
|
|
function checkallclass(value, className) { |
|
for (i=0; i<document.forms.helpform.elements.length; i++) { |
|
ele = document.forms.helpform.elements[i]; |
|
if (ele.type == "$type" && ele.onclick) { |
|
document.forms.helpform.elements[i].checked=value; |
} |
} |
} |
} |
} |
} |
</script> |
</script> |
SCRIPT |
SCRIPT |
my $buttons = <<BUTTONS; |
$buttons = <<BUTTONS; |
<br /> |
<br /> |
<input type="button" onclick="checkall(true)" value="Select All" /> |
<input type="button" onclick="checkall(true, '$var')" value="Select All Files" /> |
<input type="button" onclick="checkall(false)" value="Unselect All" /> |
<input type="button" onclick="checkall(false, '$var')" value="Unselect All Files" /> |
|
BUTTONS |
|
|
|
if ($helper->{VARS}->{'construction'}) { |
|
$buttons .= <<BUTTONS; |
|
<input type="button" onclick="checkallclass(true, 'Published')" value="Select All Published" /> |
|
<input type="button" onclick="checkallclass(false, 'Published')" value="Unselect All Published" /> |
<br /> |
<br /> |
BUTTONS |
BUTTONS |
|
} |
} |
} |
|
|
# Get the list of files in this directory. |
# Get the list of files in this directory. |
Line 1814 BUTTONS
|
Line 2000 BUTTONS
|
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
} |
} |
|
|
$result .= '<table border="0" cellpadding="1" cellspacing="1">'; |
$result .= '<table border="0" cellpadding="2" cellspacing="0">'; |
|
|
# Keeps track if there are no choices, prints appropriate error |
# Keeps track if there are no choices, prints appropriate error |
# if there are none. |
# if there are none. |
my $choices = 0; |
my $choices = 0; |
my $type = 'radio'; |
|
if ($self->{'multichoice'}) { |
|
$type = 'checkbox'; |
|
} |
|
# Print each legitimate file choice. |
# Print each legitimate file choice. |
for my $file (@fileList) { |
for my $file (@fileList) { |
$file = (split(/&/, $file))[0]; |
$file = (split(/&/, $file))[0]; |
Line 1831 BUTTONS
|
Line 2013 BUTTONS
|
} |
} |
my $fileName = $subdir .'/'. $file; |
my $fileName = $subdir .'/'. $file; |
if (&$filterFunc($file)) { |
if (&$filterFunc($file)) { |
$result .= '<tr><td align="right">' . |
my $status; |
"<input type='$type' name='" . $var |
my $color; |
|
if ($helper->{VARS}->{'construction'}) { |
|
($status, $color) = @{fileState($subdir, $file)}; |
|
} else { |
|
$status = ''; |
|
$color = ''; |
|
} |
|
|
|
# Netscape 4 is stupid and there's nowhere to put the |
|
# information on the input tag that the file is Published, |
|
# Unpublished, etc. In *real* browsers we can just say |
|
# "class='Published'" and check the className attribute of |
|
# the input tag, but Netscape 4 is too stupid to understand |
|
# that attribute, and un-comprehended attributes are not |
|
# reflected into the object model. So instead, what I do |
|
# is either have or don't have an "onclick" handler that |
|
# does nothing, give Published files the onclick handler, and |
|
# have the checker scripts check for that. Stupid and clumsy, |
|
# and only gives us binary "yes/no" information (at least I |
|
# couldn't figure out how to reach into the event handler's |
|
# actual code to retreive a value), but it works well enough |
|
# here. |
|
|
|
my $onclick = ''; |
|
if ($status eq 'Published' && $helper->{VARS}->{'construction'}) { |
|
$onclick = 'onclick="a=1" '; |
|
} |
|
$result .= '<tr><td align="right"' . " bgcolor='$color'>" . |
|
"<input $onclick type='$type' name='" . $var |
. ".forminput' value='" . HTML::Entities::encode($fileName) . |
. ".forminput' value='" . HTML::Entities::encode($fileName) . |
"'"; |
"'"; |
if (!$self->{'multichoice'} && $choices == 0) { |
if (!$self->{'multichoice'} && $choices == 0) { |
$result .= ' checked'; |
$result .= ' checked'; |
} |
} |
$result .= "/></td><td>" . $file . "</td></tr>\n"; |
$result .= "/></td><td bgcolor='$color'>" . $file . |
|
"</td><td bgcolor='$color'>$status</td></tr>\n"; |
$choices++; |
$choices++; |
} |
} |
} |
} |
Line 1854 BUTTONS
|
Line 2065 BUTTONS
|
return $result; |
return $result; |
} |
} |
|
|
|
# Determine the state of the file: Published, unpublished, modified. |
|
# Return the color it should be in and a label as a two-element array |
|
# reference. |
|
# Logic lifted from lonpubdir.pm, even though I don't know that it's still |
|
# the most right thing to do. |
|
|
|
sub fileState { |
|
my $constructionSpaceDir = shift; |
|
my $file = shift; |
|
|
|
my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
my $subdirpart = $constructionSpaceDir; |
|
$subdirpart =~ s/^\/home\/$ENV{'user.name'}\/public_html//; |
|
my $resdir = $docroot . '/res/' . $ENV{'user.domain'} . '/' . $ENV{'user.name'} . |
|
$subdirpart; |
|
|
|
my @constructionSpaceFileStat = stat($constructionSpaceDir . '/' . $file); |
|
my @resourceSpaceFileStat = stat($resdir . '/' . $file); |
|
if (!@resourceSpaceFileStat) { |
|
return ['Unpublished', '#FFCCCC']; |
|
} |
|
|
|
my $constructionSpaceFileModified = $constructionSpaceFileStat[9]; |
|
my $resourceSpaceFileModified = $resourceSpaceFileStat[9]; |
|
|
|
if ($constructionSpaceFileModified > $resourceSpaceFileModified) { |
|
return ['Modified', '#FFFFCC']; |
|
} |
|
return ['Published', '#CCFFCC']; |
|
} |
|
|
sub postprocess { |
sub postprocess { |
my $self = shift; |
my $self = shift; |
my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; |
my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; |
Line 1863 sub postprocess {
|
Line 2105 sub postprocess {
|
return 0; |
return 0; |
} |
} |
|
|
if ($self->{'multichoice'}) { |
|
$self->process_multiple_choices($self->{'variable'}.'.forminput', |
|
$self->{'variable'}); |
|
} |
|
if (defined($self->{NEXTSTATE})) { |
if (defined($self->{NEXTSTATE})) { |
$helper->changeState($self->{NEXTSTATE}); |
$helper->changeState($self->{NEXTSTATE}); |
} |
} |
Line 2083 sub end_eval {
|
Line 2321 sub end_eval {
|
|
|
1; |
1; |
|
|
|
package Apache::lonhelper::final; |
|
|
|
=pod |
|
|
|
=head2 Element: final |
|
|
|
<final> is a special element that works with helpers that use the <finalcode> |
|
tag. It goes through all the states and elements, executing the <finalcode> |
|
snippets and collecting the results. Finally, it takes the user out of the |
|
helper, going to a provided page. |
|
|
|
=cut |
|
|
|
no strict; |
|
@ISA = ("Apache::lonhelper::element"); |
|
use strict; |
|
|
|
BEGIN { |
|
&Apache::lonhelper::register('Apache::lonhelper::final', |
|
('final', 'exitpage')); |
|
} |
|
|
|
sub new { |
|
my $ref = Apache::lonhelper::element->new(); |
|
bless($ref); |
|
} |
|
|
|
sub start_final { return ''; } |
|
|
|
sub end_final { |
|
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
|
|
|
if ($target ne 'helper') { |
|
return ''; |
|
} |
|
|
|
Apache::lonhelper::final->new(); |
|
|
|
return ''; |
|
} |
|
|
|
sub start_exitpage { |
|
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
|
|
|
if ($target ne 'helper') { |
|
return ''; |
|
} |
|
|
|
$paramHash->{EXIT_PAGE} = &Apache::lonxml::get_all_text('/exitpage', |
|
$parser); |
|
|
|
return ''; |
|
} |
|
|
|
sub end_exitpage { return ''; } |
|
|
|
sub render { |
|
my $self = shift; |
|
|
|
my @results; |
|
|
|
# Collect all the results |
|
for my $stateName (keys %{$helper->{STATES}}) { |
|
my $state = $helper->{STATES}->{$stateName}; |
|
|
|
for my $element (@{$state->{ELEMENTS}}) { |
|
if (defined($element->{FINAL_CODE})) { |
|
# Compile the code. |
|
my $code = 'sub { my $helper = shift; ' . $element->{FINAL_CODE} . |
|
'}'; |
|
$code = eval($code); |
|
die 'Error while executing final code for element with var ' . |
|
$element->{'variable'} . ', Perl said: ' . $@ if $@; |
|
|
|
my $result = &$code($helper); |
|
if ($result) { |
|
push @results, $result; |
|
} |
|
} |
|
} |
|
} |
|
|
|
if (scalar(@results) == 0) { |
|
return ''; |
|
} |
|
|
|
my $result = "<ul>\n"; |
|
for my $re (@results) { |
|
$result .= ' <li>' . $re . "</li>\n"; |
|
} |
|
return $result . '</ul>'; |
|
} |
|
|
|
1; |
|
|
package Apache::lonhelper::parmwizfinal; |
package Apache::lonhelper::parmwizfinal; |
|
|
# This is the final state for the parmwizard. It is not generally useful, |
# This is the final state for the parmwizard. It is not generally useful, |
Line 2130 sub render {
|
Line 2463 sub render {
|
'due_date' => "0_duedate", |
'due_date' => "0_duedate", |
'answer_date' => "0_answerdate"); |
'answer_date' => "0_answerdate"); |
|
|
my $result = "<form name='wizform' method='get' action='/adm/parmset'>\n"; |
|
$result .= '<p>Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.<ul>'; |
|
my $affectedResourceId = ""; |
my $affectedResourceId = ""; |
my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; |
my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; |
my $level = ""; |
my $level = ""; |
|
my $resourceString; |
# Print the type of manipulation: |
my $symb; |
$result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}} |
my $paramlevel; |
. "</b></li>\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 .= "<input type='hidden' name='recent_date_end' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_value' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_type' " . |
|
"value='date_end' />\n"; |
|
} elsif ($vars->{ACTION_TYPE} eq 'open_date') { |
|
$result .= "<input type='hidden' name='recent_date_start' ". |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_value' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_type' " . |
|
"value='date_start' />\n"; |
|
} |
|
|
|
# Print the granularity, depending on the action |
# Print the granularity, depending on the action |
if ($vars->{GRANULARITY} eq 'whole_course') { |
if ($vars->{GRANULARITY} eq 'whole_course') { |
$result .= '<li>for <b>all resources in the course</b></li>'; |
$resourceString .= '<li>for <b>all resources in the course</b></li>'; |
$level = 9; # general course, see lonparmset.pm perldoc |
$level = 9; # general course, see lonparmset.pm perldoc |
$affectedResourceId = "0.0"; |
$affectedResourceId = "0.0"; |
|
$symb = 'a'; |
|
$paramlevel = 'general'; |
} elsif ($vars->{GRANULARITY} eq 'map') { |
} elsif ($vars->{GRANULARITY} eq 'map') { |
my $navmap = Apache::lonnavmaps::navmap->new( |
my $navmap = Apache::lonnavmaps::navmap->new( |
$ENV{"request.course.fn"}.".db", |
$ENV{"request.course.fn"}.".db", |
$ENV{"request.course.fn"}."_parms.db", 0, 0); |
$ENV{"request.course.fn"}."_parms.db", 0, 0); |
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
my $title = $res->compTitle(); |
my $title = $res->compTitle(); |
|
$symb = $res->symb(); |
$navmap->untieHashes(); |
$navmap->untieHashes(); |
$result .= "<li>for the map named <b>$title</b></li>"; |
$resourceString .= "<li>for the map named <b>$title</b></li>"; |
$level = 8; |
$level = 8; |
$affectedResourceId = $vars->{RESOURCE_ID}; |
$affectedResourceId = $vars->{RESOURCE_ID}; |
|
$paramlevel = 'map'; |
} else { |
} else { |
my $navmap = Apache::lonnavmaps::navmap->new( |
my $navmap = Apache::lonnavmaps::navmap->new( |
$ENV{"request.course.fn"}.".db", |
$ENV{"request.course.fn"}.".db", |
$ENV{"request.course.fn"}."_parms.db", 0, 0); |
$ENV{"request.course.fn"}."_parms.db", 0, 0); |
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
|
$symb = $res->symb(); |
my $title = $res->compTitle(); |
my $title = $res->compTitle(); |
$navmap->untieHashes(); |
$navmap->untieHashes(); |
$result .= "<li>for the resource named <b>$title</b></li>"; |
$resourceString .= "<li>for the resource named <b>$title</b></li>"; |
$level = 7; |
$level = 7; |
$affectedResourceId = $vars->{RESOURCE_ID}; |
$affectedResourceId = $vars->{RESOURCE_ID}; |
|
$paramlevel = 'full'; |
} |
} |
|
|
|
my $result = "<form name='helpform' method='get' action='/adm/parmset#$affectedResourceId&$parm_name&$level'>\n"; |
|
$result .= '<p>Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.<ul>'; |
|
|
|
# Print the type of manipulation: |
|
$result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}} |
|
. "</b></li>\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 .= "<input type='hidden' name='recent_date_end' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_value' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_type' " . |
|
"value='date_end' />\n"; |
|
} elsif ($vars->{ACTION_TYPE} eq 'open_date') { |
|
$result .= "<input type='hidden' name='recent_date_start' ". |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_value' " . |
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
|
$result .= "<input type='hidden' name='pres_type' " . |
|
"value='date_start' />\n"; |
|
} |
|
|
|
$result .= $resourceString; |
|
|
# Print targets |
# Print targets |
if ($vars->{TARGETS} eq 'course') { |
if ($vars->{TARGETS} eq 'course') { |
$result .= '<li>for <b>all students in course</b></li>'; |
$result .= '<li>for <b>all students in course</b></li>'; |
Line 2196 sub render {
|
Line 2541 sub render {
|
} else { |
} else { |
# FIXME: This is probably wasteful! Store the name! |
# FIXME: This is probably wasteful! Store the name! |
my $classlist = Apache::loncoursedata::get_classlist(); |
my $classlist = Apache::loncoursedata::get_classlist(); |
my $name = $classlist->{$vars->{USER_NAME}}->[6]; |
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 .= "<li>for <b>$name</b></li>"; |
$result .= "<li>for <b>$name</b></li>"; |
$level -= 6; |
$level -= 6; |
my ($uname, $udom) = split /:/, $vars->{USER_NAME}; |
my ($uname, $udom) = split /:/, $vars->{USER_NAME}; |
Line 2214 sub render {
|
Line 2562 sub render {
|
# print pres_marker |
# print pres_marker |
$result .= "\n<input type='hidden' name='pres_marker'" . |
$result .= "\n<input type='hidden' name='pres_marker'" . |
" value='$affectedResourceId&$parm_name&$level' />\n"; |
" value='$affectedResourceId&$parm_name&$level' />\n"; |
|
|
|
# Make the table appear |
|
$result .= "\n<input type='hidden' value='true' name='prevvisit' />"; |
|
$result .= "\n<input type='hidden' value='all' name='pschp' />"; |
|
$result .= "\n<input type='hidden' value='$symb' name='pssymb' />"; |
|
$result .= "\n<input type='hidden' value='$paramlevel' name='parmlev' />"; |
|
|
$result .= "<br /><br /><center><input type='submit' value='Finish Helper' /></center></form>\n"; |
$result .= "<br /><br /><center><input type='submit' value='Finish Helper' /></center></form>\n"; |
|
|