[LON-CAPA-cvs] cvs: loncom /interface lonparmset.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 10 Jan 2006 05:28:01 -0000
This is a MIME encoded message
--raeburn1136870881
Content-Type: text/plain
raeburn Tue Jan 10 00:28:01 2006 EDT
Modified files:
/loncom/interface lonparmset.pm
/loncom/lonnet/perl lonnet.pm
Log:
Cascading parameters within groups, for the case where a user is in more than one group. For now default is for first group in lexical sort of group names to take precedence. Future plan is to allow rank to be set by CC (lonnet::sort_cours_groups() will retrieve and apply ranks).
--raeburn1136870881
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060110002801.txt"
Index: loncom/interface/lonparmset.pm
diff -u loncom/interface/lonparmset.pm:1.274 loncom/interface/lonparmset.pm:1.275
--- loncom/interface/lonparmset.pm:1.274 Thu Dec 29 12:58:13 2005
+++ loncom/interface/lonparmset.pm Tue Jan 10 00:27:57 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.274 2005/12/29 17:58:13 albertel Exp $
+# $Id: lonparmset.pm,v 1.275 2006/01/10 05:27:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -109,20 +109,18 @@
##################################################
sub parmval {
- my ($what,$id,$def,$uname,$udom,$csec,$cgroup)=@_;
- return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,$cgroup);
+ my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
+ return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
+ $cgroup,$courseopt);
}
sub parmval_by_symb {
- my ($what,$symb,$def,$uname,$udom,$csec,$cgroup)=@_;
+ my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
# load caches
&cacheparmhash();
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
- my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
my $result='';
my @outpar=();
@@ -187,7 +185,7 @@
$result=7;
}
}
-# ------------------------------------------------------ fifth, check gourse group
+# ------------------------------------------------------ fifth, check course group
if (defined($cgroup)) {
if (defined($$courseopt{$grplevel})) {
$outpar[6]=$$courseopt{$grplevel};
@@ -310,7 +308,7 @@
sub storeparm {
my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
- &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
+ &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
}
#
@@ -327,7 +325,7 @@
my %recstack;
sub storeparm_by_symb {
- my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup,$recflag)=@_;
+ my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
unless ($recflag) {
# first time call
%recstack=();
@@ -370,7 +368,7 @@
}
if ($active) {
&storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
- $uname,$udom,$csec,$cgroup,$recflag);
+ $uname,$udom,$csec,$recflag,$cgroup);
}
}
}
@@ -632,16 +630,19 @@
sub print_row {
my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
- $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup)=@_;
+ $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups)=@_;
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
# get the values for the parameter in cascading order
# empty levels will remain empty
my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
- $rid,$$default{$which},$uname,$udom,$csec,$cgroup);
+ $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
# get the type for the parameters
# problem: these may not be set for all levels
my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
- $$name{$which}.'.type',
- $rid,$$defaulttype{$which},$uname,$udom,$csec,$cgroup);
+ $$name{$which}.'.type',$rid,
+ $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
# cascade down manually
my $cascadetype=$$defaulttype{$which};
for (my $i=14;$i>0;$i--) {
@@ -668,6 +669,8 @@
my $thismarker=$which;
$thismarker=~s/^parameter\_//;
my $mprefix=$rid.'&'.$thismarker.'&';
+ my $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
+ my ($othergrp,$grp_parm,$controlgrp);
if ($parmlev eq 'general') {
@@ -692,6 +695,22 @@
&print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
}
} else {
+ if ($uname) {
+ if (@{$usersgroups} > 1) {
+ my ($coursereply,$grp_parm,$controlgrp);
+ ($coursereply,$othergrp,$grp_parm,$controlgrp) =
+ &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
+ $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
+ if ($coursereply && $result > 3) {
+ if (defined($controlgrp)) {
+ if ($cgroup ne $controlgrp) {
+ $effective_parm = $grp_parm;
+ $result = 0;
+ }
+ }
+ }
+ }
+ }
&print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
@@ -711,24 +730,25 @@
&print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,4,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
}
-
+
if ($uname) {
+ if ($othergrp) {
+ $r->print($othergrp);
+ }
&print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
}
} # end of $parmlev if/else
-
- $r->print('<td bgcolor=#CCCCFF align="center">'.
- &valout($outpar[$result],$typeoutpar[$result]).'</td>');
+ $r->print('<td bgcolor="#CCCCFF" align="center">'.$effective_parm.'</td>');
if ($parmlev eq 'full') {
my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
'.'.$$name{$which},$$symbp{$rid});
my $sessionvaltype=$typeoutpar[$result];
if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
- $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
+ $r->print('<td bgcolor="#999999" align="center"><font color="#FFFFFF">'.
&valout($sessionval,$sessionvaltype).' '.
'</font></td>');
}
@@ -750,6 +770,61 @@
$r->print('</td>'."\n");
}
+sub print_usergroups {
+ my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
+ my $courseid = $env{'request.course.id'};
+ my $output;
+ my $symb = &symbcache($rid);
+ my $symbparm=$symb.'.'.$what;
+ my $map=(&Apache::lonnet::decode_symb($symb))[0];
+ my $mapparm=$map.'___(all).'.$what;
+ my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
+ &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,$what,
+ $courseopt);
+ my $bgcolor = $defbg;
+ my $grp_parm;
+ if (($coursereply) && ($cgroup ne $resultgroup)) {
+ if ($result > 3) {
+ $bgcolor = '"#AAFFAA"';
+ $grp_parm = &valout($coursereply,$resulttype);
+ }
+ $grp_parm = &valout($coursereply,$resulttype);
+ $output = '<td bgcolor='.$bgcolor.' align="center">';
+ if ($resultgroup && $resultlevel) {
+ $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
+ } else {
+ $output .= ' ';
+ }
+ $output .= '</td>';
+ } else {
+ $output .= '<td bgcolor='.$bgcolor.'> </td>';
+ }
+ return ($coursereply,$output,$grp_parm,$resultgroup);
+}
+
+sub parm_control_group {
+ my ($courseid,$usersgroups,$symbparm,$mapparm,$what,$courseopt) = @_;
+ my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
+ my $grpfound = 0;
+ my @levels = ($symbparm,$mapparm,$what);
+ my @levelnames = ('resource','map/folder','general');
+ foreach my $group (@{$usersgroups}) {
+ if ($grpfound) { last; }
+ for (my $i=0; $i<@levels; $i++) {
+ my $item = $courseid.'.['.$group.'].'.$levels[$i];
+ if (defined($$courseopt{$item})) {
+ $coursereply = $$courseopt{$item};
+ $resultitem = $item;
+ $resultgroup = $group;
+ $resultlevel = $levelnames[$i];
+ $resulttype = $$courseopt{$item.'.type'};
+ $grpfound = 1;
+ last;
+ }
+ }
+ }
+ return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
+}
=pod
@@ -997,7 +1072,7 @@
}
sub usermenu {
- my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev)=@_;
+ my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups)=@_;
my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
&Apache::loncommon::selectstudent_link('parmform','uname','udom');
my $selscript=&Apache::loncommon::studentbrowser_javascript();
@@ -1026,9 +1101,10 @@
$sections .= qq| onchange="group_or_section('csec')" |;
}
$sections .= '>';
- foreach ('',sort keys %sectionhash) {
- $sections.='<option value="'.$_.'"'.
- ($_ eq $csec?'selected="selected"':'').'>'.$_.'</option>';
+ foreach my $section ('',sort keys %sectionhash) {
+ $sections.='<option value="'.$section.'" '.
+ ($section eq $csec?'selected="selected"':'').'>'.$section.
+ '</option>';
}
$sections.='</select>';
}
@@ -1064,10 +1140,20 @@
$groups .= qq| onchange="group_or_section('cgroup')" |;
}
$groups .= '>';
- foreach ('',sort keys %grouphash) {
- $groups.='<option value="'.$_.'"'.
- ($_ eq $cgroup?'selected="selected"':'').'>'.
- $_.'</option>';
+ foreach my $grp ('',sort keys %grouphash) {
+ $groups.='<option value="'.$grp.'" ';
+ if ($grp eq $cgroup) {
+ unless ((defined($uname)) && ($grp eq '')) {
+ $groups .= 'selected="selected" ';
+ }
+ } elsif (!defined($cgroup)) {
+ if (@{$usersgroups} == 1) {
+ if ($grp eq $$usersgroups[0]) {
+ $groups .= 'selected="selected" ';
+ }
+ }
+ }
+ $groups .= '>'.$grp.'</option>';
}
$groups.='</select>';
}
@@ -1294,6 +1380,8 @@
my $uhome;
my $csec;
my $cgroup;
+ my $grouplist;
+ my @usersgroups = ();
my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
@@ -1398,12 +1486,16 @@
.$name{'lastname'}.' '.$name{'generation'}.
"<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
}
- my $grouplist = &Apache::lonnet::get_users_groups(
- $udom,$uname,$env{'request.course.id'});
+ $grouplist = &Apache::lonnet::get_users_groups(
+ $udom,$uname,$env{'request.course.id'});
if ($grouplist) {
- my @groups = split(/:/,$grouplist);
- @groups = sort(@groups);
- $cgroup = $groups[0];
+ @usersgroups = &Apache::lonnet::sort_course_groups($grouplist,
+ $env{'request.course.id'});
+ unless (grep/^\Q$cgroup\E$/,@usersgroups) {
+ $cgroup = $usersgroups[0];
+ }
+ } else {
+ $cgroup = '';
}
}
}
@@ -1464,7 +1556,7 @@
'<br /><label><b>'.&mt('Show all parts').': <input type="checkbox" name="psprt" value="all"'.
($env{'form.psprt'}?' checked="checked"':'').' /></b></label><br />');
}
- &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev);
+ &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
$r->print('<p>'.$message.'</p>');
@@ -1486,6 +1578,7 @@
if ($parmlev eq 'full') {
my $coursespan=$csec?8:5;
+ my $userspan=3;
if ($cgroup ne '') {
$coursespan += 3;
}
@@ -1494,7 +1587,10 @@
$r->print('<tr><td colspan=5></td>');
$r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
if ($uname) {
- $r->print("<th colspan=3 rowspan=2>");
+ if (@usersgroups > 1) {
+ $userspan ++;
+ }
+ $r->print('<th colspan="'.$userspan.'" rowspan="2">');
$r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
}
my %lt=&Apache::lonlocal::texthash(
@@ -1545,6 +1641,9 @@
}
if ($uname) {
+ if (@usersgroups > 1) {
+ $r->print('<th>'.&mt('Control by other group?').'</th>');
+ }
$r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
}
@@ -1638,7 +1737,7 @@
&print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
\%type,\%display,$defbgone,$defbgtwo,
$defbgthree,$parmlev,$uname,$udom,$csec,
- $cgroup);
+ $cgroup,\@usersgroups);
}
}
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.690 loncom/lonnet/perl/lonnet.pm:1.691
--- loncom/lonnet/perl/lonnet.pm:1.690 Fri Jan 6 19:25:23 2006
+++ loncom/lonnet/perl/lonnet.pm Tue Jan 10 00:28:00 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.690 2006/01/07 00:25:23 albertel Exp $
+# $Id: lonnet.pm,v 1.691 2006/01/10 05:28:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4823,7 +4823,7 @@
return $env{'course.'.$courseid.'.'.$spacequalifierrest};
} elsif ($realm eq 'resource') {
- my ($section,$group);
+ my $section;
my @groups = ();
if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
if (!$symbparm) { $symbparm=&symbread(); }
@@ -4844,10 +4844,9 @@
if (($env{'user.name'} eq $uname) &&
($env{'user.domain'} eq $udom)) {
$section=$env{'request.course.sec'};
- @groups=split(/:/,$env{'request.course.groups'});
+ @groups=&sort_course_groups($env{'request.course.groups'},$courseid);
if (@groups > 0) {
@groups = sort(@groups);
- $group = $groups[0];
}
} else {
if (! defined($usection)) {
@@ -4857,16 +4856,10 @@
}
my $grouplist = &get_users_groups($udom,$uname,$courseid);
if ($grouplist) {
- @groups = split(/:/,$grouplist);
- @groups = sort(@groups);
- $group = $groups[0];
+ @groups=&sort_course_groups($grouplist,$courseid);
}
}
- my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest;
- my $grplevelr=$courseid.'.['.$group.'].'.$symbparm;
- my $grplevelm=$courseid.'.['.$group.'].'.$mapparm;
-
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
@@ -4880,17 +4873,13 @@
my $userreply=&resdata($uname,$udom,'user',
($courselevelr,$courselevelm,
$courselevel));
-
if (defined($userreply)) { return $userreply; }
# ------------------------------------------------ second, check some of course
my $coursereply;
- if (defined($group)) {
- $coursereply = &resdata($env{'course.'.$courseid.'.num'},
- $env{'course.'.$courseid.'.domain'},
- 'course',
- ($grplevelr,$grplevelm,$grplevel,
- $courselevelr));
+ if (@groups > 0) {
+ $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
+ $mapparm,$spacequalifierrest);
if (defined($coursereply)) { return $coursereply; }
}
@@ -4969,6 +4958,32 @@
return '';
}
+sub check_group_parms {
+ my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
+ my @groupitems = ();
+ my $resultitem;
+ my @levels = ($symbparm,$mapparm,$what);
+ foreach my $group (@{$groups}) {
+ foreach my $level (@levels) {
+ my $item = $courseid.'.['.$group.'].'.$level;
+ push(@groupitems,$item);
+ }
+ }
+ my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+ $env{'course.'.$courseid.'.domain'},
+ 'course',@groupitems);
+ return $coursereply;
+}
+
+sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
+ my ($grouplist,$courseid) = @_;
+ my @groups = split/:/,$grouplist;
+ if (@groups > 1) {
+ @groups = sort(@groups);
+ }
+ return @groups;
+}
+
sub packages_tab_default {
my ($uri,$varname)=@_;
my (undef,$part,$name)=split(/\./,$varname);
--raeburn1136870881--