version 1.1, 2000/11/20 22:56:01
|
version 1.7, 2000/11/23 20:50:41
|
Line 9
|
Line 9
|
# |
# |
# 10/11,10/12,10/16 Gerd Kortemeyer) |
# 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; |
package Apache::lonparmset; |
|
|
Line 17 use strict;
|
Line 17 use strict;
|
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::Constants qw(:common :http REDIRECT); |
use Apache::Constants qw(:common :http REDIRECT); |
use GDBM_File; |
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 |
# ================================================================ Main Handler |
|
|
Line 33 sub handler {
|
Line 121 sub handler {
|
|
|
if (($ENV{'request.course.fn'}) && |
if (($ENV{'request.course.fn'}) && |
(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { |
(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { |
|
# -------------------------------------------------------- Variable declaration |
|
|
|
%courseopt=(); |
|
%useropt=(); |
|
%bighash=(); |
|
|
my %bighash; |
@ids=(); |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
%symbp=(); |
&GDBM_READER,0640)) { |
%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->content_type('text/html'); |
$r->send_http_header; |
$r->send_http_header; |
$r->print('<html><body bgcolor="#FFFFFF">'); |
$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"); |
|
|
$r->print('</body></html>'); |
} |
|
</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(%bighash); |
|
untie(%parmhash); |
} |
} |
} else { |
} else { |
# ----------------------------- Not in a course, or not allowed to modify parms |
# ----------------------------- Not in a course, or not allowed to modify parms |
$ENV{'user.error.msg'}= |
$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 HTTP_NOT_ACCEPTABLE; |
} |
} |
return OK; |
return OK; |