--- loncom/interface/lonparmset.pm 2016/10/16 21:49:51 1.568
+++ loncom/interface/lonparmset.pm 2023/04/03 19:53:30 1.619
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.568 2016/10/16 21:49:51 raeburn Exp $
+# $Id: lonparmset.pm,v 1.619 2023/04/03 19:53:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,7 +36,8 @@ lonparmset - Handler to set parameters f
=head1 SYNOPSIS
-lonparmset provides an interface to setting course parameters.
+lonparmset provides an interface to setting content parameters in a
+course.
It contains all the code for the "Content and Problem Settings" UI, except
for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
@@ -137,7 +138,7 @@ javascript function 'pjump'.
=item print_td()
-=item print_usergroups()
+=item check_other_groups()
=item parm_control_group()
@@ -328,6 +329,7 @@ use Apache::lonnavmaps;
use Apache::longroup;
use Apache::lonrss;
use HTML::Entities;
+use Text::Wrap();
use LONCAPA qw(:DEFAULT :match);
@@ -846,17 +848,36 @@ sub storeparm_by_symb_inner {
my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
my $storeunder='';
+ my $possreplace='';
if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
- if (($snum==17) || ($snum==3)) { $storeunder=$courseleveli; }
- if (($snum==16) || ($snum==2)) { $storeunder=$courselevelm; }
+ if (($snum==17) || ($snum==3)) {
+ $storeunder=$courseleveli;
+ $possreplace=$courselevelm;
+ }
+ if (($snum==16) || ($snum==2)) {
+ $storeunder=$courselevelm;
+ $possreplace=$courseleveli;
+ }
if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
if ($snum==12) { $storeunder=$seclevel; }
- if ($snum==11) { $storeunder=$secleveli; }
- if ($snum==10) { $storeunder=$seclevelm; }
+ if ($snum==11) {
+ $storeunder=$secleveli;
+ $possreplace=$seclevelm;
+ }
+ if ($snum==10) {
+ $storeunder=$seclevelm;
+ $possreplace=$secleveli;
+ }
if ($snum==9) { $storeunder=$seclevelr; }
if ($snum==8) { $storeunder=$grplevel; }
- if ($snum==7) { $storeunder=$grpleveli; }
- if ($snum==6) { $storeunder=$grplevelm; }
+ if ($snum==7) {
+ $storeunder=$grpleveli;
+ $possreplace=$grplevelm;
+ }
+ if ($snum==6) {
+ $storeunder=$grplevelm;
+ $possreplace=$grpleveli;
+ }
if ($snum==5) { $storeunder=$grplevelr; }
@@ -875,7 +896,7 @@ sub storeparm_by_symb_inner {
&Apache::lonnet::expirespread('','','studentcalc');
if (($snum==13) || ($snum==9) || ($snum==5)) {
&Apache::lonnet::expirespread('','','assesscalc',$symb);
- } elsif (($snum==14) || ($snum==10) || ($snum==6)) {
+ } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
&Apache::lonnet::expirespread('','','assesscalc',$map);
} else {
&Apache::lonnet::expirespread('','','assesscalc');
@@ -889,6 +910,17 @@ sub storeparm_by_symb_inner {
$reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,$cdom,$cnum);
&log_parmset(\%storecontent);
+ if ($possreplace) {
+ my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
+ if (ref($resdata) eq 'HASH') {
+ if (exists($resdata->{$possreplace})) {
+ if (&Apache::lonnet::del
+ ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
+ &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);
+ }
+ }
+ }
+ }
}
&Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
} else {
@@ -899,7 +931,7 @@ sub storeparm_by_symb_inner {
if ($snum==1) {
&Apache::lonnet::expirespread
($uname,$udom,'assesscalc',$symb);
- } elsif ($snum==2) {
+ } elsif (($snum==2) || ($snum==3)) {
&Apache::lonnet::expirespread
($uname,$udom,'assesscalc',$map);
} else {
@@ -914,6 +946,18 @@ sub storeparm_by_symb_inner {
$reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,$udom,$uname);
&log_parmset(\%storecontent,0,$uname,$udom);
+ if ($possreplace) {
+ my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
+ if (ref($resdata) eq 'HASH') {
+ if (exists($resdata->{$possreplace})) {
+ if (&Apache::lonnet::del
+ ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
+ &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
+ $uname,$udom);
+ }
+ }
+ }
+ }
}
&Apache::lonnet::devalidateuserresdata($uname,$udom);
}
@@ -933,10 +977,9 @@ sub storeparm_by_symb_inner {
#
# @param {string} $value - the parameter value
# @param {string} $type - the parameter type
-# @param {string} $name - the parameter name (unused)
# @param {boolean} $editable - Set to true to get an icon when no value is defined.
sub valout {
- my ($value,$type,$name,$editable)=@_;
+ my ($value,$type,$editable)=@_;
my $result = '';
# Values of zero are valid.
if (! $value && $value ne '0') {
@@ -1022,12 +1065,18 @@ sub valout {
# @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
# @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
# @param {string} $call - javascript function to call to submit the form ('psub')
+# @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
+# @param {string} $extra - optional additional information to send as tenth arg in call to javascript pjump function.
sub plink {
- my ($type,$dis,$value,$marker,$return,$call)=@_;
+ my ($type,$dis,$value,$marker,$return,$call,$recursive,$extra)=@_;
my $winvalue=$value;
unless ($winvalue) {
- if (&isdateparm($type)) {
+ if (&isdateparm($type) || (&is_specialstring($type))) {
$winvalue=$env{'form.recent_'.$type};
+ } elsif ($type eq 'string_yesno') {
+ if ($env{'form.recent_string'} =~ /^(yes|no)$/i) {
+ $winvalue=$env{'form.recent_string'};
+ }
} else {
$winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
}
@@ -1035,17 +1084,19 @@ sub plink {
my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
unless (defined($winvalue)) { $winvalue=$val; }
- my $valout = &valout($value,$type,$parmname,1);
+ my $valout = &valout($value,$type,1);
my $unencmarker = $marker;
foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
- \$hour, \$min, \$sec) {
+ \$hour, \$min, \$sec, \$extra) {
$$item = &HTML::Entities::encode($$item,'"<>&');
$$item =~ s/\'/\\\'/g;
}
return '
');
}
$r->print('');
$r->print("\n");
+ if (($numlinks) && (ref($reclinks))) {
+ $$reclinks = $numlinks;
+ }
}
# Prints a cell for table mode.
@@ -1535,15 +2011,41 @@ sub print_row {
# @param {hash reference} $display - parameter key -> full title for the parameter
# @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
# @param {boolean} $readonly -true if editing not allowed.
+# @param {boolean} $ismaplevel - true if level is for a map.
+# @param {string} $extra - extra information to pass to plink.
sub print_td {
- my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp,$readonly)=@_;
- $r->print('
');
my $nolink = 0;
if ($readonly) {
$nolink = 1;
} else {
- if ($which == 14 || $which == 15) {
+ if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
$nolink = 1;
} elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
$nolink = 1;
@@ -1552,9 +2054,7 @@ sub print_td {
$nolink = 1;
}
} elsif ($mprefix =~ /availablestudent\&$/) {
- if ($which > 4) {
- $nolink = 1;
- }
+ $nolink = 1;
} elsif ($mprefix =~ /examcode\&$/) {
unless ($which == 2) {
$nolink = 1;
@@ -1562,21 +2062,20 @@ sub print_td {
}
}
if ($nolink) {
- $r->print(&valout($$outpar[$which],$$typeoutpar[$which],$mprefix));
-# FIXME: probably a good thing that mprefix is not used in valout, because it does not look like a parameter name !
+ my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
+ $r->print(&valout($currval,$currtype));
} else {
- $r->print(&plink($$typeoutpar[$which],
- $$display{$value},$$outpar[$which],
- $mprefix."$which",'parmform.pres','psub'));
+ $r->print(&plink($currtype,
+ $$display{$value},$currval,
+ $mprefix.$currlevel,'parmform.pres','psub',$recursive,
+ $extra));
}
$r->print('
'."\n");
}
-# FIXME: Despite the name, this does not print anything, the $r parameter is unused.
# Returns HTML and other info for the cell added when a user is selected
# and that user is in several groups. This is the cell with the title "Control by other group".
#
-# @param {Apache2::RequestRec} $r - the Apache request (unused)
# @param {string} $what - parameter part.'.'.parameter name
# @param {string} $rid - resource id
# @param {string} $cgroup - group name
@@ -1584,9 +2083,9 @@ sub print_td {
# @param {array reference} $usersgroups - list of groups the user belongs to, if any
# @param {integer} $result - level
# @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
-# @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group)
-sub print_usergroups {
- my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
+# @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group, true if recursive)
+sub check_other_groups {
+ my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
my $courseid = $env{'request.course.id'};
my $output;
my $symb = &symbcache($rid);
@@ -1598,16 +2097,22 @@ sub print_usergroups {
&parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
$recurseparm,$what,$courseopt);
my $bgcolor = $defbg;
- my $grp_parm;
+ my ($grp_parm,$grp_is_rec);
if (($coursereply) && ($cgroup ne $resultgroup)) {
+ my ($parmname) = ($what =~ /\.([^.]+)$/);
if ($result > 3) {
$bgcolor = '#AAFFAA';
- $grp_parm = &valout($coursereply,$resulttype,$what);
}
- $grp_parm = &valout($coursereply,$resulttype,$what);
+ $grp_parm = &valout($coursereply,$resulttype);
$output = '
';
}
- return ($coursereply,$output,$grp_parm,$resultgroup);
+ return ($coursereply,$output,$grp_parm,$resultgroup,$grp_is_rec);
}
# Looks for a group with a defined parameter for given user and parameter.
-# Used by print_usergroups.
+# Used by check_other_groups.
#
# @param {string} $courseid - the course id
# @param {array reference} $usersgroups - list of groups the user belongs to, if any
@@ -1670,6 +2175,7 @@ sub parm_control_group {
# @param {hash reference} $uris - hash resource/map id -> resource src
# @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
# @param {hash reference} $defkeytype - hash parameter name -> parameter type
+# @param {string} $pssymb - resource symb (when a single resource is selected)
sub extractResourceInformation {
my $ids = shift;
my $typep = shift;
@@ -1683,11 +2189,22 @@ sub extractResourceInformation {
my $uris=shift;
my $keyorder=shift;
my $defkeytype=shift;
+ my $pssymb=shift;
my $keyordercnt=100;
my $navmap = Apache::lonnavmaps::navmap->new();
- my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
+ return unless(ref($navmap));
+ my @allres;
+ if ($pssymb ne '') {
+ my $res = $navmap->getBySymb($pssymb);
+ if (ref($res)) {
+ @allres = ($res);
+ }
+ }
+ if (!@allres) {
+ @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
+ }
foreach my $resource (@allres) {
my $id=$resource->id();
my ($mapid,$resid)=split(/\./,$id);
@@ -1696,23 +2213,27 @@ sub extractResourceInformation {
my $srcf=$resource->src();
$srcf=~/\.(\w+)$/;
$$typep{$id}=$1;
+ my $toolsymb;
+ if ($srcf =~ /ext\.tool$/) {
+ $toolsymb = $resource->symb();
+ }
$$keyp{$id}='';
$$uris{$id}=$srcf;
- foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
+ foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys',$toolsymb))) {
next if ($key!~/^parameter_/);
# Hidden parameters
- next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
+ next if (&Apache::lonnet::metadata($srcf,$key.'.hidden',$toolsymb) eq 'parm');
#
# allparms is a hash of parameter names
#
- my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
+ my $name=&Apache::lonnet::metadata($srcf,$key.'.name',$toolsymb);
if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
my ($display,$parmdis);
$display = &standard_parameter_names($name);
if ($display eq '') {
- $display= &Apache::lonnet::metadata($srcf,$key.'.display');
+ $display= &Apache::lonnet::metadata($srcf,$key.'.display',$toolsymb);
$parmdis = $display;
$parmdis =~ s/\s*\[Part.*$//g;
} else {
@@ -1721,14 +2242,14 @@ sub extractResourceInformation {
$$allparms{$name}=$parmdis;
if (ref($defkeytype)) {
$$defkeytype{$name}=
- &Apache::lonnet::metadata($srcf,$key.'.type');
+ &Apache::lonnet::metadata($srcf,$key.'.type',$toolsymb);
}
}
#
# allparts is a hash of all parts
#
- my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
+ my $part= &Apache::lonnet::metadata($srcf,$key.'.part',$toolsymb);
$$allparts{$part} = &mt('Part: [_1]',$part);
#
# Remember all keys going with this resource
@@ -1769,6 +2290,29 @@ sub extractResourceInformation {
}
}
+sub get_recursive {
+ my ($recurseup,$resdata,$what,$prefix) = @_;
+ if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
+ foreach my $item (@{$recurseup}) {
+ my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
+ if (defined($resdata->{$norecursechk})) {
+ if ($what =~ /\.(encrypturl|hiddenresource)$/) {
+ my $type = $resdata->{$norecursechk.'.type'};
+ return [$resdata->{$norecursechk},$type,$item];
+ } else {
+ last;
+ }
+ }
+ my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
+ if (defined($resdata->{$recursechk})) {
+ my $type = $resdata->{$recursechk.'.type'};
+ return [$resdata->{$recursechk},$type,$item];
+ }
+ }
+ }
+ return;
+}
+
# Tells if a parameter type is a date.
#
@@ -1779,16 +2323,19 @@ sub isdateparm {
return (($type=~/^date/) && (!($type eq 'date_interval')));
}
+# Determine if parameter type is specialized string type (i.e.,
+# not just string or string_yesno.
+
+sub is_specialstring {
+ my $type=shift;
+ return (($type=~/^string_/) && ($type ne 'string_yesno'));
+}
+
# Prints the HTML and Javascript to select parameters, with various shortcuts.
-# FIXME: remove unused parameters
#
-# @param {Apache2::RequestRec} $r - the Apache request (unused)
-# @param {hash reference} $allparms - hash parameter name -> parameter title
-# @param {array reference} $pscat - list of selected parameter names (unused)
-# @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
+# @param {Apache2::RequestRec} $r - the Apache request
sub parmmenu {
- my ($r,$allparms,$pscat,$keyorder)=@_;
- my $tempkey;
+ my ($r)=@_;
$r->print(<
// print('');
- &shortCuts($r,$allparms,$pscat,$keyorder);
+ &shortCuts($r);
$r->print('');
}
@@ -1919,6 +2466,7 @@ sub lookUpTableParameter {
'buttonshide' => 'hiding',
'turnoffeditor' => 'hiding',
'encrypturl' => 'hiding',
+ 'deeplink' => 'hiding',
'randomorder' => 'high_level_randomization',
'randompick' => 'high_level_randomization',
'available' => 'slots',
@@ -1934,8 +2482,8 @@ sub lookUpTableParameter {
'lenient' => 'grading',
'retrypartial' => 'tries',
'discussvote' => 'misc',
- 'examcode' => 'high_level_randomization',
- );
+ 'examcode' => 'high_level_randomization',
+ );
}
# Adds the given parameter name to an array of arrays listing all parameters for each category.
@@ -2023,20 +2571,24 @@ sub parmboxes {
&whatIsMyCategory($tempparameter, \%categoryList);
}
#part to print the parm-list
+ $Text::Wrap::columns=60;
+ $Text::Wrap::separator=' ';
foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
next if (@{$categoryList{$key}} == 0);
next if ($key eq '');
$r->print('
'
.'
'.&mt($categories{$key}).'
'."\n");
foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
+ next if ($tempkey eq '');
$r->print(''
.' '."\n");
}
$r->print('
');
@@ -2045,14 +2597,10 @@ sub parmboxes {
}
# Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
-# FIXME: remove unused parameters
#
# @param {Apache2::RequestRec} $r - the Apache request
-# @param {hash reference} $allparms - hash parameter name -> parameter title (unused)
-# @param {array reference} $pscat - list of selected parameter names (unused)
-# @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
sub shortCuts {
- my ($r,$allparms,$pscat,$keyorder)=@_;
+ my ($r)=@_;
# Parameter Selection
$r->print(
@@ -2131,9 +2679,37 @@ sub partmenu {
sub usermenu {
my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
- &Apache::loncommon::selectstudent_link('parmform','uname','udom');
- my $selscript=&Apache::loncommon::studentbrowser_javascript();
+ &Apache::loncommon::selectstudent_link('parmform','uname','udom','condition').
+ &Apache::lonhtmlcommon::scripttag(<'.
+ $stuonly.' '.
+ '';
my $sections='';
my %sectionhash = &Apache::loncommon::get_sections();
@@ -2142,7 +2718,7 @@ sub usermenu {
if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
%grouphash = &Apache::longroup::coursegroups();
} elsif ($env{'request.course.groups'} ne '') {
- map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
+ map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
}
my $g_s_header='';
@@ -2200,7 +2776,7 @@ function group_or_section(caller) {
}
if (%grouphash) {
- $groups=&mt('Group:').'