# 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,11/23 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);
}
}
# -------------------------------------------------------- Produces link anchor
sub plink {
my ($type,$dis,$value,$marker,$return,$call)=@_;
return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"
.$marker."','".$return."','".$call."'".');">'.
(($type=~/^date/)?localtime($value):$value).'</a>';
}
# ================================================================ 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(<<ENDHEAD);
<html>
<head>
<title>LON-CAPA Assessment Parameters</title>
<script>
function pclose() {
parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
"height=350,width=350,scrollbars=no,menubar=no");
parmwin.close();
}
function pjump(type,dis,value,marker,ret,call) {
parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
+"&value="+escape(value)+"&marker="+escape(marker)
+"&return="+escape(ret)
+"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
"height=350,width=350,scrollbars=no,menubar=no");
}
</script>
</head>
<body bgcolor="#FFFFFF" onUnload="pclose()">
<h1>Set Assessment Parameters</h1>
ENDHEAD
$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("\n<table border=2>\n<tr>");
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('<td rowspan='.$totalparms.'><tt><font size=-1>'.
$bighash{'src_'.$rid}.'</font></tt><p><b>'.
$bighash{'title_'.$rid});
if ($thistitle) {
$r->print(' ('.$thistitle.')');
}
$r->print('</b></td>');
my $i;
for ($i=0;$i<$totalparms;$i++) {
$r->print("<td>$part[$i]</td><td>$display[$i]</td>");
$r->print('<td>'.&plink($type[$i],$display[$i],'987684455').'</td>');
$r->print("</tr>\n<tr>");
}
# -------------------------------------------------- End entry for one resource
} @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/parmset:opa:0:0:Cannot modify assessment parameters";
return HTTP_NOT_ACCEPTABLE;
}
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>