--- loncom/interface/lonparmset.pm 2000/11/20 22:56:01 1.1 +++ loncom/interface/lonparmset.pm 2000/11/24 20:00:27 1.10 @@ -9,7 +9,7 @@ # # 10/11,10/12,10/16 Gerd Kortemeyer) # -# 11/20 Gerd Kortemeyer +# 11/20,11/21,11/22,11/23,11/24,11/25 Gerd Kortemeyer package Apache::lonparmset; @@ -17,6 +17,133 @@ 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 @outpar; + +my @ids; +my %symbp; +my %mapp; +my %typep; + +my $uname; +my $udom; +my $uhome; + +my $csec; + +my $fcat; + +# -------------------------------------------- Figure out a cascading parameter + +sub parmval { + my ($what,$id)=@_; + my $result=''; +# ----------------------------------------------------- Cascading lookup scheme + + my $symbparm=$symbp{$id}.'.'.$what; + my $mapparm=$mapp{$id}.'___(all).'.$what; + + my $seclevel= + $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 + + if ($uname) { + if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; + $result=1; } + if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; + $result=2; } + if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel}; + $result=3; } + } + +# -------------------------------------------------------- second, check course + + if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr}; + $result=4; } + if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm}; + $result=5; } + if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel}; + $result=6; } + + if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; + $result=7; } + if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; + $result=8; } + if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel}; + $result=9; } + +# ------------------------------------------------------ third, check map parms + + my $thisparm=$parmhash{$symbparm}; + if ($thisparm) { $outpar[10]=$thisparm; + $result=10; } + +# --------------------------------------------- last, look in resource metadata + + my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta'; + if (-e $filename) { + my @content; + { + my $fh=Apache::File->new($filename); + @content=<$fh>; + } + if (join('',@content)=~ + /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) { + $outpar[11]=$1; + $result=11; + } + } + return $result; +} + +# ---------------------------------------------------------------- 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 @@ -33,21 +160,240 @@ sub handler { if (($ENV{'request.course.fn'}) && (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { +# -------------------------------------------------------- Variable declaration - my %bighash; - if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', - &GDBM_READER,0640)) { + %courseopt=(); + %useropt=(); + %bighash=(); + + @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= + "