version 1.14, 2003/04/30 18:40:49
|
version 1.25, 2003/05/08 19:52:43
|
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 311 sub new {
|
Line 343 sub new {
|
|
|
$self->{TITLE} = shift; |
$self->{TITLE} = shift; |
|
|
|
Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); |
|
|
# If there is a state from the previous form, use that. If there is no |
# If there is a state from the previous form, use that. If there is no |
# state, use the start state parameter. |
# state, use the start state parameter. |
if (defined $ENV{"form.CURRENT_STATE"}) |
if (defined $ENV{"form.CURRENT_STATE"}) |
Line 322 sub new {
|
Line 356 sub new {
|
$self->{STATE} = "START"; |
$self->{STATE} = "START"; |
} |
} |
|
|
Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); |
|
|
|
$self->{TOKEN} = $ENV{'form.TOKEN'}; |
$self->{TOKEN} = $ENV{'form.TOKEN'}; |
# If a token was passed, we load that in. Otherwise, we need to create a |
# If a token was passed, we load that in. Otherwise, we need to create a |
# new storage file |
# new storage file |
Line 462 sub process {
|
Line 494 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 505 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 528 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 680 the helper variables, like this:
|
Line 718 the helper variables, like this:
|
|
|
=back |
=back |
|
|
|
B<finalcode tag> |
|
|
|
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. |
|
|
|
Again, see the course initialization helper for examples. |
|
|
=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 784 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 914 You can mix and match methods of creatin
|
Line 1009 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 939 sub start_choices {
|
Line 1046 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->{CHOICES} = []; |
$paramHash->{CHOICES} = []; |
Line 987 sub render {
|
Line 1094 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 |
} |
} |
|
|
if (defined $self->{ERRO_MSG}) { |
if (defined $self->{ERROR_MSG}) { |
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />'; |
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />'; |
} |
} |
|
|
Line 1010 BUTTONS
|
Line 1125 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 1044 sub postprocess {
|
Line 1193 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->{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; |
Line 1295 the user can manipulate the folders.
|
Line 1444 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. |
|
|
B<SUB-TAGS> |
B<SUB-TAGS> |
|
|
Line 1356 sub start_resource {
|
Line 1508 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->{'multichoice'} = $token->[2]{'multichoice'}; |
|
$paramHash->{'toponly'} = $token->[2]{'toponly'}; |
return ''; |
return ''; |
} |
} |
|
|
Line 1455 sub render {
|
Line 1608 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 .= '<br /><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}; |
Line 1491 sub render {
|
Line 1669 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()], |
Line 1500 sub render {
|
Line 1678 sub render {
|
'resource_no_folder_link' => 1, |
'resource_no_folder_link' => 1, |
'iterator_map' => $mapUrl } |
'iterator_map' => $mapUrl } |
); |
); |
|
|
|
$result .= $buttons; |
|
|
return $result; |
return $result; |
} |
} |
Line 1586 sub render {
|
Line 1766 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 1641 BUTTONS
|
Line 1825 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 1787 sub render {
|
Line 1971 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 1828 BUTTONS
|
Line 2032 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 1845 BUTTONS
|
Line 2045 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 1868 BUTTONS
|
Line 2097 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'}; |