--- loncom/interface/lonparmset.pm 2004/11/24 14:57:07 1.178
+++ loncom/interface/lonparmset.pm 2005/06/03 19:16:25 1.205
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.178 2004/11/24 14:57:07 raeburn Exp $
+# $Id: lonparmset.pm,v 1.205 2005/06/03 19:16:25 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -62,24 +62,16 @@ use GDBM_File;
use Apache::lonhomework;
use Apache::lonxml;
use Apache::lonlocal;
+use Apache::lonnavmaps;
-my %courseopt;
-my %useropt;
+# --- Caches local to lonparmset
+
+my $parmhashid;
my %parmhash;
+my $symbsid;
+my %symbs;
-my @ids;
-my %symbp;
-my %mapp;
-my %typep;
-my %keyp;
-
-my %maptitles;
-
-my $uname;
-my $udom;
-my $uhome;
-my $csec;
-my $coursename;
+# --- end local caches
##################################################
##################################################
@@ -96,10 +88,10 @@ Inputs: $what - a parameter spec (inclu
Returns: A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 11 possible levels
-11- resource default
-10- map default
-9 - General Course
-8 - Map or Folder level in course
+11 - General Course
+10 - Map or Folder level in course
+9- resource default
+8- map default
7 - resource level in course
6 - General for section
5 - Map or Folder level for section
@@ -111,87 +103,258 @@ Returns: A list, the first item is the
=cut
##################################################
-##################################################
sub parmval {
- my ($what,$id,$def)=@_;
+ my ($what,$id,$def,$uname,$udom,$csec)=@_;
+ return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec);
+}
+
+sub parmval_by_symb {
+ my ($what,$symb,$def,$uname,$udom,$csec)=@_;
+# 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=();
# ----------------------------------------------------- Cascading lookup scheme
+ my $map=(&Apache::lonnet::decode_symb($symb))[0];
- my $symbparm=$symbp{$id}.'.'.$what;
- my $mapparm=$mapp{$id}.'___(all).'.$what;
+ my $symbparm=$symb.'.'.$what;
+ my $mapparm=$map.'___(all).'.$what;
- my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
- my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
- my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
+ my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
+ my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
+ my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
- my $courselevel=$ENV{'request.course.id'}.'.'.$what;
- my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
- my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
+ my $courselevel=$env{'request.course.id'}.'.'.$what;
+ my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
+ my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
-# -------------------------------------------------------- first, check default
- if (defined($def)) { $outpar[11]=$def; $result=11; }
-# ----------------------------------------------------- second, check map parms
+# --------------------------------------------------------- first, check course
- my $thisparm=$parmhash{$symbparm};
- if (defined($thisparm)) { $outpar[10]=$thisparm; $result=10; }
-
-# --------------------------------------------------------- third, check course
-
- if (defined($courseopt{$courselevel})) {
- $outpar[9]=$courseopt{$courselevel};
- $result=9;
+ if (defined($$courseopt{$courselevel})) {
+ $outpar[11]=$$courseopt{$courselevel};
+ $result=11;
}
- if (defined($courseopt{$courselevelm})) {
- $outpar[8]=$courseopt{$courselevelm};
- $result=8;
+ if (defined($$courseopt{$courselevelm})) {
+ $outpar[10]=$$courseopt{$courselevelm};
+ $result=10;
}
- if (defined($courseopt{$courselevelr})) {
- $outpar[7]=$courseopt{$courselevelr};
+# ------------------------------------------------------- second, check default
+
+ if (defined($def)) { $outpar[9]=$def; $result=9; }
+
+# ------------------------------------------------------ third, check map parms
+
+ my $thisparm=$parmhash{$symbparm};
+ if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
+
+ if (defined($$courseopt{$courselevelr})) {
+ $outpar[7]=$$courseopt{$courselevelr};
$result=7;
}
+# ------------------------------------------------------ fourth, back to course
if (defined($csec)) {
- if (defined($courseopt{$seclevel})) {
- $outpar[6]=$courseopt{$seclevel};
+ if (defined($$courseopt{$seclevel})) {
+ $outpar[6]=$$courseopt{$seclevel};
$result=6;
}
- if (defined($courseopt{$seclevelm})) {
- $outpar[5]=$courseopt{$seclevelm};
+ if (defined($$courseopt{$seclevelm})) {
+ $outpar[5]=$$courseopt{$seclevelm};
$result=5;
}
- if (defined($courseopt{$seclevelr})) {
- $outpar[4]=$courseopt{$seclevelr};
+ if (defined($$courseopt{$seclevelr})) {
+ $outpar[4]=$$courseopt{$seclevelr};
$result=4;
}
}
-# ---------------------------------------------------------- fourth, check user
+# ---------------------------------------------------------- fifth, check user
if (defined($uname)) {
- if (defined($useropt{$courselevel})) {
- $outpar[3]=$useropt{$courselevel};
+ if (defined($$useropt{$courselevel})) {
+ $outpar[3]=$$useropt{$courselevel};
$result=3;
}
- if (defined($useropt{$courselevelm})) {
- $outpar[2]=$useropt{$courselevelm};
+ if (defined($$useropt{$courselevelm})) {
+ $outpar[2]=$$useropt{$courselevelm};
$result=2;
}
- if (defined($useropt{$courselevelr})) {
- $outpar[1]=$useropt{$courselevelr};
+ if (defined($$useropt{$courselevelr})) {
+ $outpar[1]=$$useropt{$courselevelr};
$result=1;
}
}
return ($result,@outpar);
}
+sub resetparmhash {
+ $parmhashid='';
+}
+
+sub cacheparmhash {
+ if ($parmhashid eq $env{'request.course.fn'}) { return; }
+ my %parmhashfile;
+ if (tie(%parmhashfile,'GDBM_File',
+ $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
+ %parmhash=%parmhashfile;
+ untie %parmhashfile;
+ $parmhashid=$env{'request.course.fn'};
+ }
+}
+
+sub resetsymbcache {
+ $symbsid='';
+}
+
+sub symbcache {
+ my $id=shift;
+ if ($symbsid ne $env{'request.course.id'}) {
+ %symbs=();
+ }
+ unless ($symbs{$id}) {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if ($id=~/\./) {
+ my $resource=$navmap->getById($id);
+ $symbs{$id}=$resource->symb();
+ } else {
+ my $resource=$navmap->getByMapPc($id);
+ $symbs{$id}=&Apache::lonnet::declutter($resource->src());
+ }
+ $symbsid=$env{'request.course.id'};
+ }
+ return $symbs{$id};
+}
+
+##################################################
+##################################################
+#
+# Store a parameter by ID
+#
+# Takes
+# - resource id
+# - name of parameter
+# - level
+# - new value
+# - new type
+# - username
+# - userdomain
+
+sub storeparm {
+ my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
+ &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
+}
+
+#
+# Store a parameter by symb
+#
+# Takes
+# - symb
+# - name of parameter
+# - level
+# - new value
+# - new type
+# - username
+# - userdomain
+
+sub storeparm_by_symb {
+# ---------------------------------------------------------- Get symb, map, etc
+ my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
+# ---------------------------------------------------------- Construct prefixes
+ $spnam=~s/\_([^\_]+)$/\.$1/;
+ my $map=(&Apache::lonnet::decode_symb($symb))[0];
+ my $symbparm=$symb.'.'.$spnam;
+ my $mapparm=$map.'___(all).'.$spnam;
+
+ my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
+ my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
+ my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
+
+ my $courselevel=$env{'request.course.id'}.'.'.$spnam;
+ my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
+ my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
+
+ my $storeunder='';
+ if (($snum==11) || ($snum==3)) { $storeunder=$courselevel; }
+ if (($snum==10) || ($snum==2)) { $storeunder=$courselevelm; }
+ if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
+ if ($snum==6) { $storeunder=$seclevel; }
+ if ($snum==5) { $storeunder=$seclevelm; }
+ if ($snum==4) { $storeunder=$seclevelr; }
+
+ my $delete;
+ if ($nval eq '') { $delete=1;}
+ my %storecontent = ($storeunder => $nval,
+ $storeunder.'.type' => $ntype);
+ my $reply='';
+ if ($snum>3) {
+# ---------------------------------------------------------------- Store Course
+#
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+# Expire sheets
+ &Apache::lonnet::expirespread('','','studentcalc');
+ if (($snum==7) || ($snum==4)) {
+ &Apache::lonnet::expirespread('','','assesscalc',$symb);
+ } elsif (($snum==8) || ($snum==5)) {
+ &Apache::lonnet::expirespread('','','assesscalc',$map);
+ } else {
+ &Apache::lonnet::expirespread('','','assesscalc');
+ }
+# Store parameter
+ if ($delete) {
+ $reply=&Apache::lonnet::del
+ ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
+ } else {
+ $reply=&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$cdom,$cnum);
+ }
+ &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
+ } else {
+# ------------------------------------------------------------------ Store User
+#
+# Expire sheets
+ &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
+ if ($snum==1) {
+ &Apache::lonnet::expirespread
+ ($uname,$udom,'assesscalc',$symb);
+ } elsif ($snum==2) {
+ &Apache::lonnet::expirespread
+ ($uname,$udom,'assesscalc',$map);
+ } else {
+ &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
+ }
+# Store parameter
+ if ($delete) {
+ $reply=&Apache::lonnet::del
+ ('resourcedata',[keys(%storecontent)],$udom,$uname);
+ } else {
+ $reply=&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$udom,$uname);
+ }
+ &Apache::lonnet::devalidateuserresdata($uname,$udom);
+ }
+
+ if ($reply=~/^error\:(.*)/) {
+ return "Write Error: $1";
+ }
+ return '';
+}
+
##################################################
##################################################
@@ -272,9 +435,9 @@ sub plink {
my $winvalue=$value;
unless ($winvalue) {
if ($type=~/^date/) {
- $winvalue=$ENV{'form.recent_'.$type};
+ $winvalue=$env{'form.recent_'.$type};
} else {
- $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
+ $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
}
}
return
@@ -283,34 +446,26 @@ sub plink {
&valout($value,$type).'';
}
-
sub startpage {
- my ($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader)=@_;
+ my ($r,$id,$udom,$csec,$uname,$have_assessments)=@_;
my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
'onUnload="pclose()"');
+ my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table Mode Parameter Setting');
my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
&Apache::loncommon::selectstudent_link('parmform','uname','udom');
my $selscript=&Apache::loncommon::studentbrowser_javascript();
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my %lt=&Apache::lonlocal::texthash(
- 'cep' => "Course Environment Parameters",
- 'scep' => "Set Course Environment Parameters",
- 'smcap' => "Set/Modify Course Assessment Parameter",
- 'mcap' => "Modify Course Assessment Parameters",
- 'caphm' => "Course Assessment Parameter - Helper Mode",
- 'capom' => "Course Assessment Parameters - Overview Mode",
'captm' => "Course Assessments Parameters - Table Mode",
'sg' => "Section/Group",
'fu' => "For User",
'oi' => "or ID",
'ad' => "at Domain"
);
- my $overallhelp=
- &Apache::loncommon::help_open_menu('','Setting Parameters','Course_Setting_Parameters','',10,'Instructor Interface');
- my $assessparmhelp=&Apache::loncommon::help_open_topic("Cascading_Parameters","Assessment Parameters");
+ my $html=&Apache::lonxml::xmlbegin();
$r->print(<
+$html
LON-CAPA Course Parameters
-
LON-CAPA Course Environment
$bodytag
-