--- loncom/interface/lonparmset.pm 2005/02/05 06:21:57 1.182
+++ loncom/interface/lonparmset.pm 2005/06/02 13:34:14 1.199
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.182 2005/02/05 06:21:57 albertel Exp $
+# $Id: lonparmset.pm,v 1.199 2005/06/02 13:34:14 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -62,25 +62,30 @@ use GDBM_File;
use Apache::lonhomework;
use Apache::lonxml;
use Apache::lonlocal;
+use Apache::lonnavmaps;
+# --- Caches local to lonparmset
+
+my $courseoptid;
my %courseopt;
+my $useroptid;
my %useropt;
+my $parmhashid;
my %parmhash;
+# --- end local caches
+
+#
+# FIXME: get rid of items below
+#
my @ids;
my %symbp;
my %mapp;
my %typep;
my %keyp;
-
+my %uris;
my %maptitles;
-my $uname;
-my $udom;
-my $uhome;
-my $csec;
-my $coursename;
-
##################################################
##################################################
@@ -113,7 +118,12 @@ Returns: A list, the first item is the
##################################################
##################################################
sub parmval {
- my ($what,$id,$def)=@_;
+ my ($what,$id,$def,$uname,$udom,$csec)=@_;
+# load caches
+ &cacheparmhash();
+ &cacheuseropt($uname,$udom);
+ &cachecourseopt();
+
my $result='';
my @outpar=();
# ----------------------------------------------------- Cascading lookup scheme
@@ -121,13 +131,13 @@ sub parmval {
my $symbparm=$symbp{$id}.'.'.$what;
my $mapparm=$mapp{$id}.'___(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 $courselevel=$ENV{'request.course.id'}.'.'.$what;
- my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
- my $courselevelm=$ENV{'request.course.id'}.'.'.$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;
@@ -195,6 +205,171 @@ sub parmval {
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 resetuseropt {
+ $useroptid='';
+}
+
+sub cacheuseropt {
+ my ($uname,$udom)=@_;
+ unless ($uname) { return; }
+ if ($useroptid eq $uname.'@'.$udom) { return; }
+ %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
+ $useroptid=$uname.'@'.$udom;
+}
+
+sub resetcourseopt {
+ $courseoptid='';
+}
+
+sub cachecourseopt {
+ if ($courseoptid eq $env{'request.course.id'}) { return; };
+ %courseopt = &Apache::lonnet::dump
+ ('resourcedata',
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ $courseoptid=$env{'request.course.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)=@_;
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if ($sresid=~/\./) {
+ my $resource=$navmap->getById($sresid);
+ &storeparm_by_symb($resource->symb(),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
+ } else {
+ my $resource=$navmap->getByMapPc($sresid);
+ &storeparm_by_symb(&Apache::lonnet::declutter($resource->src()),$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
+#
+# 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');
+ }
+ &resetcourseopt();
+# 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'});
+ } else {
+ $reply=&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
+ } 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');
+ }
+ &resetuseropt();
+# 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 '';
+}
+
##################################################
##################################################
@@ -275,9 +450,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
@@ -292,6 +467,7 @@ sub startpage {
my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
'onUnload="pclose()"');
+ 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();
@@ -312,8 +488,9 @@ sub startpage {
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
-