--- loncom/interface/lonparmset.pm 2000/11/21 12:22:29 1.2 +++ loncom/interface/lonparmset.pm 2001/05/10 01:06:06 1.29 @@ -9,7 +9,9 @@ # # 10/11,10/12,10/16 Gerd Kortemeyer) # -# 11/20,11/21 Gerd Kortemeyer +# 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28, +# 12/08,12/12, +# 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09 Gerd Kortemeyer package Apache::lonparmset; @@ -18,16 +20,23 @@ use Apache::lonnet; use Apache::Constants qw(:common :http REDIRECT); use GDBM_File; + my %courseopt; my %useropt; my %bighash; my %parmhash; -my @srcp; -my @typep; -my @resp; -my @mapp; -my @symbp; +my @outpar; + +my @ids; +my %symbp; +my %mapp; +my %typep; +my %keyp; +my %defp; + +my %allkeys; +my %allmaps; my $uname; my $udom; @@ -35,53 +44,113 @@ my $uhome; my $csec; +my $fcat; + # -------------------------------------------- Figure out a cascading parameter sub parmval { - my ($what,$idx)=@_; + my ($what,$id,$def)=@_; + my $result=''; + @outpar=(); # ----------------------------------------------------- Cascading lookup scheme - my $symbparm=$symbp[$idx].'.'.$what; - my $reslevel= - $ENV{'request.course.id'}.'.'.$symbparm; + + my $symbparm=$symbp{$id}.'.'.$what; + my $mapparm=$mapp{$id}.'___(all).'.$what; + my $seclevel= - $ENV{'request.course.id'}.'.'. - $ENV{'request.course.sec'}.'.'.$what; + $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 user +# -------------------------------------------------------- first, check default - if ($useropt{$reslevel}) { return $useropt{$reslevel}; } - if ($useropt{$seclevel}) { return $useropt{$seclevel}; } - if ($useropt{$courselevel}) { return $useropt{$courselevel}; } + if ($def) { $outpar[11]=$def; + $result=11; } -# -------------------------------------------------------- second, check course +# ----------------------------------------------------- second, check map parms - if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; } - if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } - if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } + my $thisparm=$parmhash{$symbparm}; + if ($thisparm) { $outpar[10]=$thisparm; + $result=10; } -# ------------------------------------------------------ third, check map parms +# --------------------------------------------------------- third, check course - my $thisparm=$parmhash{$symbparm}; - if ($thisparm) { return $thisparm; } + if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel}; + $result=9; } + + if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; + $result=8; } + + if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; + $result=7; } + + if ($csec) { + + if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel}; + $result=6; } + + if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm}; + $result=5; } + + if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr}; + $result=4; } + + } + +# ---------------------------------------------------------- fourth, check user + + if ($uname) { + + if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel}; + $result=3; } + + if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; + $result=2; } + + if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; + $result=1; } + } -# --------------------------------------------- last, look in resource metadata + return $result; +} - my $filename='/home/httpd/res/'.$srcp[$idx].'.meta'; - if (-e $filename) { - my @content; - { - my $fh=Apache::File->new($filename); - @content=<$fh>; - } - if (join('',@content)=~ - /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) { - return $1; - } +# ------------------------------------------------------------ Output for value + +sub valout { + my ($value,$type)=@_; + return + ($value?(($type=~/^date/)?localtime($value):$value):'  '); +} + +# -------------------------------------------------------- Produces link anchor + +sub plink { + my ($type,$dis,$value,$marker,$return,$call)=@_; + my $winvalue=$value; + unless ($winvalue) { + if ($type=~/^date/) { + $winvalue=$ENV{'form.recent_'.$type}; + } else { + $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]}; } - return ''; + } + return + ''. + &valout($value,$type).''; } # ================================================================ Main Handler @@ -105,21 +174,77 @@ sub handler { %useropt=(); %bighash=(); - @srcp=(); - @typep=(); - @resp=(); - @mapp=(); - @symbp=(); + @ids=(); + %symbp=(); + %typep=(); + + my $message=''; - $uname=$ENV{'form.uname'}; + $csec=$ENV{'form.csec'}; $udom=$ENV{'form.udom'}; + unless ($udom) { $udom=$r->dir_config('lonDefDomain'); } + + my $pscat=$ENV{'form.pscat'}; + my $pschp=$ENV{'form.pschp'}; + my $pssymb=''; + +# ----------------------------------------------- Was this started from grades? + + 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); + $pscat='all'; + $pschp=''; + } else { + $ENV{'form.url'}=''; + } + + my $id=$ENV{'form.id'}; + if (($id) && ($udom)) { + $uname=(&Apache::lonnet::idget($udom,$id))[1]; + if ($uname) { + $id=''; + } else { + $message= + "Unknown ID '$id' at domain '$udom'"; + } + } else { + $uname=$ENV{'form.uname'}; + } unless ($udom) { $uname=''; } $uhome=''; if ($uname) { $uhome=&Apache::lonnet::homeserver($uname,$udom); + + if ($uhome eq 'no_host') { + $message= + "Unknown user '$uname' at domain '$udom'"; + $uname=''; + } else { + $csec=&Apache::lonnet::usection( + $udom,$uname,$ENV{'request.course.id'}); + if ($csec eq '-1') { + $message="". + "User '$uname' at domain '$udom' not in this course"; + $uname=''; + $csec=$ENV{'form.csec'}; + } else { + my %name=&Apache::lonnet::userenvironment($udom,$uname, + ('firstname','middlename','lastname','generation','id')); + $message="\n

\nFull Name: ". + $name{'firstname'}.' '.$name{'middlename'} + .$name{'lastname'}.' '.$name{'generation'}. + "
\nID: ".$name{'id'}.'

'; + } + } } - $csec=$ENV{'form.csec'}; + unless ($csec) { $csec=''; } + + $fcat=$ENV{'form.fcat'}; + unless ($fcat) { $fcat=''; } # ------------------------------------------------------------------- Tie hashs if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', @@ -127,6 +252,138 @@ sub handler { (tie(%parmhash,'GDBM_File', $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { +# --------------------------------------------------------- Get all assessments + undef %allkeys; + undef %allmaps; + undef %defp; + map { + 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}=''; + map { + 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; + } + } + } split(/\,/, + &Apache::lonnet::metadata($srcf,'keys')); + $mapp{$id}= + &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); + $allmaps{$mapid}=$mapp{$id}; + $symbp{$id}=$mapp{$id}. + '___'.$resid.'___'. + &Apache::lonnet::declutter($srcf); + } + } + } keys %bighash; +# ---------------------------------------------------------- Anything to store? + if ($ENV{'form.pres_marker'}) { + my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'}); + $spnam=~s/\_/\./; +# ---------------------------------------------------------- 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 $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 + $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'); + } + +# Store parameter + $reply= + &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'. + $storecontent,$uhome); + } + + if ($reply=~/^error\:(.*)/) { + $message.="Write Error: $1"; + } +# ---------------------------------------------------------------- Done storing + } # -------------------------------------------------------------- Get coursedata my $reply=&Apache::lonnet::reply('dump:'. $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. @@ -135,7 +392,8 @@ sub handler { if ($reply!~/^error\:/) { map { my ($name,$value)=split(/\=/,$_); - $courseopt{unescape($name)}=unescape($value); + $courseopt{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); } split(/\&/,$reply); } # --------------------------------------------------- Get userdata (if present) @@ -145,41 +403,303 @@ sub handler { if ($reply!~/^error\:/) { map { my ($name,$value)=split(/\=/,$_); - $useropt{unescape($name)}=unescape($value); + $useropt{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); } split(/\&/,$reply); } } -# --------------------------------------------------------- Get all assessments - map { - if ($_=~/^src\_(\d+)\.(\d+)$/) { - my $mapid=$1; - my $resid=$2; - if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) { - $typep[$#typep+1]=$1; - $mapp[$#mapp+1]=$mapid; - $resp[$#resp+1]=$resid; - $srcp[$#srcp+1]=&Apache::lonnet::declutter($bighash{$_}); - $symbp[$#symbp+1]= - &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). - '___'.$resid.'___'.$srcp[$#srcp]; - } - } - } keys %bighash; + # ------------------------------------------------------------------- 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; + # ------------------------------------------------------------------ Start page $r->content_type('text/html'); $r->send_http_header; - $r->print(''); + $r->print(< + +LON-CAPA Assessment Parameters + + + +

Set Assessment Parameters

+
+

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

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

'.$message.'

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

' + ); + if (($pscat) || ($pschp) || ($pssymb)) { +# ----------------------------------------------------------------- Start Table + my $catmarker='parameter_'.$pscat; + $catmarker=~s/\./\_/g; + my $coursespan=$csec?8:5; + $r->print(< + + +ENDTABLEHEAD + if ($uname) { + $r->print(""); + } + $r->print(<Parameter in Effect + + +ENDTABLETWO + if ($csec) { + $r->print(""); + } + $r->print(< + + + +ENDTABLEHEADFOUR + if ($csec) { + $r->print(''); + } + if ($uname) { + $r->print(''); + } + $r->print(''); + my $defbgone=''; + my $defbgtwo=''; + map { + 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}))) { +# ------------------------------------------------------ Entry for one resource + if ($defbgone eq '"E0E099"') { + $defbgone='"E0E0DD"'; + } else { + $defbgone='"E0E099"'; + } + if ($defbgtwo eq '"FFFF99"') { + $defbgtwo='"FFFFDD"'; + } else { + $defbgtwo='"FFFF99"'; + } + @outpar=(); + my $thistitle=''; + my %name= (); + my %part= (); + my %display=(); + my %type= (); + my %default=(); + my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); + + map { + $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'); + } split(/\,/,$keyp{$rid}); + + my $totalparms=scalar keys %name; + my $isdef=1; + unless ($totalparms) { $totalparms=1; $isdef=0; } + if ($pscat ne 'all') { $totalparms=1; } + $r->print(''); + $r->print(''); + $r->print(''); + if ($isdef) { + map { + if (($_ eq $catmarker) || ($pscat eq 'all')) { + my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_}); + + $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( + ''); + $r->print("\n"); + } + } sort keys %name; + } else { + $r->print("\n"); + } +# -------------------------------------------------- End entry for one resource + } + } @ids; + $r->print('
Any UserUser $uname at Domain $udom
Resource Levelin Coursein Section/Group $csec
Assessment URL and TitleTypeEnclosing MapPart No.Parameter Namedefaultfrom Enclosing Mapgeneralfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resource
'. + 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{$_}).'
'); + } + $r->print(''); untie(%bighash); untie(%parmhash); } } else { # ----------------------------- Not in a course, or not allowed to modify parms $ENV{'user.error.msg'}= - "/adm/flip:opa:0:0:Cannot modify assessment parameters"; + "/adm/parmset:opa:0:0:Cannot modify assessment parameters"; return HTTP_NOT_ACCEPTABLE; } return OK; @@ -190,7 +710,4 @@ __END__ - - -