--- loncom/interface/lonparmset.pm 2005/11/22 02:24:50 1.269
+++ loncom/interface/lonparmset.pm 2006/04/17 21:28:50 1.291
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.269 2005/11/22 02:24:50 raeburn Exp $
+# $Id: lonparmset.pm,v 1.291 2006/04/17 21:28:50 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -109,20 +109,18 @@ Returns: A list, the first item is the
##################################################
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 @@ sub parmval_by_symb {
$result=7;
}
}
-# ------------------------------------------------------ fifth, check gourse group
+# ------------------------------------------------------ fifth, check course group
if (defined($cgroup)) {
if (defined($$courseopt{$grplevel})) {
$outpar[6]=$$courseopt{$grplevel};
@@ -295,6 +293,25 @@ sub preset_defaults {
}
##################################################
+
+sub date_sanity_info {
+ my $checkdate=shift;
+ unless ($checkdate) { return ''; }
+ my $result='';
+ my $crsprefix='course.'.$env{'request.course.id'}.'.';
+ if ($env{$crsprefix.'default_enrollment_end_date'}) {
+ if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
+ $result.=' '.&mt('After course enrollment end!');
+ }
+ }
+ if ($env{$crsprefix.'default_enrollment_start_date'}) {
+ if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
+ $result.=' '.&mt('Before course enrollment start!');
+ }
+ }
+ return $result;
+}
+##################################################
##################################################
#
# Store a parameter by ID
@@ -310,7 +327,7 @@ sub preset_defaults {
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 +344,7 @@ sub storeparm {
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,13 +387,39 @@ sub storeparm_by_symb {
}
if ($active) {
&storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
- $uname,$udom,$csec,$cgroup,$recflag);
+ $uname,$udom,$csec,$recflag,$cgroup);
}
}
}
return '';
}
+{
+ my $logid;
+ sub log_parmset {
+ my ($storehash,$delflag,$uname,$udom)=@_;
+ my $logentry=join(',',map {
+ &Apache::lonnet::escape($_).'=>'.&Apache::lonnet::escape($$storehash{$_});
+ } keys %$storehash);
+ $logid++;
+ my $id=time().'00000'.$$.'00000'.$logid;
+ &Apache::lonnet::put('nohist_parameterlog',
+ {
+ $id.'_exe_uname' => $env{'user.name'},
+ $id.'_exe_udom' => $env{'user.domain'},
+ $id.'_exe_time' => time(),
+ $id.'_exe_ip' => $ENV{'REMOTE_ADDR'},
+ $id.'_delflag' => $delflag,
+ $id.'_logentry' => $logentry,
+ $id.'_uname' => $uname,
+ $id.'_udom' => $udom,
+ },
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'}
+ );
+ }
+}
+
sub storeparm_by_symb_inner {
# ---------------------------------------------------------- Get symb, map, etc
my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
@@ -433,9 +476,11 @@ sub storeparm_by_symb_inner {
if ($delete) {
$reply=&Apache::lonnet::del
('resourcedata',[keys(%storecontent)],$cdom,$cnum);
+ &log_parmset(\%storecontent,1);
} else {
$reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,$cdom,$cnum);
+ &log_parmset(\%storecontent);
}
&Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
} else {
@@ -456,9 +501,11 @@ sub storeparm_by_symb_inner {
if ($delete) {
$reply=&Apache::lonnet::del
('resourcedata',[keys(%storecontent)],$udom,$uname);
+ &log_parmset(\%storecontent,1,$uname,$udom);
} else {
$reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,$udom,$uname);
+ &log_parmset(\%storecontent,0,$uname,$udom);
}
&Apache::lonnet::devalidateuserresdata($uname,$udom);
}
@@ -518,7 +565,7 @@ sub valout {
}
$result=~s/\s+$//;
} elsif (&isdateparm($type)) {
- $result = localtime($value);
+ $result = localtime($value).&date_sanity_info($value);
} else {
$result = $value;
}
@@ -557,26 +604,19 @@ sub plink {
my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
unless (defined($winvalue)) { $winvalue=$val; }
- return
+ return '
';
}
-sub startpage {
- my $r=shift;
- my $loaditems = qq|onUnload="pclose()" onLoad="group_or_section('cgroup')"|;
- my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
- $loaditems);
- my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table Mode Parameter Setting');
+sub page_js {
+
my $selscript=&Apache::loncommon::studentbrowser_javascript();
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
- my $html=&Apache::lonxml::xmlbegin();
- $r->print(<
-LON-CAPA Course Parameters
-
$selscript
-
-$bodytag
+ENDJS
+
+}
+sub startpage {
+ my ($r) = @_;
+
+ my %loaditems = ('onunload' => "pclose()",
+ 'onload' => "group_or_section('cgroup')",);
+
+ my $start_page =
+ &Apache::loncommon::start_page('Set/Modify Course Parameters',
+ &page_js(),
+ {'add_entries' => \%loaditems,});
+ my $breadcrumbs =
+ &Apache::lonhtmlcommon::breadcrumbs(undef,
+ 'Table Mode Parameter Setting');
+ $r->print(<
-
-
-
-
+
+
+
+
ENDHEAD
}
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 +727,8 @@ sub print_row {
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 +753,22 @@ sub print_row {
&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 +788,25 @@ sub print_row {
&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(''.
- &valout($outpar[$result],$typeoutpar[$result]).' ');
+ $r->print(''.$effective_parm.' ');
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(''.
+ $r->print(' '.
&valout($sessionval,$sessionvaltype).' '.
' ');
}
@@ -750,6 +828,61 @@ sub print_td {
$r->print(''."\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 = '';
+ if ($resultgroup && $resultlevel) {
+ $output .= ''.$resultgroup.' ('.$resultlevel.'): '.$grp_parm;
+ } else {
+ $output .= ' ';
+ }
+ $output .= ' ';
+ } else {
+ $output .= ' ';
+ }
+ 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 +1130,7 @@ sub partmenu {
}
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 +1159,10 @@ sub usermenu {
$sections .= qq| onchange="group_or_section('csec')" |;
}
$sections .= '>';
- foreach ('',sort keys %sectionhash) {
- $sections.=''.$_.' ';
+ foreach my $section ('',sort keys %sectionhash) {
+ $sections.=''.$section.
+ ' ';
}
$sections.='';
}
@@ -1064,10 +1198,20 @@ function group_or_section(caller) {
$groups .= qq| onchange="group_or_section('cgroup')" |;
}
$groups .= '>';
- foreach ('',sort keys %grouphash) {
- $groups.=''.
- $_.' ';
+ foreach my $grp ('',sort keys %grouphash) {
+ $groups.='';
}
$groups.='';
}
@@ -1294,6 +1438,8 @@ sub assessparms {
my $uhome;
my $csec;
my $cgroup;
+ my $grouplist;
+ my @usersgroups = ();
my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
@@ -1398,12 +1544,16 @@ sub assessparms {
.$name{'lastname'}.' '.$name{'generation'}.
" \n".&mt('ID').": ".$name{'id'}.'';
}
- 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 +1614,7 @@ sub assessparms {
''.&mt('Show all parts').': ');
}
- &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev);
+ &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
$r->print('
'.$message.'
');
@@ -1486,6 +1636,7 @@ sub assessparms {
if ($parmlev eq 'full') {
my $coursespan=$csec?8:5;
+ my $userspan=3;
if ($cgroup ne '') {
$coursespan += 3;
}
@@ -1494,7 +1645,10 @@ sub assessparms {
$r->print(' ');
$r->print(''.&mt('Any User').' ');
if ($uname) {
- $r->print("");
+ if (@usersgroups > 1) {
+ $userspan ++;
+ }
+ $r->print(' ');
$r->print(&mt("User")." $uname ".&mt('at Domain')." $udom ");
}
my %lt=&Apache::lonlocal::texthash(
@@ -1545,6 +1699,9 @@ ENDTABLEHEADFOUR
}
if ($uname) {
+ if (@usersgroups > 1) {
+ $r->print(''.&mt('Control by other group?').' ');
+ }
$r->print(''.&mt('general').' '.&mt('for Enclosing Map or Folder').' '.&mt('for Resource').' ');
}
@@ -1605,14 +1762,15 @@ ENDTABLEHEADFOUR
my $totalparms=scalar keys %name;
if ($totalparms>0) {
my $firstrow=1;
- my $title=&Apache::lonnet::gettitle($uri);
+ my $title=&Apache::lonnet::gettitle($symbp{$rid});
$r->print(''.
join(' / ',split(/\//,$uri)).
' '.
"$title");
@@ -1637,7 +1795,7 @@ ENDTABLEHEADFOUR
&print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
\%type,\%display,$defbgone,$defbgtwo,
$defbgthree,$parmlev,$uname,$udom,$csec,
- $cgroup);
+ $cgroup,\@usersgroups);
}
}
}
@@ -1828,7 +1986,7 @@ ENDMAPONE
$r->print("");
} # end of $parmlev eq general
}
- $r->print('