--- loncom/interface/lonparmset.pm 2005/05/30 17:50:18 1.193
+++ loncom/interface/lonparmset.pm 2005/06/03 14:25:49 1.203
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.193 2005/05/30 17:50:18 albertel Exp $
+# $Id: lonparmset.pm,v 1.203 2005/06/03 14:25:49 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -62,18 +62,16 @@ use GDBM_File;
use Apache::lonhomework;
use Apache::lonxml;
use Apache::lonlocal;
+use Apache::lonnavmaps;
-my %courseopt;
-my %useropt;
-my %parmhash;
+# --- Caches local to lonparmset
-my @ids;
-my %symbp;
-my %mapp;
-my %typep;
-my %keyp;
+my $parmhashid;
+my %parmhash;
+my $symbsid;
+my %symbs;
-my %maptitles;
+# --- end local caches
##################################################
##################################################
@@ -105,15 +103,30 @@ Returns: A list, the first item is the
=cut
##################################################
-##################################################
sub parmval {
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;
@@ -127,13 +140,13 @@ sub parmval {
# --------------------------------------------------------- first, check course
- if (defined($courseopt{$courselevel})) {
- $outpar[11]=$courseopt{$courselevel};
+ if (defined($$courseopt{$courselevel})) {
+ $outpar[11]=$$courseopt{$courselevel};
$result=11;
}
- if (defined($courseopt{$courselevelm})) {
- $outpar[10]=$courseopt{$courselevelm};
+ if (defined($$courseopt{$courselevelm})) {
+ $outpar[10]=$$courseopt{$courselevelm};
$result=10;
}
@@ -146,24 +159,24 @@ sub parmval {
my $thisparm=$parmhash{$symbparm};
if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
- if (defined($courseopt{$courselevelr})) {
- $outpar[7]=$courseopt{$courselevelr};
+ 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;
}
}
@@ -171,29 +184,66 @@ sub parmval {
# ---------------------------------------------------------- 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
+# Store a parameter by ID
#
# Takes
# - resource id
@@ -206,12 +256,30 @@ sub parmval {
sub storeparm {
my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
- $spnam=~s/\_([^\_]+)$/\.$1/;
+ &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
-
- my $symbparm=$symbp{$sresid}.'.'.$spnam;
- my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
-
+ $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;
@@ -236,27 +304,26 @@ sub storeparm {
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',$symbp{$sresid});
+ &Apache::lonnet::expirespread('','','assesscalc',$symb);
} elsif (($snum==8) || ($snum==5)) {
- &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
+ &Apache::lonnet::expirespread('','','assesscalc',$map);
} else {
&Apache::lonnet::expirespread('','','assesscalc');
}
# Store parameter
if ($delete) {
$reply=&Apache::lonnet::del
- ('resourcedata',[keys(%storecontent)],
- $env{'course.'.$env{'request.course.id'}.'.domain'},
- $env{'course.'.$env{'request.course.id'}.'.num'});
+ ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
} else {
$reply=&Apache::lonnet::cput
- ('resourcedata',\%storecontent,
- $env{'course.'.$env{'request.course.id'}.'.domain'},
- $env{'course.'.$env{'request.course.id'}.'.num'});
+ ('resourcedata',\%storecontent,$cdom,$cnum);
}
+ &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
} else {
# ------------------------------------------------------------------ Store User
#
@@ -264,10 +331,10 @@ sub storeparm {
&Apache::lonnet::expirespread($uname,$udom,'studentcalc');
if ($snum==1) {
&Apache::lonnet::expirespread
- ($uname,$udom,'assesscalc',$symbp{$sresid});
+ ($uname,$udom,'assesscalc',$symb);
} elsif ($snum==2) {
&Apache::lonnet::expirespread
- ($uname,$udom,'assesscalc',$mapp{$sresid});
+ ($uname,$udom,'assesscalc',$map);
} else {
&Apache::lonnet::expirespread($uname,$udom,'assesscalc');
}
@@ -379,25 +446,17 @@ 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');
+ my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table');
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",
@@ -459,26 +518,6 @@ $bodytag
$breadcrumbs
$overallhelp
ENDHEAD
-
- unless ($trimheader) {$r->print(<
-
$lt{'cep'}
-
-
-
-$assessparmhelp
-
-
-
-
-ENDHEAD2
- }
my %sectionhash=();
my $sections='';
if (&Apache::loncommon::get_sections(
@@ -497,8 +536,8 @@ ENDHEAD2
$lt{'captm'}
ENDHEAD3
- if (!$have_assesments) {
- $r->print(''.&mt('There are no assesment parameters in this course to set.').' ');
+ if (!$have_assessments) {
+ $r->print(''.&mt('There are no assessment parameters in this course to set.').' ');
} else {
$r->print(<
@@ -519,7 +558,7 @@ ENDHEAD
}
sub print_row {
- my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone,
+ my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
$defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
# get the values for the parameter in cascading order
# empty levels will remain empty
@@ -541,7 +580,7 @@ sub print_row {
}
my $parm=$$display{$which};
- if ($parmlev eq 'full' || $parmlev eq 'brief') {
+ if ($parmlev eq 'full') {
$r->print('
\n");
@@ -1426,7 +1419,7 @@ ENDMAPONE
foreach (@ids) {
my $rid = $_;
- my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
+ my $uri=&Apache::lonnet::declutter($uris{$rid});
#--------------------------------------------------------------------
# @catmarker contains list of all possible parameters including part #s
@@ -1478,7 +1471,7 @@ ENDMAPONE
foreach (sort keys %name) {
$r->print('