--- loncom/interface/lonparmset.pm 2000/11/20 22:56:01 1.1 +++ loncom/interface/lonparmset.pm 2000/11/23 20:50:41 1.7 @@ -9,7 +9,7 @@ # # 10/11,10/12,10/16 Gerd Kortemeyer) # -# 11/20 Gerd Kortemeyer +# 11/20,11/21,11/22,11/23 Gerd Kortemeyer package Apache::lonparmset; @@ -17,6 +17,94 @@ 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 @ids; +my %symbp; +my %typep; + +my $uname; +my $udom; +my $uhome; + +my $csec; + +my $fcat; + +# -------------------------------------------- Figure out a cascading parameter + +sub parmval { + my ($what,$id)=@_; +# ----------------------------------------------------- Cascading lookup scheme + my $symbparm=$symbp{$id}.'.'.$what; + my $reslevel= + $ENV{'request.course.id'}.'.'.$symbparm; + my $seclevel= + $ENV{'request.course.id'}.'.'. + $ENV{'request.course.sec'}.'.'.$what; + my $courselevel= + $ENV{'request.course.id'}.'.'.$what; + +# ----------------------------------------------------------- first, check user + + if ($uname) { + if ($useropt{$reslevel}) { return $useropt{$reslevel}; } + if ($useropt{$seclevel}) { return $useropt{$seclevel}; } + if ($useropt{$courselevel}) { return $useropt{$courselevel}; } + } + +# -------------------------------------------------------- second, check course + + if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; } + if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } + if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } + +# ------------------------------------------------------ third, check map parms + + my $thisparm=$parmhash{$symbparm}; + if ($thisparm) { return $thisparm; } + +# --------------------------------------------- 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\>/) { + return $1; + } + } + return ''; +} + +# ---------------------------------------------------------------- Sort routine + +sub bycat { + if ($fcat eq '') { + $a<=>$b; + } else { + &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); + } +} + +# -------------------------------------------------------- Produces link anchor + +sub plink { + my ($type,$dis,$value,$marker,$return,$call)=@_; + return ''. + (($type=~/^date/)?localtime($value):$value).''; +} # ================================================================ Main Handler @@ -33,21 +121,168 @@ sub handler { if (($ENV{'request.course.fn'}) && (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { +# -------------------------------------------------------- Variable declaration + + %courseopt=(); + %useropt=(); + %bighash=(); - my %bighash; - if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', - &GDBM_READER,0640)) { + @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', + &GDBM_READER,0640)) && + (tie(%parmhash,'GDBM_File', + $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { + +# -------------------------------------------------------------- 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\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $courseopt{unescape($name)}=unescape($value); + } split(/\&/,$reply); + } +# --------------------------------------------------- Get userdata (if present) + if ($uname) { + my $reply= + &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); + if ($reply!~/^error\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $useropt{unescape($name)}=unescape($value); + } split(/\&/,$reply); + } + } +# --------------------------------------------------------- Get all assessments + map { + if ($_=~/^src\_(\d+)\.(\d+)$/) { + my $mapid=$1; + my $resid=$2; + my $id=$mapid.'.'.$resid; + if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) { + $ids[$#ids+1]=$id; + $typep{$id}=$1; + $symbp{$id}= + &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). + '___'.$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(< + +LON-CAPA Assessment Parameters + + + +

Set Assessment Parameters

+ENDHEAD + $r->print("

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

"); + if ($csec) { + $r->print("

Section/Group: $csec

"); + } + if ($uname) { + $r->print("

For User $uname at Domain $udom"); + } + if ($uhome eq 'no_host') { + $r->print($message); + } + $r->print("\n\n"); + map { +# ------------------------------------------------------ Entry for one resource + my $rid=$_; + my $thistitle=''; + my @part=(0,1,1); + my @name=('deadline','sig','tol'); + my @display=('Deadline','Significant Figures','Tolerance'); + my @type=('date','int','tolerance'); + my %metadata=&Apache::lonmeta::unpackagemeta( +&Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1); + map { + if ($_=~/^parameter\_(\d+)\_(\w+)$/) { + $part[$#part+1]=$1; + $name[$#name+1]=$2; + ($type[$#type+1],$display[$#display+1])= + split(/\_\_dis\_\_/,$metadata{$_}); + unless ($display[$#display]) { + $display[$#display]=$name[$#name]; + } + } + if ($_ eq 'title') { + $thistitle=$metadata{$_}; + } + } keys %metadata; + my $totalparms=$#name+1; + $r->print(''); + my $i; + for ($i=0;$i<$totalparms;$i++) { + $r->print(""); + $r->print(''); + $r->print("\n"); + } +# -------------------------------------------------- End entry for one resource + } @ids; + $r->print('
'. + $bighash{'src_'.$rid}.'

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

$part[$i]$display[$i]'.&plink($type[$i],$display[$i],'987684455').'
'); 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;