--- loncom/interface/lonparmset.pm 2005/05/30 17:58:51 1.195
+++ loncom/interface/lonparmset.pm 2005/06/02 16:35:32 1.200
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.195 2005/05/30 17:58:51 albertel Exp $
+# $Id: lonparmset.pm,v 1.200 2005/06/02 16:35:32 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -62,17 +62,24 @@ 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;
+# --- end local caches
+
+#
+# FIXME: get rid of items below
+#
my @ids;
my %symbp;
my %mapp;
my %typep;
my %keyp;
-
+my %uris;
my %maptitles;
##################################################
@@ -108,6 +115,16 @@ Returns: A list, the first item is the
##################################################
sub parmval {
my ($what,$id,$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
@@ -127,13 +144,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 +163,25 @@ 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 +189,43 @@ 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'};
+ }
+}
##################################################
##################################################
#
-# Store a parameter
+# Store a parameter by ID
#
# Takes
# - resource id
@@ -206,12 +238,37 @@ sub parmval {
sub storeparm {
my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
- $spnam=~s/\_([^\_]+)$/\.$1/;
+ 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
-
- 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 +293,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 +320,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');
}
@@ -675,7 +731,6 @@ Input: See list below:
=cut
sub extractResourceInformation {
- my $bighash = shift;
my $ids = shift;
my $typep = shift;
my $keyp = shift;
@@ -688,63 +743,62 @@ sub extractResourceInformation {
my $mapp = shift;
my $symbp = shift;
my $maptitles=shift;
+ my $uris=shift;
+
- foreach (keys %$bighash) {
- if ($_=~/^src\_(\d+)\.(\d+)$/) {
- # there are no resources in the 0 level
- if ($1 eq '0') { next; }
- my $mapid=$1;
- my $resid=$2;
- my $id=$mapid.'.'.$resid;
- my $srcf=$$bighash{$_};
- if (1) {
- $srcf=~/\.(\w+)$/;
- $$ids[$#$ids+1]=$id;
- $$typep{$id}=$1;
- $$keyp{$id}='';
- foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
- if ($_=~/^parameter\_(.*)/) {
- my $key=$_;
- my $allkey=$1;
- $allkey=~s/\_/\./g;
- if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq
- 'parm') {
- next; #hide hidden things
- }
- my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
- my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
- my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
- my $parmdis = $display;
- $parmdis =~ s|(\[Part.*)$||g;
- my $partkey = $part;
- $partkey =~ tr|_|.|;
- $$allparms{$name} = $parmdis;
- $$allparts{$part} = "[Part $part]";
- $$allkeys{$allkey}=$display;
- if ($allkey eq $fcat) {
- $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
- }
- if ($$keyp{$id}) {
- $$keyp{$id}.=','.$key;
- } else {
- $$keyp{$id}=$key;
- }
- }
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
+ foreach my $resource (@allres) {
+ my $id=$resource->id();
+ my ($mapid,$resid)=split(/\./,$id);
+ if ($mapid eq '0') { next; }
+ $$ids[$#$ids+1]=$id;
+ my $srcf=$resource->src();
+ $srcf=~/\.(\w+)$/;
+ $$typep{$id}=$1;
+ $$keyp{$id}='';
+ $$uris{$id}=$srcf;
+ foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
+ if ($_=~/^parameter\_(.*)/) {
+ my $key=$_;
+ my $allkey=$1;
+ $allkey=~s/\_/\./g;
+ if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq
+ 'parm') {
+ next; #hide hidden things
+ }
+ my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
+ my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
+ my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
+ my $parmdis = $display;
+ $parmdis =~ s|(\[Part.*)$||g;
+ my $partkey = $part;
+ $partkey =~ tr|_|.|;
+ $$allparms{$name} = $parmdis;
+ $$allparts{$part} = "[Part $part]";
+ $$allkeys{$allkey}=$display;
+ if ($allkey eq $fcat) {
+ $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
}
- $$mapp{$id}=
- &Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});
- $$mapp{$mapid}=$$mapp{$id};
- $$allmaps{$mapid}=$$mapp{$id};
- if ($mapid eq '1') {
- $$maptitles{$mapid}='Main Course Documents';
+ if ($$keyp{$id}) {
+ $$keyp{$id}.=','.$key;
} else {
- $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
+ $$keyp{$id}=$key;
}
- $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
- $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
- $$symbp{$mapid}=$$mapp{$id}.'___(all)';
}
}
+ $$mapp{$id}=
+ &Apache::lonnet::declutter($resource->enclosing_map_src());
+ $$mapp{$mapid}=$$mapp{$id};
+ $$allmaps{$mapid}=$$mapp{$id};
+ if ($mapid eq '1') {
+ $$maptitles{$mapid}='Main Course Documents';
+ } else {
+ $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
+ }
+ $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
+ $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
+ $$symbp{$mapid}=$$mapp{$id}.'___(all)';
}
}
@@ -801,9 +855,6 @@ sub assessparms {
my %allparts;
my %defp;
- %courseopt=();
- %useropt=();
- my %bighash=();
@ids=();
%symbp=();
@@ -905,20 +956,8 @@ sub assessparms {
my $fcat=$env{'form.fcat'};
unless ($fcat) { $fcat=''; }
-# ------------------------------------------------------------------- Tie hashs
- if (!(tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
- &GDBM_READER(),0640))) {
- $r->print("Unable to access course data. (File $env{'request.course.fn'}.db not tieable)");
- return ;
- }
- if (!(tie(%parmhash,'GDBM_File',
- $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
- $r->print("Unable to access parameter data. (File $env{'request.course.fn'}_parms.db not tieable)");
- return ;
- }
-
# --------------------------------------------------------- Get all assessments
- &extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles);
+ &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles,\%uris);
$mapp{'0.0'} = '';
$symbp{'0.0'} = '';
@@ -932,21 +971,6 @@ sub assessparms {
# ---------------------------------------------------------------- Done storing
$message.=''.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'
';
}
-# --------------------------------------------- Devalidate cache for this child
- &Apache::lonnet::devalidatecourseresdata(
- $env{'course.'.$env{'request.course.id'}.'.num'},
- $env{'course.'.$env{'request.course.id'}.'.domain'});
- #&Apache::lonnet::clear_EXT_cache_status();
-# -------------------------------------------------------------- Get coursedata
- %courseopt = &Apache::lonnet::dump
- ('resourcedata',
- $env{'course.'.$env{'request.course.id'}.'.domain'},
- $env{'course.'.$env{'request.course.id'}.'.num'});
-# --------------------------------------------------- Get userdata (if present)
- if ($uname) {
- %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
- }
-
# ------------------------------------------------------------------- Sort this
@ids=sort {
@@ -971,11 +995,6 @@ sub assessparms {
$trimheader = 'yes';
&startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);
- if (!$have_assesments) {
- untie(%bighash);
- untie(%parmhash);
- return '';
- }
# if ($env{'form.url'}) {
# $r->print('');
@@ -1238,7 +1257,7 @@ ENDTABLEHEADFOUR
my %display=();
my %type= ();
my %default=();
- my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
+ my $uri=&Apache::lonnet::declutter($uris{$rid});
foreach (split(/\,/,$keyp{$rid})) {
my $tempkeyp = $_;
@@ -1337,7 +1356,7 @@ ENDTABLEHEADFOUR
# $r->print("$mapid:$map: $rid
\n");
if ($map eq $mapid) {
- my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
+ my $uri=&Apache::lonnet::declutter($uris{$rid});
# $r->print("Keys: $keyp{$rid}
\n");
#--------------------------------------------------------------------
@@ -1425,7 +1444,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
@@ -1485,8 +1504,6 @@ ENDMAPONE
} # end of $parmlev eq general
}
$r->print('