--- loncom/interface/lonparmset.pm 2000/11/21 12:22:29 1.2 +++ loncom/interface/lonparmset.pm 2000/11/24 21:41:43 1.11 @@ -9,7 +9,7 @@ # # 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 Gerd Kortemeyer package Apache::lonparmset; @@ -17,17 +17,20 @@ use strict; use Apache::lonnet; use Apache::Constants qw(:common :http REDIRECT); use GDBM_File; +use Apache::lonmeta; + 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 $uname; my $udom; @@ -35,53 +38,114 @@ 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'}.'.['. + $ENV{'request.course.sec'}.'].'.$what; + my $seclevelr= + $ENV{'request.course.id'}.'.['. + $ENV{'request.course.sec'}.'].'.$symbparm; + my $seclevelm= + $ENV{'request.course.id'}.'.['. + $ENV{'request.course.sec'}.'].'.$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; - } - } - return ''; +# ---------------------------------------------------------------- Sort routine + +sub bycat { + if ($fcat eq '') { + $a<=>$b; + } else { + &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); + } +} + +# ------------------------------------------------------------ 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)=@_; + return ''. + &valout($value,$type).''; } # ================================================================ Main Handler @@ -105,21 +169,28 @@ sub handler { %useropt=(); %bighash=(); - @srcp=(); - @typep=(); - @resp=(); - @mapp=(); - @symbp=(); + @ids=(); + %symbp=(); + %typep=(); $uname=$ENV{'form.uname'}; $udom=$ENV{'form.udom'}; unless ($udom) { $uname=''; } $uhome=''; + my $message=''; if ($uname) { $uhome=&Apache::lonnet::homeserver($uname,$udom); } + if ($uhome eq 'no_host') { + $message= + "

Unknown user '$uname' at domain '$udom'

"; + $uname=''; + } $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', @@ -154,32 +225,190 @@ sub handler { if ($_=~/^src\_(\d+)\.(\d+)$/) { my $mapid=$1; my $resid=$2; + my $id=$mapid.'.'.$resid; 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]; + $ids[$#ids+1]=$id; + $typep{$id}=$1; + $mapp{$id}= + &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); + $symbp{$id}=$mapp{$id}. + '___'.$resid.'___'. + &Apache::lonnet::declutter($bighash{$_}); } } } keys %bighash; # ------------------------------------------------------------------- Sort this - + @ids=sort bycat @ids; # ------------------------------------------------------------------ Start page $r->content_type('text/html'); $r->send_http_header; - $r->print(''); - - $r->print(''); + $r->print(< + +LON-CAPA Assessment Parameters + + + +

Set Assessment Parameters

+
+

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

+ +Section/Group: + +
+For User + +at Domain + +
+ENDHEAD + + if ($uhome eq 'no_host') { + $r->print($message); + } + $r->print('

Sort list by '); + $r->print(''); +# ----------------------------------------------------------------- Start Table + 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(''); + map { +# ------------------------------------------------------ Entry for one resource + @outpar=(); + my $rid=$_; + my $thistitle=''; + my %name= ('0_deadline' => 'deadline'); + my %part= ('0_deadline' => '0'); + my %display=('0_deadline' => 'Deadline'); + my %type= ('0_deadline' => 'date_end'); + my %default=('0_deadline' => time); + my %metadata=&Apache::lonmeta::unpackagemeta( +&Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1); + map { + if ($_=~/^parameter\_(\d+)\_(\w+)$/) { + my $hashid=$1.'_'.$2; + $part{$hashid}=$1; + $name{$hashid}=$2; + my $tdef; + ($tdef,$display{$hashid})= + split(/\_\_dis\_\_/,$metadata{$_}); + ($type{$hashid},$default{$hashid})=split(/\:/,$tdef); + unless ($display{$hashid}) { + $display{$hashid}=$name{$hashid}; + } + } + if ($_ eq 'title') { + $thistitle=$metadata{$_}; + } + } keys %metadata; + my $totalparms=scalar keys %name; + $r->print(''); + $r->print(''); + $r->print(''); + map { + + my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_}); + + $r->print(""); + + $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; +# -------------------------------------------------- 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(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))). + '

'. + $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]).''. + &plink($type{$_},$display{$_},$outpar[8]).''. + &plink($type{$_},$display{$_},$outpar[7]).''. + &plink($type{$_},$display{$_},$outpar[6]).''. + &plink($type{$_},$display{$_},$outpar[5]).''. + &plink($type{$_},$display{$_},$outpar[4]).''. + &plink($type{$_},$display{$_},$outpar[3]).''. + &plink($type{$_},$display{$_},$outpar[2]).''. + &plink($type{$_},$display{$_},$outpar[1]).''.&valout($outpar[$result],$type{$_}).'
'); 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 +419,4 @@ __END__ - - -