--- loncom/interface/lonparmset.pm 2005/03/03 06:11:11 1.184 +++ loncom/interface/lonparmset.pm 2005/06/04 15:26:13 1.207 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.184 2005/03/03 06:11:11 albertel Exp $ +# $Id: lonparmset.pm,v 1.207 2005/06/04 15:26:13 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 ################################################## ################################################## @@ -111,35 +103,50 @@ 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 $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; # --------------------------------------------------------- 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; } @@ -152,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; } } @@ -177,24 +184,177 @@ 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 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 ''; +} + ################################################## ################################################## @@ -275,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 @@ -286,32 +446,23 @@ 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(< $bodytag -$overallhelp +$breadcrumbs ENDHEAD - - unless ($trimheader) {$r->print(< -

$lt{'cep'}

- - -
-$assessparmhelp -
-

$lt{'caphm'}

- -
-
-
-

$lt{'capom'}

- -
-
-ENDHEAD2 -} - $r->print(< + my %sectionhash=(); + my $sections=''; + if (&Apache::loncommon::get_sections( + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}, + \%sectionhash)) { + $sections=$lt{'sg'}.': '; + } + $r->print(<

$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(< -$lt{'sg'}: - -
+$sections +
$lt{'fu'} - + $lt{'oi'} - + $lt{'ad'} $chooseopt @@ -411,17 +554,17 @@ ENDHEAD } sub print_row { - my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone, - $defbgtwo,$parmlev)=@_; + 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 my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which}, - $rid,$$default{$which}); + $rid,$$default{$which},$uname,$udom,$csec); # get the type for the parameters # problem: these may not be set for all levels my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'. $$name{$which}.'.type', - $rid,$$defaulttype{$which}); + $rid,$$defaulttype{$which},$uname,$udom,$csec); # cascade down manually my $cascadetype=$$defaulttype{$which}; for (my $i=11;$i>0;$i--) { @@ -433,7 +576,7 @@ sub print_row { } my $parm=$$display{$which}; - if ($parmlev eq 'full' || $parmlev eq 'brief') { + if ($parmlev eq 'full') { $r->print('' .$$part{$which}.''); } else { @@ -468,47 +611,30 @@ sub print_row { &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - if ($parmlev eq 'brief') { - - &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - - if ($csec) { - &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - if ($uname) { - &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - } else { - - &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + + if ($csec) { + &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + } + if ($uname) { + &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + } - if ($csec) { - &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - if ($uname) { - &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - } # end of $brief if/else } # end of $parmlev if/else $r->print(''. &valout($outpar[$result],$typeoutpar[$result]).''); - if ($parmlev eq 'full' || $parmlev eq 'brief') { + if ($parmlev eq 'full') { my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}. - '.'.$$name{$which},$symbp{$rid}); - -# this doesn't seem to work, and I don't think is correct -# my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}. -# '.'.$$name{$which}.'.type',$symbp{$rid}); -# this seems to work + '.'.$$name{$which},$$symbp{$rid}); my $sessionvaltype=$typeoutpar[$result]; if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; } $r->print(''. @@ -533,6 +659,7 @@ sub print_td { $r->print(''."\n"); } + =pod =item B: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes. @@ -568,7 +695,6 @@ Input: See list below: =cut sub extractResourceInformation { - my $bighash = shift; my $ids = shift; my $typep = shift; my $keyp = shift; @@ -581,63 +707,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)'; } } @@ -674,13 +799,28 @@ Variables used (guessed by Jeremy): sub assessparms { my $r=shift; + + my @ids=(); + my %symbp=(); + my %mapp=(); + my %typep=(); + my %keyp=(); + my %uris=(); + my %maptitles=(); + # -------------------------------------------------------- Variable declaration my %allkeys=(); my %allmaps=(); my %alllevs=(); + my $uname; + my $udom; + my $uhome; + my $csec; + + my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'}; + $alllevs{'Resource Level'}='full'; -# $alllevs{'Resource Level [BRIEF]'}='brief'; $alllevs{'Map Level'}='map'; $alllevs{'Course Level'}='general'; @@ -688,9 +828,6 @@ sub assessparms { my %allparts; my %defp; - %courseopt=(); - %useropt=(); - my %bighash=(); @ids=(); %symbp=(); @@ -698,57 +835,51 @@ sub assessparms { my $message=''; - $csec=$ENV{'form.csec'}; - if ($udom=$ENV{'form.udom'}) { - } elsif ($udom=$ENV{'request.role.domain'}) { - } elsif ($udom=$ENV{'user.domain'}) { + $csec=$env{'form.csec'}; + + if ($udom=$env{'form.udom'}) { + } elsif ($udom=$env{'request.role.domain'}) { + } elsif ($udom=$env{'user.domain'}) { } else { $udom=$r->dir_config('lonDefDomain'); } my @pscat=&Apache::loncommon::get_env_multiple('form.pscat'); - my $pschp=$ENV{'form.pschp'}; + my $pschp=$env{'form.pschp'}; my @psprt=&Apache::loncommon::get_env_multiple('form.psprt'); if (!@psprt) { $psprt[0]='0'; } - my $showoptions=$ENV{'form.showoptions'}; + my $showoptions=$env{'form.showoptions'}; my $pssymb=''; my $parmlev=''; - my $trimheader=''; - my $prevvisit=$ENV{'form.prevvisit'}; - -# unless ($parmlev==$ENV{'form.parmlev'}) { -# $parmlev = 'full'; -# } + my $prevvisit=$env{'form.prevvisit'}; - unless ($ENV{'form.parmlev'}) { + unless ($env{'form.parmlev'}) { $parmlev = 'map'; } else { - $parmlev = $ENV{'form.parmlev'}; + $parmlev = $env{'form.parmlev'}; } # ----------------------------------------------- Was this started from grades? - if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'}) - && (!$ENV{'form.dis'})) { - my $url=$ENV{'form.url'}; + if (($env{'form.command'} eq 'set') && ($env{'form.url'}) + && (!$env{'form.dis'})) { + my $url=$env{'form.url'}; $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; $pssymb=&Apache::lonnet::symbread($url); if (!@pscat) { @pscat=('all'); } $pschp=''; $parmlev = 'full'; - $trimheader='yes'; - } elsif ($ENV{'form.symb'}) { - $pssymb=$ENV{'form.symb'}; + } elsif ($env{'form.symb'}) { + $pssymb=$env{'form.symb'}; if (!@pscat) { @pscat=('all'); } $pschp=''; $parmlev = 'full'; - $trimheader='yes'; } else { - $ENV{'form.url'}=''; + $env{'form.url'}=''; } - my $id=$ENV{'form.id'}; + my $id=$env{'form.id'}; if (($id) && ($udom)) { $uname=(&Apache::lonnet::idget($udom,$id))[1]; if ($uname) { @@ -759,7 +890,7 @@ sub assessparms { &mt('at domain')." '$udom'"; } } else { - $uname=$ENV{'form.uname'}; + $uname=$env{'form.uname'}; } unless ($udom) { $uname=''; } $uhome=''; @@ -772,13 +903,13 @@ sub assessparms { $uname=''; } else { $csec=&Apache::lonnet::getsection($udom,$uname, - $ENV{'request.course.id'}); + $env{'request.course.id'}); if ($csec eq '-1') { $message="". &mt("User")." '$uname' ".&mt("at domain")." '$udom' ". &mt("not in this course").""; $uname=''; - $csec=$ENV{'form.csec'}; + $csec=$env{'form.csec'}; } else { my %name=&Apache::lonnet::userenvironment($udom,$uname, ('firstname','middlename','lastname','generation','id')); @@ -792,135 +923,38 @@ sub assessparms { unless ($csec) { $csec=''; } - my $fcat=$ENV{'form.fcat'}; + 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'} = ''; # ---------------------------------------------------------- Anything to store? - if ($ENV{'form.pres_marker'}) { - my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'}); - $spnam=~s/\_([^\_]+)$/\.$1/; -# ---------------------------------------------------------- Construct prefixes - - my $symbparm=$symbp{$sresid}.'.'.$spnam; - my $mapparm=$mapp{$sresid}.'___(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 ($ENV{'form.pres_value'} eq '') { $delete=1;} - my %storecontent = ($storeunder => $ENV{'form.pres_value'}, - $storeunder.'.type' => $ENV{'form.pres_type'}); - my $reply=''; - if ($snum>3) { -# ---------------------------------------------------------------- Store Course -# -# Expire sheets - &Apache::lonnet::expirespread('','','studentcalc'); - if (($snum==7) || ($snum==4)) { - &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid}); - } elsif (($snum==8) || ($snum==5)) { - &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid}); - } 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'}); - } 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',$symbp{$sresid}); - } elsif ($snum==2) { - &Apache::lonnet::expirespread - ($uname,$udom,'assesscalc',$mapp{$sresid}); - } 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); - } - } - - if ($reply=~/^error\:(.*)/) { - $message.="Write Error: $1"; + if ($env{'form.pres_marker'}) { + my @markers=split(/\&\&\&/,$env{'form.pres_marker'}); + my @values=split(/\&\&\&/,$env{'form.pres_value'}); + my @types=split(/\&\&\&/,$env{'form.pres_type'}); + for (my $i=0;$i<=$#markers;$i++) { + $message.=&storeparm(split(/\&/,$markers[$i]), + $values[$i], + $types[$i], + $uname,$udom,$csec); } # ---------------------------------------------------------------- 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 { if ($fcat eq '') { $a<=>$b; } else { - my ($result,@outpar)=&parmval($fcat,$a,$defp{$a}); + my ($result,@outpar)=&parmval($fcat,$a,$defp{$a},$uname,$udom,$csec); my $aparm=$outpar[$result]; - ($result,@outpar)=&parmval($fcat,$b,$defp{$b}); + ($result,@outpar)=&parmval($fcat,$b,$defp{$b},$uname,$udom,$csec); my $bparm=$outpar[$result]; 1*$aparm<=>1*$bparm; } @@ -930,26 +964,14 @@ sub assessparms { if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);} # ------------------------------------------------------------------ Start page - my $have_assesments=1; - if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; } - - &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader); + &startpage($r,$id,$udom,$csec,$uname,scalar(keys(%allkeys))); - if (!$have_assesments) { - untie(%bighash); - untie(%parmhash); - return ''; - } -# if ($ENV{'form.url'}) { -# $r->print(''); -# } $r->print(''); foreach ('tolerance','date_default','date_start','date_end', 'date_interval','int','float','string') { $r->print(''); + $env{'form.recent_'.$_}.'" name="recent_'.$_.'">'); } $r->print('

'.$message.'

'); @@ -989,9 +1011,9 @@ sub assessparms { $r->print(''); } - $r->print(''); + $r->print(' name="showoptions" value="show" />'.&mt('Show More Options').'
'); # $r->print(""); # $r->print(""); # $r->print(""); @@ -1115,10 +1137,10 @@ sub assessparms { if (($prevvisit) || ($pschp) || ($pssymb)) { # ----------------------------------------------------------------- Start Table my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat; - my $csuname=$ENV{'user.name'}; - my $csudom=$ENV{'user.domain'}; + my $csuname=$env{'user.name'}; + my $csudom=$env{'user.domain'}; - if ($parmlev eq 'full' || $parmlev eq 'brief') { + if ($parmlev eq 'full') { my $coursespan=$csec?8:5; $r->print('

print('
Show: $showoptions
pscat: @pscat
psprt: @psprt
'); $r->print(''); @@ -1158,8 +1180,8 @@ ENDTABLETWO $r->print(< - - + + ENDTABLEHEADFOUR if ($csec) { @@ -1202,7 +1224,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 = $_; @@ -1255,16 +1277,16 @@ ENDTABLEHEADFOUR undef $firstrow; } - &print_row($r,$_,\%part,\%name,$rid,\%default, + &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default, \%type,\%display,$defbgone,$defbgtwo, - $parmlev); + $parmlev,$uname,$udom,$csec); } } } } # end foreach ids # -------------------------------------------------- End entry for one resource $r->print('
$lt{'aut'}$lt{'type'} $lt{'emof'}$lt{'part'}$lt{'pn'}$lt{'gen'}$lt{'femof'}$lt{'def'}$lt{'foremf'}$lt{'fr'}$lt{'gen'}$lt{'foremf'}$lt{'def'}$lt{'femof'}$lt{'fr'}
'); - } # end of brief/full + } # end of full #--------------------------------------------------- Entry for parm level map if ($parmlev eq 'map') { my $defbgone = '"E0E099"'; @@ -1301,7 +1323,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"); #-------------------------------------------------------------------- @@ -1363,9 +1385,9 @@ ENDMAPONE foreach (sort keys %name) { $r->print(''); - &print_row($r,$_,\%part,\%name,$mapid,\%default, + &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default, \%type,\%display,$defbgone,$defbgtwo, - $parmlev); + $parmlev,$uname,$udom,$csec); # $r->print("resource.$part{$_}.$name{$_},$symbp{$mapid}\n"); } $r->print(""); @@ -1389,7 +1411,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 @@ -1441,16 +1463,14 @@ ENDMAPONE foreach (sort keys %name) { $r->print(''); - &print_row($r,$_,\%part,\%name,$mapid,\%default, - \%type,\%display,$defbgone,$defbgtwo,$parmlev); + &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default, + \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec); # $r->print("resource.$part{$_}.$name{$_},$symbp{$mapid}\n"); } $r->print(""); } # end of $parmlev eq general } $r->print(''); - untie(%bighash); - untie(%parmhash); } # end sub assessparms @@ -1477,17 +1497,19 @@ sub crsenv { my $setoutput=''; my $bodytag=&Apache::loncommon::bodytag( 'Set Course Environment Parameters'); - my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef, + 'Edit Course Environment'); + my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; # # Go through list of changes - foreach (keys %ENV) { + foreach (keys %env) { next if ($_!~/^form\.(.+)\_setparmval$/); my $name = $1; - my $value = $ENV{'form.'.$name.'_value'}; + my $value = $env{'form.'.$name.'_value'}; if ($name eq 'newp') { - $name = $ENV{'form.newp_name'}; + $name = $env{'form.newp_name'}; } if ($name eq 'url') { $value=~s/^\/res\///; @@ -1563,7 +1585,7 @@ sub crsenv { } # ------------------------- Re-init course environment entries for this session - &Apache::lonnet::coursedescription($ENV{'request.course.id'}); + &Apache::lonnet::coursedescription($env{'request.course.id'}); # -------------------------------------------------------- Get parameters again @@ -1759,7 +1781,7 @@ sub crsenv { my $Set=&mt('Set'); my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset'); my $html=&Apache::lonxml::xmlbegin(); - $r->print(<print(<