--- loncom/interface/lonparmset.pm 2005/05/30 17:56:39 1.194 +++ loncom/interface/lonparmset.pm 2005/06/02 13:15:05 1.198 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.194 2005/05/30 17:56:39 albertel Exp $ +# $Id: lonparmset.pm,v 1.198 2005/06/02 13:15:05 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -62,17 +62,28 @@ 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 $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; ################################################## @@ -108,6 +119,9 @@ Returns: A list, the first item is the ################################################## sub parmval { my ($what,$id,$def,$uname,$udom,$csec)=@_; +# load caches + &cacheparmhash(); + my $result=''; my @outpar=(); # ----------------------------------------------------- Cascading lookup scheme @@ -189,11 +203,32 @@ 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 cacheuseropt { + my ($uname,$udom)=@_; +} + +sub cachecourseopt { +} ################################################## ################################################## # -# Store a parameter +# Store a parameter by ID # # Takes # - resource id @@ -206,12 +241,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; @@ -239,9 +299,9 @@ sub storeparm { # 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'); } @@ -264,10 +324,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 +735,6 @@ Input: See list below: =cut sub extractResourceInformation { - my $bighash = shift; my $ids = shift; my $typep = shift; my $keyp = shift; @@ -688,63 +747,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)'; } } @@ -803,7 +861,6 @@ sub assessparms { my %defp; %courseopt=(); %useropt=(); - my %bighash=(); @ids=(); %symbp=(); @@ -905,20 +962,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'} = ''; @@ -971,11 +1016,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 +1278,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 +1377,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 +1465,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 +1525,6 @@ ENDMAPONE } # end of $parmlev eq general } $r->print(''); - untie(%bighash); - untie(%parmhash); } # end sub assessparms @@ -2091,7 +2129,8 @@ sub print_main_menu { action="/adm/parmset" name="studentform"> ENDMAINFORMHEAD # - my ($cdom,$cnum) = split/_/,$env{'request.course.id'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my @menu = ( { text => 'Set Course Environment Parameters',