--- loncom/interface/lonhelper.pm 2003/05/14 20:16:56 1.29 +++ loncom/interface/lonhelper.pm 2003/06/23 20:39:18 1.40 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # .helper XML handler to implement the LON-CAPA helper # -# $Id: lonhelper.pm,v 1.29 2003/05/14 20:16:56 bowersj2 Exp $ +# $Id: lonhelper.pm,v 1.40 2003/06/23 20:39:18 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,10 @@ Each state contains one or more state el 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". +of the helper itself, such as "Parameter helper". The helper tag may optionally +have a "requiredpriv" attribute, specifying the priviledge a user must have +to use the helper, or get denied access. See loncom/auth/rolesplain.tab for +useful privs. Default is full access, which is often wrong! =head2 State tags @@ -257,10 +260,17 @@ sub real_handler { # xml parsing &Apache::lonxml::xmlparse($r, 'helper', $file); + my $allowed = $helper->allowedCheck(); + if (!$allowed) { + $ENV{'user.error.msg'} = $ENV{'request.uri'}.':'.$helper->{REQUIRED_PRIV}. + ":0:0:Permission denied to access this helper."; + return HTTP_NOT_ACCEPTABLE; + } + $helper->process(); $r->print($helper->display()); - return OK; + return OK; } sub registerHelperTags { @@ -284,7 +294,7 @@ sub start_helper { registerHelperTags(); - Apache::lonhelper::helper->new($token->[2]{'title'}); + Apache::lonhelper::helper->new($token->[2]{'title'}, $token->[2]{'requiredpriv'}); return ''; } @@ -343,6 +353,7 @@ sub new { 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. @@ -467,6 +478,16 @@ sub declareVar { } } +sub allowedCheck { + my $self = shift; + + if (!defined($self->{REQUIRED_PRIV})) { + return 1; + } + + return Apache::lonnet::allowed($self->{REQUIRED_PRIV}, $ENV{'request.course.id'}); +} + sub changeState { my $self = shift; $self->{STATE} = shift; @@ -549,17 +570,41 @@ sub display { HEADER if (!$state->overrideForm()) { $result.="
"; } $result .= < + @@ -684,7 +730,6 @@ sub addElement { push @{$self->{ELEMENTS}}, $element; } -use Data::Dumper; sub render { my $self = shift; my @results = (); @@ -734,12 +779,30 @@ some setting accidentally. Again, see the course initialization helper for examples. +B + +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 + +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')); + 'defaultvalue', 'validator')); } # Because we use the param hash, this is often a sufficent @@ -804,6 +867,22 @@ sub start_defaultvalue { 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 { return 1; } @@ -820,6 +899,11 @@ sub overrideForm { return 0; } +sub getValue { + my $self = shift; + return $helper->{VARS}->{$self->{'variable'}}; +} + 1; package Apache::lonhelper::message; @@ -1104,7 +1188,7 @@ BUTTONS if (defined($self->{DEFAULT_VALUE})) { $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); die 'Error in default value code for variable ' . - {'variable'} . ', Perl said:' . $@ if $@; + $self->{'variable'} . ', Perl said: ' . $@ if $@; } else { $checkedChoicesFunc = sub { return ''; }; } @@ -1638,6 +1722,10 @@ BUTTONS $col .= "checked "; $checked = 1; } + if ($multichoice) { # all resources start checked; see bug 1174 + $col .= "checked "; + $checked = 1; + } $col .= "value='" . HTML::Entities::encode(&$valueFunc($resource)) . "' />"; @@ -1687,9 +1775,10 @@ package Apache::lonhelper::student; Student elements display a choice of students enrolled in the current course. Currently it is primitive; this is expected to evolve later. -Student elements take two attributes: "variable", which means what -it usually does, and "multichoice", which if true allows the user -to select multiple students. +Student elements take three attributes: "variable", which means what +it usually does, "multichoice", which if true allows the user +to select multiple students, and "coursepersonnel" which if true +adds the course personnel to the top of the student selection. =cut @@ -1719,6 +1808,7 @@ sub start_student { $paramHash->{'variable'} = $token->[2]{'variable'}; $helper->declareVar($paramHash->{'variable'}); $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; + $paramHash->{'coursepersonnel'} = $token->[2]{'coursepersonnel'}; if (defined($token->[2]{'nextstate'})) { $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; } @@ -1765,30 +1855,60 @@ BUTTONS $result .= '' . $self->{ERROR_MSG} . '

'; } - # Load up the students - my $choices = &Apache::loncoursedata::get_classlist(); - my @keys = keys %{$choices}; + my $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 my $section = Apache::loncoursedata::CL_SECTION(); my $fullname = Apache::loncoursedata::CL_FULLNAME(); + # Load up the students + my $classlist = &Apache::loncoursedata::get_classlist(); + my @keys = keys %{$classlist}; # Sort by: Section, name @keys = sort { - if ($choices->{$a}->[$section] ne $choices->{$b}->[$section]) { - return $choices->{$a}->[$section] cmp $choices->{$b}->[$section]; + if ($classlist->{$a}->[$section] ne $classlist->{$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; + # username, fullname, section, type + for (@keys) { + push @$choices, [$_, $classlist->{$_}->[$fullname], + $classlist->{$_}->[$section], 'Student']; + } + + my $name = $self->{'coursepersonnel'} ? 'Name' : 'Student Name'; my $type = 'radio'; if ($self->{'multichoice'}) { $type = 'checkbox'; } $result .= "

$stateTitle

HEADER + $result .= "
"; + if (!$state->overrideForm()) { $result .= $self->_saveVars(); } - $result .= $state->render() . "

 

"; + $result .= $state->render(); + + $result .= "		"; + + # Warning: Copy and pasted from below, because it's too much trouble to + # turn this into a subroutine + if (!$state->overrideForm()) { + if ($self->{STATE} ne $self->{START_STATE}) { + #$result .= '  '; + } + if ($self->{DONE}) { + my $returnPage = $self->{RETURN_PAGE}; + $result .= "End Helper"; + } + else { + $result .= 'overrideForm()) { - $result .= '
'; if ($self->{STATE} ne $self->{START_STATE}) { #$result .= '  '; } @@ -568,17 +613,18 @@ HEADER $result .= "End Helper"; } else { - $result .= '{VARS}}) { # $result .= "|$key| -> " . $self->{VARS}->{$key} . "
"; #} + $result .= "
"; + $result .= <
\n"; - $result .= "". - ""; + $result .= "". + "" . + ""; my $checked = 0; - foreach (@keys) { + for my $choice (@$choices) { $result .= "\n"; + . HTML::Entities::encode($choice->[2]) + . "\n\n"; } $result .= "
Student NameSection
$nameSectionRole
{$_}->[$section]) + " value='" . HTML::Entities::encode($choice->[0] . ':' . $choice->[2]) . "' />" - . HTML::Entities::encode($choices->{$_}->[$fullname]) + . HTML::Entities::encode($choice->[1]) . "" - . HTML::Entities::encode($choices->{$_}->[$section]) - . "
" + . HTML::Entities::encode($choice->[3]) . "
\n\n"; @@ -1866,6 +1987,8 @@ no strict; @ISA = ("Apache::lonhelper::element"); use strict; +use Apache::lonpubdir; # for getTitleString + BEGIN { &Apache::lonhelper::register('Apache::lonhelper::files', ('files', 'filechoice', 'filefilter')); @@ -2022,6 +2145,9 @@ BUTTONS $color = ''; } + # Get the title + my $title = Apache::lonpubdir::getTitleString($fileName); + # 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 @@ -2048,8 +2174,9 @@ BUTTONS if (!$self->{'multichoice'} && $choices == 0) { $result .= ' checked'; } - $result .= "/>" . $file . - "$status\n"; + $result .= "/>" . $file . "" . + "$title" . + "$status" . "\n"; $choices++; } } @@ -2188,6 +2315,115 @@ sub end_section { } 1; +package Apache::lonhelper::string; + +=pod + +=head2 Element: string + +string elements provide a string entry field for the user. string elements +take the usual 'variable' and 'nextstate' parameters. string elements +also pass through 'maxlength' and 'size' attributes to the input tag. + +string honors the defaultvalue tag, if given. + +string honors the validation function, if given. + +=cut + +no strict; +@ISA = ("Apache::lonhelper::element"); +use strict; + +BEGIN { + &Apache::lonhelper::register('Apache::lonhelper::string', + ('string')); +} + +sub new { + my $ref = Apache::lonhelper::element->new(); + bless($ref); +} + +# CONSTRUCTION: Construct the message element from the XML +sub start_string { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + + $paramHash->{'variable'} = $token->[2]{'variable'}; + $helper->declareVar($paramHash->{'variable'}); + $paramHash->{'nextstate'} = $token->[2]{'nextstate'}; + $paramHash->{'maxlength'} = $token->[2]{'maxlength'}; + $paramHash->{'size'} = $token->[2]{'size'}; + + return ''; +} + +sub end_string { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + + if ($target ne 'helper') { + return ''; + } + Apache::lonhelper::string->new(); + return ''; +} + +sub render { + my $self = shift; + my $result = ''; + + if (defined $self->{ERROR_MSG}) { + $result .= '
' . $self->{ERROR_MSG} . '

'; + } + + $result .= '{'size'})) { + $result .= ' size="' . $self->{'size'} . '"'; + } + if (defined($self->{'maxlength'})) { + $result .= ' maxlength="' . $self->{'maxlength'} . '"'; + } + + if (defined($self->{DEFAULT_VALUE})) { + my $valueFunc = eval($self->{DEFAULT_VALUE}); + die 'Error in default value code for variable ' . + $self->{'variable'} . ', Perl said: ' . $@ if $@; + $result .= ' value="' . &$valueFunc($helper, $self) . '"'; + } + + $result .= ' />'; + + return $result; +} + +# If a NEXTSTATE was given, switch to it +sub postprocess { + my $self = shift; + + if (defined($self->{VALIDATOR})) { + my $validator = eval($self->{VALIDATOR}); + die 'Died during evaluation of evaulation code; Perl said: ' . $@ if $@; + my $invalid = &$validator($helper, $state, $self, $self->getValue()); + if ($invalid) { + $self->{ERROR_MSG} = $invalid; + return 0; + } + } + + if (defined($self->{'nextstate'})) { + $helper->changeState($self->{'nextstate'}); + } + + return 1; +} + +1; + package Apache::lonhelper::general; =pod @@ -2332,6 +2568,11 @@ tag. It goes through all the states and snippets and collecting the results. Finally, it takes the user out of the helper, going to a provided page. +If the parameter "restartCourse" is true, this will override the buttons and +will make a "Finish Helper" button that will re-initialize the course for them, +which is useful for the Course Initialization helper so the users never see +the old values taking effect. + =cut no strict; @@ -2348,7 +2589,17 @@ sub new { bless($ref); } -sub start_final { return ''; } +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)=@_; @@ -2389,13 +2640,13 @@ sub render { for my $element (@{$state->{ELEMENTS}}) { if (defined($element->{FINAL_CODE})) { # Compile the code. - my $code = 'sub { my $helper = shift; ' . $element->{FINAL_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); + my $result = &$code($helper, $element); if ($result) { push @results, $result; } @@ -2403,15 +2654,38 @@ sub render { } } - if (scalar(@results) == 0) { - return ''; - } + my $result; - my $result = "'; + + return $result; +} + +sub overrideForm { + my $self = shift; + return $self->{'restartCourse'}; } 1; @@ -2458,10 +2732,13 @@ sub render { # FIXME: Unify my designators with the standard ones my %dateTypeHash = ('open_date' => "Opening Date", 'due_date' => "Due Date", - 'answer_date' => "Answer Date"); + 'answer_date' => "Answer Date", + 'tries' => 'Number of Tries' + ); my %parmTypeHash = ('open_date' => "0_opendate", 'due_date' => "0_duedate", - 'answer_date' => "0_answerdate"); + 'answer_date' => "0_answerdate", + 'tries' => '0_maxtries' ); my $affectedResourceId = ""; my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; @@ -2481,7 +2758,7 @@ sub render { 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->getByMapPc($vars->{RESOURCE_ID}); my $title = $res->compTitle(); $symb = $res->symb(); $navmap->untieHashes(); @@ -2507,8 +2784,11 @@ sub render { $result .= '

Confirm that this information is correct, then click "Finish Wizard" to complete setting the parameter.