--- loncom/interface/lonparmset.pm 2002/02/12 00:14:07 1.43 +++ loncom/interface/lonparmset.pm 2002/02/12 06:28:23 1.44 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.43 2002/02/12 00:14:07 albertel Exp $ +# $Id: lonparmset.pm,v 1.44 2002/02/12 06:28:23 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,11 +56,8 @@ use GDBM_File; my %courseopt; my %useropt; -my %bighash; my %parmhash; -my @outpar; - my @ids; my %symbp; my %mapp; @@ -70,17 +67,14 @@ my %keyp; my $uname; my $udom; my $uhome; - my $csec; -my $fcat; - # -------------------------------------------- Figure out a cascading parameter sub parmval { my ($what,$id,$def)=@_; my $result=''; - @outpar=(); + my @outpar=(); # ----------------------------------------------------- Cascading lookup scheme my $symbparm=$symbp{$id}.'.'.$what; @@ -155,7 +149,7 @@ sub parmval { } } - return $result; + return ($result,@outpar); } # ------------------------------------------------------------ Output for value @@ -183,6 +177,128 @@ sub plink { &valout($value,$type).''; } + +sub startpage { + my ($r,$id,$udom,$csec,$uname)=@_; + $r->content_type('text/html'); + $r->send_http_header; + $r->print(< + +LON-CAPA Course Parameters + + + +

Set Course Parameters

+
+

Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}

+

Course Environment

+ +
+
+

Course Assessments

+ +Section/Group: + +
+For User + +or ID + +at Domain + + + + + +ENDHEAD + +} + +sub print_row { + my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone, + $defbgtwo)=@_; + my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which}, + $rid,$$default{$which}); + $r->print("'. + &plink($$type{$value},$$display{$value},$$outpar[$which], + $mprefix."$which",'parmform.pres','psub').''); +} + sub assessparms { my $r=shift; @@ -192,7 +308,7 @@ sub assessparms { my %defp; %courseopt=(); %useropt=(); - %bighash=(); + my %bighash=(); @ids=(); %symbp=(); @@ -266,459 +382,335 @@ sub assessparms { unless ($csec) { $csec=''; } - $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)) && - (tie(%parmhash,'GDBM_File', - $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { - + 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 - foreach (keys %bighash) { - if ($_=~/^src\_(\d+)\.(\d+)$/) { - my $mapid=$1; - my $resid=$2; - my $id=$mapid.'.'.$resid; - my $srcf=$bighash{$_}; - if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { - $ids[$#ids+1]=$id; - $typep{$id}=$1; - $keyp{$id}=''; - foreach (split(/\,/, - &Apache::lonnet::metadata($srcf,'keys'))) { - if ($_=~/^parameter\_(.*)/) { - my $key=$_; - my $allkey=$1; - $allkey=~s/\_/\./; - my $display= - &Apache::lonnet::metadata($srcf,$key.'.display'); - unless ($display) { - $display= - &Apache::lonnet::metadata($srcf,$key.'.name'); - } - $allkeys{$allkey}=$display; - if ($allkey eq $fcat) { - $defp{$id}= - &Apache::lonnet::metadata($srcf,$key); - } - if ($keyp{$id}) { - $keyp{$id}.=','.$key; - } else { - $keyp{$id}=$key; - } + foreach (keys %bighash) { + if ($_=~/^src\_(\d+)\.(\d+)$/) { + my $mapid=$1; + my $resid=$2; + my $id=$mapid.'.'.$resid; + my $srcf=$bighash{$_}; + if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { + $ids[$#ids+1]=$id; + $typep{$id}=$1; + $keyp{$id}=''; + foreach (split(/\,/, + &Apache::lonnet::metadata($srcf,'keys'))) { + if ($_=~/^parameter\_(.*)/) { + my $key=$_; + my $allkey=$1; + $allkey=~s/\_/\./; + my $display= + &Apache::lonnet::metadata($srcf,$key.'.display'); + unless ($display) { + $display= + &Apache::lonnet::metadata($srcf,$key.'.name'); + } + $allkeys{$allkey}=$display; + if ($allkey eq $fcat) { + $defp{$id}= + &Apache::lonnet::metadata($srcf,$key); + } + if ($keyp{$id}) { + $keyp{$id}.=','.$key; + } else { + $keyp{$id}=$key; } } - $mapp{$id}= - &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); - $allmaps{$mapid}=$mapp{$id}; - $symbp{$id}=$mapp{$id}. + } + $mapp{$id}= + &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); + $allmaps{$mapid}=$mapp{$id}; + $symbp{$id}=$mapp{$id}. '___'.$resid.'___'. &Apache::lonnet::declutter($srcf); - } - } - } + } + } + } # ---------------------------------------------------------- Anything to store? - if ($ENV{'form.pres_marker'}) { - my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'}); - $spnam=~s/\_([^\_]+)$/\.$1/; + 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==9) || ($snum==3)) { $storeunder=$courselevel; } - if (($snum==8) || ($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; } - $storeunder=&Apache::lonnet::escape($storeunder); - - my $storecontent= - $storeunder.'='. - &Apache::lonnet::escape($ENV{'form.pres_value'}).'&'. - $storeunder.'.type='. - &Apache::lonnet::escape($ENV{'form.pres_type'}); + 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==9) || ($snum==3)) { $storeunder=$courselevel; } + if (($snum==8) || ($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; } + $storeunder=&Apache::lonnet::escape($storeunder); + + my $storecontent= + $storeunder.'='. + &Apache::lonnet::escape($ENV{'form.pres_value'}).'&'. + $storeunder.'.type='. + &Apache::lonnet::escape($ENV{'form.pres_type'}); - my $reply=''; - if ($snum>3) { + 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'); - } + &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 - $reply=&Apache::lonnet::critical('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'. - $storecontent, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - } else { + $reply=&Apache::lonnet::critical('put:'. + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'. + $storecontent, + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + } 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'); - } + &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 - $reply= - &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'. - $storecontent,$uhome); - } + $reply= + &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'. + $storecontent,$uhome); + } - if ($reply=~/^error\:(.*)/) { - $message.="Write Error: $1"; - } + if ($reply=~/^error\:(.*)/) { + $message.="Write Error: $1"; + } # ---------------------------------------------------------------- Done storing - } + } # -------------------------------------------------------------- Get coursedata - my $reply=&Apache::lonnet::reply('dump:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata', - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - if ($reply!~/^error\:/) { + my $reply=&Apache::lonnet::reply('dump:'. + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata', + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + if ($reply!~/^error\:/) { + foreach (split(/\&/,$reply)) { + my ($name,$value)=split(/\=/,$_); + $courseopt{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } + } +# --------------------------------------------------- Get userdata (if present) + if ($uname) { + my $reply= + &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); + if ($reply!~/^error\:/) { foreach (split(/\&/,$reply)) { my ($name,$value)=split(/\=/,$_); - $courseopt{&Apache::lonnet::unescape($name)}= + $useropt{&Apache::lonnet::unescape($name)}= &Apache::lonnet::unescape($value); } - } -# --------------------------------------------------- Get userdata (if present) - if ($uname) { - my $reply= - &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); - if ($reply!~/^error\:/) { - foreach (split(/\&/,$reply)) { - my ($name,$value)=split(/\=/,$_); - $useropt{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - } - } - } + } + } # ------------------------------------------------------------------- Sort this - @ids=sort { - if ($fcat eq '') { - $a<=>$b; - } else { - 1*$outpar[&parmval($fcat,$a,$defp{$a})]<=> - 1*$outpar[&parmval($fcat,$b,$defp{$b})]; - } - } @ids; + @ids=sort { + if ($fcat eq '') { + $a<=>$b; + } else { + my ($result,@outpar)=&parmval($fcat,$a,$defp{$a}); + my $aparm=$outpar[$result]; + ($result,@outpar)=&parmval($fcat,$b,$defp{$b}); + my $bparm=$outpar[$result]; + 1*$aparm<=>1*$bparm; + } + } @ids; # ------------------------------------------------------------------ Start page - $r->content_type('text/html'); - $r->send_http_header; - $r->print(< - -LON-CAPA Course Parameters - - - -

Set Course Parameters

- -

Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}

-

Course Environment

- - -
-

Course Assessments

- -Section/Group: - -
-For User - -or ID - -at Domain - - - - - -ENDHEAD - if ($ENV{'form.url'}) { - $r->print(''); - } - foreach ('tolerance','date_default','date_start','date_end', - 'date_interval','int','float','string') { - $r->print(''); - } - - $r->print('

'.$message.'

Sort list by'); - $r->print('
Select Enclosing Map
Select Parameter

'); - if (($pscat) || ($pschp) || ($pssymb)) { + if (($pssymb=~/^$allmaps{$_}/) || + ($pschp eq $_)) { $r->print(' selected'); } + $r->print('>'.$allmaps{$_}.''); + } + } else { + my ($map,$id,$resource)=split(/___/,$pssymb); + $r->print('Specfic Resource '); + $r->print(''); + } + $r->print('Select Parameter
'); + if (($pscat) || ($pschp) || ($pssymb)) { # ----------------------------------------------------------------- Start Table - my $catmarker='parameter_'.$pscat; - $catmarker=~s/\./\_/g; - my $coursespan=$csec?8:5; - my $csuname=$ENV{'user.name'}; - my $csudom=$ENV{'user.domain'}; - $r->print(<print(< ENDTABLEHEAD - if ($uname) { - $r->print(""); - } - $r->print(<print(""); + } + $r->print(<Parameter in Effect ENDTABLETWO - if ($csec) { - $r->print(""); - } - $r->print(<print(""); + } + $r->print(< ENDTABLEHEADFOUR - if ($csec) { - $r->print(''); - } - if ($uname) { - $r->print(''); - } - $r->print(''); - my $defbgone=''; - my $defbgtwo=''; - foreach (@ids) { - my $rid=$_; - my ($inmapid)=($rid=~/\.(\d+)$/); - if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) || - ($pssymb eq $mapp{$rid}.'___'.$inmapid.'___'. - &Apache::lonnet::declutter($bighash{'src_'.$rid}))) { + if ($csec) { + $r->print(''); + } + if ($uname) { + $r->print(''); + } + $r->print(''); + my $defbgone=''; + my $defbgtwo=''; + foreach (@ids) { + my $rid=$_; + my ($inmapid)=($rid=~/\.(\d+)$/); + if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) || + ($pssymb eq $symbp{$rid})) { # ------------------------------------------------------ Entry for one resource - if ($defbgone eq '"E0E099"') { - $defbgone='"E0E0DD"'; - } else { - $defbgone='"E0E099"'; - } - if ($defbgtwo eq '"FFFF99"') { - $defbgtwo='"FFFFDD"'; - } else { - $defbgtwo='"FFFF99"'; + if ($defbgone eq '"E0E099"') { + $defbgone='"E0E0DD"'; + } else { + $defbgone='"E0E099"'; + } + if ($defbgtwo eq '"FFFF99"') { + $defbgtwo='"FFFFDD"'; + } else { + $defbgtwo='"FFFF99"'; + } + my $thistitle=''; + my %name= (); + undef %name; + my %part= (); + my %display=(); + my %type= (); + my %default=(); + my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); + + foreach (split(/\,/,$keyp{$rid})) { + if (($_ eq $catmarker) || ($pscat eq 'all')) { + $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part'); + $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name'); + $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display'); + unless ($display{$_}) { $display{$_}=''; } + $display{$_}.=' ('.$name{$_}.')'; + $default{$_}=&Apache::lonnet::metadata($uri,$_); + $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type'); + $thistitle=&Apache::lonnet::metadata($uri,$_.'.title'); } - @outpar=(); - my $thistitle=''; - my %name= (); - undef %name; - my %part= (); - my %display=(); - my %type= (); - my %default=(); - my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); - - foreach (split(/\,/,$keyp{$rid})) { - if (($_ eq $catmarker) || ($pscat eq 'all')) { - $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part'); - $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name'); - $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display'); - unless ($display{$_}) { $display{$_}=''; } - $display{$_}.=' ('.$name{$_}.')'; - $default{$_}=&Apache::lonnet::metadata($uri,$_); - $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type'); - $thistitle=&Apache::lonnet::metadata($uri,$_.'.title'); - } + } + my $totalparms=scalar keys %name; + if ($totalparms>0) { + my $firstrow=1; + $r->print(''); - $r->print(''); - $r->print(''); - foreach (sort keys %name) { - my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_}); - unless ($firstrow) { - $r->print(''); - } else { - $firstrow=0; - } - $r->print(""); - my $thismarker=$_; - $thismarker=~s/^parameter\_//; - my $mprefix=$rid.'&'.$thismarker.'&'; - - $r->print(''); - $r->print(''); - - $r->print(''); - $r->print(''); - $r->print(''); - - if ($csec) { - $r->print(''); - $r->print(''); - $r->print(''); - } - - if ($uname) { - $r->print(''); - $r->print(''); - $r->print(''); - } - $r->print(''); - my $sessionval=&Apache::lonnet::EXT('resource.'.$part{$_}. - '.'.$name{$_},$mapp{$rid}.'___'.$inmapid.'___'.$uri); - if (($type{$_}=~/^date/) && ($sessionval)) - { $sessionval=localtime($sessionval); } - $r->print(''); - $r->print(""); + $r->print(''); + $r->print(''); + $r->print(''); + foreach (sort keys %name) { + unless ($firstrow) { + $r->print(''); + } else { + $firstrow=0; } + &print_row($r,$_,\%part,\%name,$rid,\%default, + \%type,\%display,$defbgone,$defbgtwo); } -# -------------------------------------------------- End entry for one resource } +# -------------------------------------------------- End entry for one resource } - $r->print('
Any UserUser $uname at Domain $udomUser $uname at Domain $udomCurrent Session Value
($csuname at $csudom)
Resource Level in Coursein Section/Group $csecin Section/Group $csec
Assessment URL and TitleType Enclosing MapPart No.Parameter Name defaultfrom Enclosing Map generalfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resource
generalfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resource
'. + join(' / ',split(/\//,$uri)). + '

'. + $bighash{'title_'.$rid}); + if ($thistitle) { + $r->print(' ('.$thistitle.')'); } - my $totalparms=scalar keys %name; - if ($totalparms>0) { - my $firstrow=1; - $r->print('

'. - join(' / ',split(/\//,$uri)). - '

'. - $bighash{'title_'.$rid}); - if ($thistitle) { - $r->print(' ('.$thistitle.')'); - } - $r->print('

'.$typep{$rid}.''. - join(' / ',split(/\//,$mapp{$rid})).'
$part{$_}$display{$_}'. - &valout($outpar[11],$type{$_}).''. - &valout($outpar[10],$type{$_}).''. - &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1', - 'parmform.pres','psub').''.&valout($outpar[$result],$type{$_}).''.$sessionval.' '. - '
'.$typep{$rid}.''. + join(' / ',split(/\//,$mapp{$rid})).'
'); } - $r->print(''); - untie(%bighash); - untie(%parmhash); + $r->print(''); } + $r->print(''); + untie(%bighash); + untie(%parmhash); } sub crsenv { @@ -913,7 +905,7 @@ parmval() : figure out a cascading param =item * -valout() : output for value +valout() : format a value for output =item *