# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
# (Handler to resolve ambiguous file locations
#
# (TeX Content Handler
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 10/11,10/12,10/16 Gerd Kortemeyer)
#
# 11/20,11/21,11/22 Gerd Kortemeyer
package Apache::lonparmset;
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);
}
}
# ================================================================ Main Handler
sub handler {
my $r=shift;
if ($r->header_only) {
$r->content_type('text/html');
$r->send_http_header;
return OK;
}
# ----------------------------------------------------- Needs to be in a course
if (($ENV{'request.course.fn'}) &&
(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
# -------------------------------------------------------- Variable declaration
%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=
"<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
$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(
'<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');
$r->print("<h2>Course: $ENV{'course.'.
$ENV{'request.course.id'}.'.description'}</h2>");
if ($csec) {
$r->print("<h3>Section/Group: $csec</h3>");
}
if ($uname) {
$r->print("<h3>For User $uname at Domain $udom");
}
if ($uhome eq 'no_host') {
$r->print($message);
}
$r->print('<table border=2>');
map {
$r->print('<tr>');
# ------------------------------------------------------ Entry for one resource
my %metadata=&Apache::lonmeta::unpackagemeta(
&Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$_}.'.meta'),1);
map {
if ($_=~/^parameter\_(\d+)\_(\w+)\_\_dis\_\_(.+)$/) {
my $part=$1;
my $name=$2;
my $display=$3;
my $type=$metadata{$_};
}
} keys %metadata;
# -------------------------------------------------- End entry for one resource
$r->print('</tr>');
} @ids;
$r->print('</table></body></html>');
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";
return HTTP_NOT_ACCEPTABLE;
}
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>