version 1.37, 2003/06/12 13:52:06
|
version 1.43, 2003/08/13 14:52:08
|
Line 779 some setting accidentally.
|
Line 779 some setting accidentally.
|
|
|
Again, see the course initialization helper for examples. |
Again, see the course initialization helper for examples. |
|
|
|
B<validator tag> |
|
|
|
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. |
|
|
B<getValue method> |
B<getValue method> |
|
|
If the element stores the name of the variable in a 'variable' member, which |
If the element stores the name of the variable in a 'variable' member, which |
Line 790 this method.
|
Line 802 this method.
|
BEGIN { |
BEGIN { |
&Apache::lonhelper::register('Apache::lonhelper::element', |
&Apache::lonhelper::register('Apache::lonhelper::element', |
('nextstate', 'finalcode', |
('nextstate', 'finalcode', |
'defaultvalue')); |
'defaultvalue', 'validator')); |
} |
} |
|
|
# Because we use the param hash, this is often a sufficent |
# Because we use the param hash, this is often a sufficent |
Line 855 sub start_defaultvalue {
|
Line 867 sub start_defaultvalue {
|
|
|
sub end_defaultvalue { return ''; } |
sub end_defaultvalue { return ''; } |
|
|
|
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 { |
sub preprocess { |
return 1; |
return 1; |
} |
} |
Line 1114 sub end_choice {
|
Line 1142 sub end_choice {
|
} |
} |
|
|
sub render { |
sub render { |
# START HERE: Replace this with correct choices code. |
|
my $self = shift; |
my $self = shift; |
my $var = $self->{'variable'}; |
my $var = $self->{'variable'}; |
my $buttons = ''; |
my $buttons = ''; |
Line 1247 sub postprocess {
|
Line 1274 sub postprocess {
|
} |
} |
1; |
1; |
|
|
|
package Apache::lonhelper::dropdown; |
|
|
|
=pod |
|
|
|
=head2 Element: dropdown |
|
|
|
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. |
|
|
|
<dropdown> takes an attribute "variable" to control which helper variable |
|
the result is stored in. |
|
|
|
B<SUB-TAGS> |
|
|
|
<choice>, which acts just as it does in the "choices" element. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
no strict; |
|
@ISA = ("Apache::lonhelper::element"); |
|
use strict; |
|
|
|
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 .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />'; |
|
} |
|
|
|
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 .= "<select name='${var}.forminput'>\n"; |
|
foreach my $choice (@{$self->{CHOICES}}) { |
|
$result .= "<option value='" . |
|
HTML::Entities::encode($choice->[1]) |
|
. "'"; |
|
if ($checkedChoices{$choice->[1]}) { |
|
$result .= " selected"; |
|
} |
|
my $choiceLabel = $choice->[0]; |
|
if ($choice->[4]) { # if we need to evaluate this choice |
|
$choiceLabel = "sub { my $helper = shift; my $state = shift;" . |
|
$choiceLabel . "}"; |
|
$choiceLabel = eval($choiceLabel); |
|
$choiceLabel = &$choiceLabel($helper, $self); |
|
} |
|
$result .= ">" . $choiceLabel . "\n"; |
|
} |
|
$result .= "</select>\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; |
package Apache::lonhelper::date; |
|
|
=pod |
=pod |
Line 1747 package Apache::lonhelper::student;
|
Line 1922 package Apache::lonhelper::student;
|
Student elements display a choice of students enrolled in the current |
Student elements display a choice of students enrolled in the current |
course. Currently it is primitive; this is expected to evolve later. |
course. Currently it is primitive; this is expected to evolve later. |
|
|
Student elements take two attributes: "variable", which means what |
Student elements take three attributes: "variable", which means what |
it usually does, and "multichoice", which if true allows the user |
it usually does, "multichoice", which if true allows the user |
to select multiple students. |
to select multiple students, and "coursepersonnel" which if true |
|
adds the course personnel to the top of the student selection. |
|
|
=cut |
=cut |
|
|
Line 1779 sub start_student {
|
Line 1955 sub start_student {
|
$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->{'coursepersonnel'} = $token->[2]{'coursepersonnel'}; |
if (defined($token->[2]{'nextstate'})) { |
if (defined($token->[2]{'nextstate'})) { |
$paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; |
$paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; |
} |
} |
Line 1825 BUTTONS
|
Line 2002 BUTTONS
|
$result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
$result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
} |
} |
|
|
# Load up the students |
my $choices = []; |
my $choices = &Apache::loncoursedata::get_classlist(); |
|
my @keys = keys %{$choices}; |
# Load up the non-students, if necessary |
|
if ($self->{'coursepersonnel'}) { |
|
my %coursepersonnel = Apache::lonnet::get_course_adv_roles(); |
|
for (sort keys %coursepersonnel) { |
|
for my $role (split /,/, $coursepersonnel{$_}) { |
|
# extract the names so we can sort them |
|
my @people; |
|
|
|
for (split /,/, $role) { |
|
push @people, [split /:/, $role]; |
|
} |
|
|
|
@people = sort { $a->[0] cmp $b->[0] } @people; |
|
|
|
for my $person (@people) { |
|
push @$choices, [join(':', @$person), $person->[0], '', $_]; |
|
} |
|
} |
|
} |
|
} |
|
|
# Constants |
# Constants |
my $section = Apache::loncoursedata::CL_SECTION(); |
my $section = Apache::loncoursedata::CL_SECTION(); |
my $fullname = Apache::loncoursedata::CL_FULLNAME(); |
my $fullname = Apache::loncoursedata::CL_FULLNAME(); |
|
|
|
# Load up the students |
|
my $classlist = &Apache::loncoursedata::get_classlist(); |
|
my @keys = keys %{$classlist}; |
# Sort by: Section, name |
# Sort by: Section, name |
@keys = sort { |
@keys = sort { |
if ($choices->{$a}->[$section] ne $choices->{$b}->[$section]) { |
if ($classlist->{$a}->[$section] ne $classlist->{$b}->[$section]) { |
return $choices->{$a}->[$section] cmp $choices->{$b}->[$section]; |
return $classlist->{$a}->[$section] cmp $classlist->{$b}->[$section]; |
} |
} |
return $choices->{$a}->[$fullname] cmp $choices->{$b}->[$fullname]; |
return $classlist->{$a}->[$fullname] cmp $classlist->{$b}->[$fullname]; |
} @keys; |
} @keys; |
|
|
|
# username, fullname, section, type |
|
for (@keys) { |
|
push @$choices, [$_, $classlist->{$_}->[$fullname], |
|
$classlist->{$_}->[$section], 'Student']; |
|
} |
|
|
|
my $name = $self->{'coursepersonnel'} ? 'Name' : 'Student Name'; |
my $type = 'radio'; |
my $type = 'radio'; |
if ($self->{'multichoice'}) { $type = 'checkbox'; } |
if ($self->{'multichoice'}) { $type = 'checkbox'; } |
$result .= "<table cellspacing='2' cellpadding='2' border='0'>\n"; |
$result .= "<table cellspacing='2' cellpadding='2' border='0'>\n"; |
$result .= "<tr><td></td><td align='center'><b>Student Name</b></td>". |
$result .= "<tr><td></td><td align='center'><b>$name</b></td>". |
"<td align='center'><b>Section</b></td></tr>"; |
"<td align='center'><b>Section</b></td>" . |
|
"<td align='center'><b>Role</b></td></tr>"; |
|
|
my $checked = 0; |
my $checked = 0; |
foreach (@keys) { |
for my $choice (@$choices) { |
$result .= "<tr><td><input type='$type' name='" . |
$result .= "<tr><td><input type='$type' name='" . |
$self->{'variable'} . '.forminput' . "'"; |
$self->{'variable'} . '.forminput' . "'"; |
|
|
Line 1857 BUTTONS
|
Line 2064 BUTTONS
|
$checked = 1; |
$checked = 1; |
} |
} |
$result .= |
$result .= |
" value='" . HTML::Entities::encode($_ . ':' . $choices->{$_}->[$section]) |
" value='" . HTML::Entities::encode($choice->[0] . ':' . $choice->[2]) |
. "' /></td><td>" |
. "' /></td><td>" |
. HTML::Entities::encode($choices->{$_}->[$fullname]) |
. HTML::Entities::encode($choice->[1]) |
. "</td><td align='center'>" |
. "</td><td align='center'>" |
. HTML::Entities::encode($choices->{$_}->[$section]) |
. HTML::Entities::encode($choice->[2]) |
. "</td></tr>\n"; |
. "</td>\n<td>" |
|
. HTML::Entities::encode($choice->[3]) . "</td></tr>\n"; |
} |
} |
|
|
$result .= "</table>\n\n"; |
$result .= "</table>\n\n"; |
Line 2266 also pass through 'maxlength' and 'size'
|
Line 2474 also pass through 'maxlength' and 'size'
|
|
|
string honors the defaultvalue tag, if given. |
string honors the defaultvalue tag, if given. |
|
|
|
string honors the validation function, if given. |
|
|
=cut |
=cut |
|
|
no strict; |
no strict; |
Line 2311 sub end_string {
|
Line 2521 sub end_string {
|
|
|
sub render { |
sub render { |
my $self = shift; |
my $self = shift; |
my $result = '<input type="string" name="' . $self->{'variable'} . '.forminput"'; |
my $result = ''; |
|
|
|
if (defined $self->{ERROR_MSG}) { |
|
$result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; |
|
} |
|
|
|
$result .= '<input type="string" name="' . $self->{'variable'} . '.forminput"'; |
|
|
if (defined($self->{'size'})) { |
if (defined($self->{'size'})) { |
$result .= ' size="' . $self->{'size'} . '"'; |
$result .= ' size="' . $self->{'size'} . '"'; |
Line 2335 sub render {
|
Line 2551 sub render {
|
# If a NEXTSTATE was given, switch to it |
# If a NEXTSTATE was given, switch to it |
sub postprocess { |
sub postprocess { |
my $self = shift; |
my $self = shift; |
if (defined($self->{NEXTSTATE})) { |
|
$helper->changeState($self->{NEXTSTATE}); |
if (defined($self->{VALIDATOR})) { |
|
my $validator = eval($self->{VALIDATOR}); |
|
die 'Died during evaluation of evaulation code; Perl said: ' . $@ if $@; |
|
my $invalid = &$validator($helper, $state, $self, $self->getValue()); |
|
if ($invalid) { |
|
$self->{ERROR_MSG} = $invalid; |
|
return 0; |
|
} |
|
} |
|
|
|
if (defined($self->{'nextstate'})) { |
|
$helper->changeState($self->{'nextstate'}); |
} |
} |
|
|
return 1; |
return 1; |
Line 2574 sub render {
|
Line 2801 sub render {
|
} |
} |
} |
} |
|
|
if (scalar(@results) == 0) { |
my $result; |
return ''; |
|
} |
|
|
|
my $result = "<ul>\n"; |
if (scalar(@results) != 0) { |
for my $re (@results) { |
$result .= "<ul>\n"; |
$result .= ' <li>' . $re . "</li>\n"; |
for my $re (@results) { |
} |
$result .= ' <li>' . $re . "</li>\n"; |
|
} |
if (!@results) { |
|
$result .= ' <li>No changes were made to current settings.</li>'; |
if (!@results) { |
|
$result .= ' <li>No changes were made to current settings.</li>'; |
|
} |
|
|
|
$result .= '</ul>'; |
} |
} |
|
|
if ($self->{'restartCourse'}) { |
if ($self->{'restartCourse'}) { |
Line 2598 sub render {
|
Line 2827 sub render {
|
"</form></center>"; |
"</form></center>"; |
} |
} |
|
|
return $result . '</ul>'; |
return $result; |
} |
} |
|
|
sub overrideForm { |
sub overrideForm { |
Line 2650 sub render {
|
Line 2879 sub render {
|
# FIXME: Unify my designators with the standard ones |
# FIXME: Unify my designators with the standard ones |
my %dateTypeHash = ('open_date' => "Opening Date", |
my %dateTypeHash = ('open_date' => "Opening Date", |
'due_date' => "Due Date", |
'due_date' => "Due Date", |
'answer_date' => "Answer Date"); |
'answer_date' => "Answer Date", |
|
'tries' => 'Number of Tries' |
|
); |
my %parmTypeHash = ('open_date' => "0_opendate", |
my %parmTypeHash = ('open_date' => "0_opendate", |
'due_date' => "0_duedate", |
'due_date' => "0_duedate", |
'answer_date' => "0_answerdate"); |
'answer_date' => "0_answerdate", |
|
'tries' => '0_maxtries' ); |
|
|
my $affectedResourceId = ""; |
my $affectedResourceId = ""; |
my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; |
my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; |
Line 2670 sub render {
|
Line 2902 sub render {
|
$symb = 'a'; |
$symb = 'a'; |
$paramlevel = 'general'; |
$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"}."_parms.db", 0, 0); |
|
my $res = $navmap->getByMapPc($vars->{RESOURCE_ID}); |
my $res = $navmap->getByMapPc($vars->{RESOURCE_ID}); |
my $title = $res->compTitle(); |
my $title = $res->compTitle(); |
$symb = $res->symb(); |
$symb = $res->symb(); |
Line 2682 sub render {
|
Line 2912 sub render {
|
$affectedResourceId = $vars->{RESOURCE_ID}; |
$affectedResourceId = $vars->{RESOURCE_ID}; |
$paramlevel = 'map'; |
$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"}."_parms.db", 0, 0); |
|
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
my $res = $navmap->getById($vars->{RESOURCE_ID}); |
$symb = $res->symb(); |
$symb = $res->symb(); |
my $title = $res->compTitle(); |
my $title = $res->compTitle(); |
Line 2699 sub render {
|
Line 2927 sub render {
|
$result .= '<p>Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.<ul>'; |
$result .= '<p>Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.<ul>'; |
|
|
# Print the type of manipulation: |
# Print the type of manipulation: |
$result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}} |
$result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}} . '</b>'; |
. "</b></li>\n"; |
if ($vars->{ACTION_TYPE} eq 'tries') { |
|
$result .= ' to <b>' . $vars->{TRIES} . '</b>'; |
|
} |
|
$result .= "</li>\n"; |
if ($vars->{ACTION_TYPE} eq 'due_date' || |
if ($vars->{ACTION_TYPE} eq 'due_date' || |
$vars->{ACTION_TYPE} eq 'answer_date') { |
$vars->{ACTION_TYPE} eq 'answer_date') { |
# for due dates, we default to "date end" type entries |
# for due dates, we default to "date end" type entries |
Line 2717 sub render {
|
Line 2948 sub render {
|
"value='" . $vars->{PARM_DATE} . "' />\n"; |
"value='" . $vars->{PARM_DATE} . "' />\n"; |
$result .= "<input type='hidden' name='pres_type' " . |
$result .= "<input type='hidden' name='pres_type' " . |
"value='date_start' />\n"; |
"value='date_start' />\n"; |
} |
} elsif ($vars->{ACTION_TYPE} eq 'tries') { |
|
$result .= "<input type='hidden' name='pres_value' " . |
|
"value='" . $vars->{TRIES} . "' />\n"; |
|
} |
|
|
$result .= $resourceString; |
$result .= $resourceString; |
|
|
Line 2747 sub render {
|
Line 2981 sub render {
|
} |
} |
|
|
# Print value |
# Print value |
$result .= "<li>to <b>" . ctime($vars->{PARM_DATE}) . "</b> (" . |
if ($vars->{ACTION_TYPE} ne 'tries') { |
Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}) |
$result .= "<li>to <b>" . ctime($vars->{PARM_DATE}) . "</b> (" . |
. ")</li>\n"; |
Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}) |
|
. ")</li>\n"; |
|
} |
|
|
# 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"; |