version 1.9, 2000/11/24 17:22:13
|
version 1.63, 2002/08/19 23:01:27
|
Line 1
|
Line 1
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Handler to set parameters for assessments |
# Handler to set parameters for assessments |
# |
# |
# (Handler to resolve ambiguous file locations |
# $Id$ |
# |
# |
# (TeX Content Handler |
# Copyright Michigan State University Board of Trustees |
# |
# |
# 05/29/00,05/30,10/11 Gerd Kortemeyer) |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# |
# |
# 10/11,10/12,10/16 Gerd Kortemeyer) |
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
# |
# |
# 11/20,11/21,11/22,11/23,11/24,11/25 Gerd Kortemeyer |
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
################################################################### |
|
################################################################### |
|
|
|
=pod |
|
|
|
=head1 NAME |
|
|
|
lonparmset - Handler to set parameters for assessments and course |
|
|
|
=head1 SYNOPSIS |
|
|
|
lonparmset provides an interface to setting course parameters. |
|
|
|
=head1 DESCRIPTION |
|
|
|
This module sets coursewide and assessment parameters. |
|
|
|
=head1 INTERNAL SUBROUTINES |
|
|
|
=over 4 |
|
|
|
=cut |
|
|
|
################################################################### |
|
################################################################### |
|
|
package Apache::lonparmset; |
package Apache::lonparmset; |
|
|
use strict; |
use strict; |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::Constants qw(:common :http REDIRECT); |
use Apache::Constants qw(:common :http REDIRECT); |
|
use Apache::loncommon; |
use GDBM_File; |
use GDBM_File; |
use Apache::lonmeta; |
use Apache::lonhomework; |
|
use Apache::lonxml; |
|
|
|
|
my %courseopt; |
my %courseopt; |
my %useropt; |
my %useropt; |
my %bighash; |
|
my %parmhash; |
my %parmhash; |
|
|
my @outpar; |
|
|
|
my @ids; |
my @ids; |
my %symbp; |
my %symbp; |
|
my %mapp; |
my %typep; |
my %typep; |
|
my %keyp; |
|
|
my $uname; |
my $uname; |
my $udom; |
my $udom; |
my $uhome; |
my $uhome; |
|
|
my $csec; |
my $csec; |
|
my $coursename; |
|
|
|
################################################## |
|
################################################## |
|
|
my $fcat; |
=pod |
|
|
# -------------------------------------------- Figure out a cascading parameter |
=item parmval |
|
|
|
Figure out a cascading parameter. |
|
|
|
Inputs: $what $id $def |
|
|
|
Returns: I am not entirely sure. |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
sub parmval { |
sub parmval { |
my ($what,$id)=@_; |
my ($what,$id,$def)=@_; |
my $result=''; |
my $result=''; |
|
my @outpar=(); |
# ----------------------------------------------------- Cascading lookup scheme |
# ----------------------------------------------------- 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}) { $result=$useropt{$reslevel}; |
|
$outpar[1]=$result; } |
|
if ($useropt{$seclevel}) { $result=$useropt{$seclevel}; |
|
$outpar[2]=$result; } |
|
if ($useropt{$courselevel}) { $result=$useropt{$courselevel}; |
|
$outpar[3]=$result; } |
|
} |
|
# -------------------------------------------------------- second, check course |
|
|
|
if ($courseopt{$reslevel}) { $result=$courseopt{$reslevel}; |
|
$outpar[4]=$result; } |
|
if ($courseopt{$seclevel}) { $result=$courseopt{$seclevel}; |
|
$outpar[5]=$result; } |
|
if ($courseopt{$courselevel}) { $result=$courseopt{$courselevel}; |
|
$outpar[6]=$result; } |
|
|
|
# ------------------------------------------------------ third, check map parms |
|
|
|
my $thisparm=$parmhash{$symbparm}; |
|
if ($thisparm) { $result=$thisparm; |
|
$outpar[7]=$result; } |
|
|
|
# --------------------------------------------- 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\>/) { |
|
$result=$1; |
|
$outpar[8]=$result; |
|
} |
|
} |
|
return $result; |
|
} |
|
|
|
# ---------------------------------------------------------------- Sort routine |
my $symbparm=$symbp{$id}.'.'.$what; |
|
my $mapparm=$mapp{$id}.'___(all).'.$what; |
|
|
sub bycat { |
my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what; |
if ($fcat eq '') { |
my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm; |
$a<=>$b; |
my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm; |
} else { |
|
&parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); |
my $courselevel=$ENV{'request.course.id'}.'.'.$what; |
|
my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; |
|
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
|
|
|
# -------------------------------------------------------- first, check default |
|
|
|
if ($def) { $outpar[11]=$def; $result=11; } |
|
|
|
# ----------------------------------------------------- second, check map parms |
|
|
|
my $thisparm=$parmhash{$symbparm}; |
|
if ($thisparm) { $outpar[10]=$thisparm; $result=10; } |
|
|
|
# --------------------------------------------------------- third, check course |
|
|
|
if ($courseopt{$courselevel}) { |
|
$outpar[9]=$courseopt{$courselevel}; |
|
$result=9; |
} |
} |
|
|
|
if ($courseopt{$courselevelm}) { |
|
$outpar[8]=$courseopt{$courselevelm}; |
|
$result=8; |
|
} |
|
|
|
if ($courseopt{$courselevelr}) { |
|
$outpar[7]=$courseopt{$courselevelr}; |
|
$result=7; |
|
} |
|
|
|
if ($csec) { |
|
if ($courseopt{$seclevel}) { |
|
$outpar[6]=$courseopt{$seclevel}; |
|
$result=6; |
|
} |
|
if ($courseopt{$seclevelm}) { |
|
$outpar[5]=$courseopt{$seclevelm}; |
|
$result=5; |
|
} |
|
|
|
if ($courseopt{$seclevelr}) { |
|
$outpar[4]=$courseopt{$seclevelr}; |
|
$result=4; |
|
} |
|
} |
|
|
|
# ---------------------------------------------------------- fourth, check user |
|
|
|
if ($uname) { |
|
if ($useropt{$courselevel}) { |
|
$outpar[3]=$useropt{$courselevel}; |
|
$result=3; |
|
} |
|
|
|
if ($useropt{$courselevelm}) { |
|
$outpar[2]=$useropt{$courselevelm}; |
|
$result=2; |
|
} |
|
|
|
if ($useropt{$courselevelr}) { |
|
$outpar[1]=$useropt{$courselevelr}; |
|
$result=1; |
|
} |
|
} |
|
|
|
return ($result,@outpar); |
} |
} |
|
|
# ------------------------------------------------------------ Output for value |
################################################## |
|
################################################## |
|
|
|
=pod |
|
|
|
=item valout |
|
|
|
Format a value for output. |
|
|
|
Inputs: $value, $type |
|
|
|
Returns: $value, formatted for output. If $type indicates it is a date, |
|
localtime($value) is returned. |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
sub valout { |
sub valout { |
my ($value,$type)=@_; |
my ($value,$type)=@_; |
return |
my $result = ''; |
($value?(($type=~/^date/)?localtime($value):$value):' '); |
# Values of zero are valid. |
|
if (! $value && $value ne '0') { |
|
$result = ' '; |
|
} else { |
|
if ($type=~/^date/) { |
|
$result = localtime($value); |
|
} else { |
|
$result = $value; |
|
} |
|
} |
|
return $result; |
} |
} |
|
|
# -------------------------------------------------------- Produces link anchor |
################################################## |
|
################################################## |
|
|
sub plink { |
=pod |
my ($type,$dis,$value,$marker,$return,$call)=@_; |
|
return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','" |
|
.$marker."','".$return."','".$call."'".');">'. |
|
&valout($value,$type).'</a>'; |
|
} |
|
|
|
# ================================================================ Main Handler |
=item plink |
|
|
sub handler { |
Produces a link anchor. |
my $r=shift; |
|
|
|
if ($r->header_only) { |
Inputs: $type,$dis,$value,$marker,$return,$call |
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
return OK; |
|
} |
|
|
|
# ----------------------------------------------------- Needs to be in a course |
Returns: scalar with html code for a link which will envoke the |
|
javascript function 'pjump'. |
|
|
if (($ENV{'request.course.fn'}) && |
=cut |
(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { |
|
# -------------------------------------------------------- Variable declaration |
|
|
|
%courseopt=(); |
################################################## |
%useropt=(); |
################################################## |
%bighash=(); |
sub plink { |
|
my ($type,$dis,$value,$marker,$return,$call)=@_; |
@ids=(); |
my $winvalue=$value; |
%symbp=(); |
unless ($winvalue) { |
%typep=(); |
if ($type=~/^date/) { |
|
$winvalue=$ENV{'form.recent_'.$type}; |
$uname=$ENV{'form.uname'}; |
} else { |
$udom=$ENV{'form.udom'}; |
$winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]}; |
unless ($udom) { $uname=''; } |
} |
$uhome=''; |
} |
my $message=''; |
return |
if ($uname) { |
'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','" |
$uhome=&Apache::lonnet::homeserver($uname,$udom); |
.$marker."','".$return."','".$call."'".');">'. |
} |
&valout($value,$type).'</a><a name="'.$marker.'"></a>'; |
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 |
sub startpage { |
my $reply=&Apache::lonnet::reply('dump:'. |
my ($r,$id,$udom,$csec,$uname)=@_; |
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. |
$r->content_type('text/html'); |
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata', |
$r->send_http_header; |
$ENV{'course.'.$ENV{'request.course.id'}.'.home'}); |
$r->print(<<ENDHEAD); |
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> |
<html> |
<head> |
<head> |
<title>LON-CAPA Assessment Parameters</title> |
<title>LON-CAPA Course Parameters</title> |
<script> |
<script> |
|
|
function pclose() { |
function pclose() { |
parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", |
parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", |
"height=350,width=350,scrollbars=no,menubar=no"); |
"height=350,width=350,scrollbars=no,menubar=no"); |
Line 229 sub handler {
|
Line 262 sub handler {
|
} |
} |
|
|
function pjump(type,dis,value,marker,ret,call) { |
function pjump(type,dis,value,marker,ret,call) { |
|
document.parmform.pres_marker.value=''; |
parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) |
parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) |
+"&value="+escape(value)+"&marker="+escape(marker) |
+"&value="+escape(value)+"&marker="+escape(marker) |
+"&return="+escape(ret) |
+"&return="+escape(ret) |
Line 236 sub handler {
|
Line 270 sub handler {
|
"height=350,width=350,scrollbars=no,menubar=no"); |
"height=350,width=350,scrollbars=no,menubar=no"); |
|
|
} |
} |
|
|
|
function psub() { |
|
pclose(); |
|
if (document.parmform.pres_marker.value!='') { |
|
document.parmform.action+='#'+document.parmform.pres_marker.value; |
|
var typedef=new Array(); |
|
typedef=document.parmform.pres_type.value.split('_'); |
|
if (document.parmform.pres_type.value!='') { |
|
if (typedef[0]=='date') { |
|
eval('document.parmform.recent_'+ |
|
document.parmform.pres_type.value+ |
|
'.value=document.parmform.pres_value.value;'); |
|
} else { |
|
eval('document.parmform.recent_'+typedef[0]+ |
|
'.value=document.parmform.pres_value.value;'); |
|
} |
|
} |
|
document.parmform.submit(); |
|
} else { |
|
document.parmform.pres_value.value=''; |
|
document.parmform.pres_marker.value=''; |
|
} |
|
} |
|
|
|
function openWindow(url, wdwName, w, h, toolbar,scrollbar) { |
|
var options = "width=" + w + ",height=" + h + ","; |
|
options += "resizable=yes,scrollbars="+scrollbar+",status=no,"; |
|
options += "menubar=no,toolbar="+toolbar+",location=no,directories=no"; |
|
var newWin = window.open(url, wdwName, options); |
|
newWin.focus(); |
|
} |
</script> |
</script> |
</head> |
</head> |
<body bgcolor="#FFFFFF" onUnload="pclose()"> |
<body bgcolor="#FFFFFF" onUnload="pclose()"> |
<h1>Set Assessment Parameters</h1> |
<h1>Set Course Parameters for Course: |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h1> |
|
<form method="post" action="/adm/parmset" name="envform"> |
|
<h3>Course Environment</h3> |
|
<input type="submit" name="crsenv" value="Set Course Environment"> |
|
</form> |
<form method="post" action="/adm/parmset" name="parmform"> |
<form method="post" action="/adm/parmset" name="parmform"> |
<h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2> |
<h3>Course Assessments</h3> |
<b> |
<b> |
Section/Group: |
Section/Group: |
<input type="text" value="$csec" size="6" name="csec" |
<input type="text" value="$csec" size="6" name="csec"> |
onBlur="this.form.submit();"> |
|
<br> |
<br> |
For User |
For User |
<input type="text" value="$uname" size="12" name="uname" |
<input type="text" value="$uname" size="12" name="uname"> |
onBlur="if (this.form.udom.value) { this.form.submit(); }"> |
or ID |
|
<input type="text" value="$id" size="12" name="id"> |
at Domain |
at Domain |
<input type="text" value="$udom" size="6" name="udom" |
<input type="text" value="$udom" size="6" name="udom"> |
onBlur="if (this.form.uname.value) { this.form.submit(); }"> |
|
</b> |
</b> |
|
<input type="hidden" value='' name="pres_value"> |
|
<input type="hidden" value='' name="pres_type"> |
|
<input type="hidden" value='' name="pres_marker"> |
ENDHEAD |
ENDHEAD |
|
|
if ($uhome eq 'no_host') { |
} |
$r->print($message); |
|
} |
sub print_row { |
$r->print('<p>Sort list by '); |
my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone, |
$r->print('<select name="fcat" onChange="this.form.submit();">'); |
$defbgtwo,$parmlev)=@_; |
my $k; |
my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which}, |
my @sopt=('map','Map','name','Problem Name','deadline','Deadline'); |
$rid,$$default{$which}); |
for ($k=0;$k<$#sopt;$k=$k+2) { |
my $parm=$$display{$which}; |
$r->print('<option value="'.$sopt[$k].'"'); |
|
if ($fcat eq $sopt[$k]) { $r->print(' selected'); } |
if ($parmlev eq 'full' || $parmlev eq 'brief') { |
$r->print('>'.$sopt[$k+1].'</option>'); |
$r->print('<td bgcolor='.$defbgtwo.' align="center">' |
} |
.$$part{$which}.'</td>'); |
$r->print('</select>'); |
} else { |
$r->print(<<ENDTABLEHEAD); |
$parm=~s|\[.*\]\s||g; |
<p><table border=2> |
|
<tr><th>Assessment URL and Title</th><th>Part No.</th><th>Parameter Name</th> |
|
<th>Resource Metadata</th><th>Enclosing Map Parameter</th> |
|
<th>Course</th> |
|
ENDTABLEHEAD |
|
if ($csec) { |
|
$r->print('<th>Section/Group: '.$csec.'</th>'); |
|
} |
} |
$r->print('<th>Resource in Course</th>'); |
|
|
$r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>'); |
|
|
|
my $thismarker=$which; |
|
$thismarker=~s/^parameter\_//; |
|
my $mprefix=$rid.'&'.$thismarker.'&'; |
|
|
|
if ($parmlev eq 'general') { |
|
|
|
if ($uname) { |
|
&print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} elsif ($csec) { |
|
&print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} else { |
|
&print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
} elsif ($parmlev eq 'map') { |
|
|
|
if ($uname) { |
|
&print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} elsif ($csec) { |
|
&print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} else { |
|
&print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
} else { |
|
|
|
&print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display); |
|
|
|
if ($parmlev eq 'brief') { |
|
|
|
&print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
|
|
if ($csec) { |
|
&print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
if ($uname) { |
|
&print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
} else { |
|
|
|
&print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
|
|
if ($csec) { |
|
&print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
if ($uname) { |
|
&print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
&print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); |
|
} |
|
} # end of $brief if/else |
|
} # end of $parmlev if/else |
|
|
|
if ($parmlev eq 'full' || $parmlev eq 'brief') { |
|
$r->print('<td bgcolor=#CCCCFF align="center">'. |
|
&valout($outpar[$result],$$type{$which}).'</td>'); |
|
} |
|
my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}. |
|
'.'.$$name{$which},$symbp{$rid}); |
|
$r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'. |
|
&valout($sessionval,$$type{$which}).' '. |
|
'</font></td>'); |
|
$r->print('</tr>'); |
|
$r->print("\n"); |
|
} |
|
|
|
sub print_td { |
|
my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_; |
|
$r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg). |
|
' align="center">'. |
|
&plink($$type{$value},$$display{$value},$$outpar[$which], |
|
$mprefix."$which",'parmform.pres','psub').'</td>'."\n"); |
|
} |
|
|
|
sub get_env_multiple { |
|
my ($name) = @_; |
|
my @values; |
|
if (defined($ENV{$name})) { |
|
# exists is it an array |
|
if (ref($ENV{$name})) { |
|
@values=@{ $ENV{$name} }; |
|
} else { |
|
$values[0]=$ENV{$name}; |
|
} |
|
} |
|
return(@values); |
|
} |
|
|
|
=pod |
|
|
|
=item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes. |
|
|
|
Input: See list below: |
|
|
|
=over 4 |
|
|
|
=item B<ids>: An array that will contain all of the ids in the course. |
|
|
|
=item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>. |
|
|
|
=item B<keyp>: hash, id->key list, will contain a comma seperated list of the meta-data keys available for the given id |
|
|
|
=item B<allparms>: hash, name of parameter->display value (what is the display value?) |
|
|
|
=item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]" |
|
|
|
=item B<allkeys>: hash, full key to part->display value (what's display value?) |
|
|
|
=item B<allmaps>: hash, ??? |
|
|
|
=item B<fcat>: ??? |
|
|
|
=item B<defp>: hash, ??? |
|
|
|
=item B<mapp>: ?? |
|
|
|
=item B<symbp>: hash, id->full sym? |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub extractResourceInformation { |
|
my $bighash = shift; |
|
my $ids = shift; |
|
my $typep = shift; |
|
my $keyp = shift; |
|
my $allparms = shift; |
|
my $allparts = shift; |
|
my $allkeys = shift; |
|
my $allmaps = shift; |
|
my $fcat = shift; |
|
my $defp = shift; |
|
my $mapp = shift; |
|
my $symbp = shift; |
|
|
|
foreach (keys %$bighash) { |
|
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
|
my $mapid=$1; |
|
my $resid=$2; |
|
my $id=$mapid.'.'.$resid; |
|
my $srcf=$$bighash{$_}; |
|
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { |
|
$$ids[$#$ids+1]=$id; |
|
$$typep{$id}=$1; |
|
$$keyp{$id}=''; |
|
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { |
|
if ($_=~/^parameter\_(.*)/) { |
|
my $key=$_; |
|
my $allkey=$1; |
|
$allkey=~s/\_/\./g; |
|
my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); |
|
my $name=&Apache::lonnet::metadata($srcf,$key.'.name'); |
|
my $part= &Apache::lonnet::metadata($srcf,$key.'.part'); |
|
my $parmdis = $display; |
|
$parmdis =~ s|(\[Part.*$)||g; |
|
my $partkey = $part; |
|
$partkey =~ tr|_|.|; |
|
$$allparms{$name} = $parmdis; |
|
$$allparts{$part} = "[Part $part]"; |
|
$$allkeys{$allkey}=$display; |
|
if ($allkey eq $fcat) { |
|
$$defp{$id}= &Apache::lonnet::metadata($srcf,$key); |
|
} |
|
if ($$keyp{$id}) { |
|
$$keyp{$id}.=','.$key; |
|
} else { |
|
$$keyp{$id}=$key; |
|
} |
|
} |
|
} |
|
$$mapp{$id}= |
|
&Apache::lonnet::declutter($$bighash{'map_id_'.$mapid}); |
|
$$mapp{$mapid}=$$mapp{$id}; |
|
$$allmaps{$mapid}=$$mapp{$id}; |
|
$$symbp{$id}=$$mapp{$id}. |
|
'___'.$resid.'___'. |
|
&Apache::lonnet::declutter($srcf); |
|
$$symbp{$mapid}=$$mapp{$id}.'___(all)'; |
|
} |
|
} |
|
} |
|
} |
|
|
|
################################################## |
|
################################################## |
|
|
|
=pod |
|
|
|
=item assessparms |
|
|
|
Show assessment data and parameters. This is a large routine that should |
|
be simplified and shortened... someday. |
|
|
|
Inputs: $r |
|
|
|
Returns: nothing |
|
|
|
Variables used (guessed by Jeremy): |
|
|
|
=over 4 |
|
|
|
=item B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type. |
|
|
|
=item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts? |
|
|
|
=item B<allmaps>: |
|
|
|
=back |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
|
sub assessparms { |
|
|
|
my $r=shift; |
|
# -------------------------------------------------------- Variable declaration |
|
my %allkeys; |
|
my %allmaps; |
|
my %alllevs; |
|
|
|
$alllevs{'Resource Level'}='full'; |
|
# $alllevs{'Resource Level [BRIEF]'}='brief'; |
|
$alllevs{'Map Level'}='map'; |
|
$alllevs{'Course Level'}='general'; |
|
|
|
my %allparms; |
|
my %allparts; |
|
|
|
my %defp; |
|
%courseopt=(); |
|
%useropt=(); |
|
my %bighash=(); |
|
|
|
@ids=(); |
|
%symbp=(); |
|
%typep=(); |
|
|
|
my $message=''; |
|
|
|
$csec=$ENV{'form.csec'}; |
|
$udom=$ENV{'form.udom'}; |
|
unless ($udom) { $udom=$r->dir_config('lonDefDomain'); } |
|
|
|
my @pscat=&get_env_multiple('form.pscat'); |
|
my $pschp=$ENV{'form.pschp'}; |
|
my @psprt=&get_env_multiple('form.psprt'); |
|
my $showoptions=$ENV{'form.showoptions'}; |
|
|
|
my $pssymb=''; |
|
my $parmlev=''; |
|
my $prevvisit=$ENV{'form.prevvisit'}; |
|
|
|
# unless ($parmlev==$ENV{'form.parmlev'}) { |
|
# $parmlev = 'full'; |
|
# } |
|
|
|
unless ($ENV{'form.parmlev'}) { |
|
$parmlev = 'map'; |
|
} else { |
|
$parmlev = $ENV{'form.parmlev'}; |
|
} |
|
|
|
# ----------------------------------------------- Was this started from grades? |
|
|
|
if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'}) |
|
&& (!$ENV{'form.dis'})) { |
|
my $url=$ENV{'form.url'}; |
|
$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; |
|
$pssymb=&Apache::lonnet::symbread($url); |
|
@pscat='all'; |
|
$pschp=''; |
|
$parmlev = 'full'; |
|
} elsif ($ENV{'form.symb'}) { |
|
$pssymb=$ENV{'form.symb'}; |
|
@pscat='all'; |
|
$pschp=''; |
|
$parmlev = 'full'; |
|
} else { |
|
$ENV{'form.url'}=''; |
|
} |
|
|
|
my $id=$ENV{'form.id'}; |
|
if (($id) && ($udom)) { |
|
$uname=(&Apache::lonnet::idget($udom,$id))[1]; |
if ($uname) { |
if ($uname) { |
$r->print('<th>User in Course</th>'); |
$id=''; |
if ($csec) { |
} else { |
$r->print('<th>User in Section/Group: '.$csec.'</th>'); |
$message= |
} |
"<font color=red>Unknown ID '$id' at domain '$udom'</font>"; |
$r->print('<th>User for Resource in Course</th>'); |
|
} |
} |
$r->print('<tr>'); |
} else { |
map { |
$uname=$ENV{'form.uname'}; |
|
} |
|
unless ($udom) { $uname=''; } |
|
$uhome=''; |
|
if ($uname) { |
|
$uhome=&Apache::lonnet::homeserver($uname,$udom); |
|
if ($uhome eq 'no_host') { |
|
$message= |
|
"<font color=red>Unknown user '$uname' at domain '$udom'</font>"; |
|
$uname=''; |
|
} else { |
|
$csec=&Apache::lonnet::usection($udom,$uname, |
|
$ENV{'request.course.id'}); |
|
if ($csec eq '-1') { |
|
$message="<font color=red>". |
|
"User '$uname' at domain '$udom' not ". |
|
"in this course</font>"; |
|
$uname=''; |
|
$csec=$ENV{'form.csec'}; |
|
} else { |
|
my %name=&Apache::lonnet::userenvironment($udom,$uname, |
|
('firstname','middlename','lastname','generation','id')); |
|
$message="\n<p>\nFull Name: ". |
|
$name{'firstname'}.' '.$name{'middlename'}.' ' |
|
.$name{'lastname'}.' '.$name{'generation'}. |
|
"<br>\nID: ".$name{'id'}.'<p>'; |
|
} |
|
} |
|
} |
|
|
|
unless ($csec) { $csec=''; } |
|
|
|
my $fcat=$ENV{'form.fcat'}; |
|
unless ($fcat) { $fcat=''; } |
|
|
|
# ------------------------------------------------------------------- Tie hashs |
|
if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
|
&GDBM_READER(),0640))) { |
|
$r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)"); |
|
return ; |
|
} |
|
if (!(tie(%parmhash,'GDBM_File', |
|
$ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) { |
|
$r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)"); |
|
return ; |
|
} |
|
|
|
# --------------------------------------------------------- Get all assessments |
|
extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp); |
|
|
|
$mapp{'0.0'} = ''; |
|
$symbp{'0.0'} = ''; |
|
# ---------------------------------------------------------- Anything to store? |
|
if ($ENV{'form.pres_marker'}) { |
|
my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'}); |
|
$spnam=~s/\_([^\_]+)$/\.$1/; |
|
# ---------------------------------------------------------- Construct prefixes |
|
|
|
my $symbparm=$symbp{$sresid}.'.'.$spnam; |
|
my $mapparm=$mapp{$sresid}.'___(all).'.$spnam; |
|
|
|
my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam; |
|
my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm; |
|
my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm; |
|
|
|
my $courselevel=$ENV{'request.course.id'}.'.'.$spnam; |
|
my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; |
|
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
|
|
|
my $storeunder=''; |
|
if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; } |
|
if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; } |
|
if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; } |
|
if ($snum==6) { $storeunder=$seclevel; } |
|
if ($snum==5) { $storeunder=$seclevelm; } |
|
if ($snum==4) { $storeunder=$seclevelr; } |
|
|
|
my %storecontent = ($storeunder => $ENV{'form.pres_value'}, |
|
$storeunder.'type' => $ENV{'form.pres_type'}); |
|
my $reply=''; |
|
if ($snum>3) { |
|
# ---------------------------------------------------------------- Store Course |
|
# |
|
# Expire sheets |
|
&Apache::lonnet::expirespread('','','studentcalc'); |
|
if (($snum==7) || ($snum==4)) { |
|
&Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid}); |
|
} elsif (($snum==8) || ($snum==5)) { |
|
&Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid}); |
|
} else { |
|
&Apache::lonnet::expirespread('','','assesscalc'); |
|
} |
|
# Store parameter |
|
$reply=&Apache::lonnet::cput |
|
('resourcedata',\%storecontent, |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); |
|
} else { |
|
# ------------------------------------------------------------------ Store User |
|
# |
|
# Expire sheets |
|
&Apache::lonnet::expirespread($uname,$udom,'studentcalc'); |
|
if ($snum==1) { |
|
&Apache::lonnet::expirespread |
|
($uname,$udom,'assesscalc',$symbp{$sresid}); |
|
} elsif ($snum==2) { |
|
&Apache::lonnet::expirespread |
|
($uname,$udom,'assesscalc',$mapp{$sresid}); |
|
} else { |
|
&Apache::lonnet::expirespread($uname,$udom,'assesscalc'); |
|
} |
|
# Store parameter |
|
$reply=&Apache::lonnet::cput |
|
('resourcedata',\%storecontent,$udom,$uname); |
|
} |
|
|
|
if ($reply=~/^error\:(.*)/) { |
|
$message.="<font color=red>Write Error: $1</font>"; |
|
} |
|
# ---------------------------------------------------------------- Done storing |
|
} |
|
# -------------------------------------------------------------- Get coursedata |
|
%courseopt = &Apache::lonnet::dump |
|
('resourcedata', |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); |
|
# --------------------------------------------------- Get userdata (if present) |
|
if ($uname) { |
|
%useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname); |
|
} |
|
|
|
# ------------------------------------------------------------------- Sort this |
|
|
|
@ids=sort { |
|
if ($fcat eq '') { |
|
$a<=>$b; |
|
} else { |
|
my ($result,@outpar)=&parmval($fcat,$a,$defp{$a}); |
|
my $aparm=$outpar[$result]; |
|
($result,@outpar)=&parmval($fcat,$b,$defp{$b}); |
|
my $bparm=$outpar[$result]; |
|
1*$aparm<=>1*$bparm; |
|
} |
|
} @ids; |
|
#----------------------------------------------- if all selected, fill in array |
|
if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);} |
|
if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);} |
|
# ------------------------------------------------------------------ Start page |
|
|
|
&startpage($r,$id,$udom,$csec,$uname); |
|
# if ($ENV{'form.url'}) { |
|
# $r->print('<input type="hidden" value="'.$ENV{'form.url'}. |
|
# '" name="url"><input type="hidden" name="command" value="set">'); |
|
# } |
|
$r->print('<input type="hidden" value="true" name="prevvisit">'); |
|
|
|
foreach ('tolerance','date_default','date_start','date_end', |
|
'date_interval','int','float','string') { |
|
$r->print('<input type="hidden" value="'. |
|
$ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">'); |
|
} |
|
|
|
$r->print('<h2>'.$message.'</h2><table>'); |
|
|
|
$r->print('<tr><td><hr /></td></tr>'); |
|
|
|
my $submitmessage; |
|
if (($prevvisit) || ($pschp) || ($pssymb)) { |
|
$submitmessage = "Update Display"; |
|
} else { |
|
$submitmessage = "Display"; |
|
} |
|
if (!$pssymb) { |
|
$r->print('<tr><td>Select Parameter Level</td><td>'); |
|
$r->print('<select name="parmlev">'); |
|
foreach (reverse sort keys %alllevs) { |
|
$r->print('<option value="'.$alllevs{$_}.'"'); |
|
if ($parmlev eq $alllevs{$_}) { |
|
$r->print(' selected'); |
|
} |
|
$r->print('>'.$_.'</option>'); |
|
} |
|
$r->print("</select></td>\n"); |
|
|
|
$r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>'); |
|
|
|
$r->print('</tr><tr><td><hr /></td>'); |
|
|
|
$r->print('<tr><td>Select Enclosing Map</td>'); |
|
$r->print('<td colspan="2"><select name="pschp">'); |
|
$r->print('<option value="all">All Maps</option>'); |
|
foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) { |
|
$r->print('<option value="'.$_.'"'); |
|
if (($pschp eq $_)) { $r->print(' selected'); } |
|
$r->print('>/res/'.$allmaps{$_}.'</option>'); |
|
} |
|
$r->print("</select></td></tr>\n"); |
|
} else { |
|
my ($map,$id,$resource)=split(/___/,$pssymb); |
|
$r->print("<tr><td>Specific Resource</td><td>$resource</td>"); |
|
$r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>'); |
|
$r->print('</tr>'); |
|
$r->print('<input type="hidden" value="'.$pssymb.'" name="symb">'); |
|
} |
|
|
|
$r->print('<tr><td colspan="3"><hr /><input type="checkbox"'); |
|
if ($showoptions eq 'show') {$r->print(" checked ");} |
|
$r->print(' name="showoptions" value="show" onclick="form.submit();">Show More Options<hr /></td></tr>'); |
|
# $r->print("<tr><td>Show: $showoptions</td></tr>"); |
|
# $r->print("<tr><td>pscat: @pscat</td></tr>"); |
|
# $r->print("<tr><td>psprt: @psprt</td></tr>"); |
|
# $r->print("<tr><td>fcat: $fcat</td></tr>"); |
|
|
|
if ($showoptions eq 'show') { |
|
my $tempkey; |
|
|
|
$r->print('<tr><td colspan="3" align="center">Select Parameters to View</td></tr>'); |
|
|
|
$r->print('<tr><td colspan="2"><table>'); |
|
$r->print('<tr><td><input type="checkbox" name="pscat" value="all"'); |
|
$r->print(' checked') unless (@pscat); |
|
$r->print('>All Parameters</td>'); |
|
|
|
my $cnt=0; |
|
|
|
foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} } |
|
keys %allparms ) { |
|
++$cnt; |
|
$r->print('</tr><tr>') unless ($cnt%2); |
|
$r->print('<td><input type="checkbox" name="pscat" '); |
|
$r->print('value="'.$tempkey.'"'); |
|
if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) { |
|
$r->print(' checked'); |
|
} |
|
$r->print('>'.$allparms{$tempkey}.'</td>'); |
|
} |
|
$r->print('</tr></table>'); |
|
|
|
# $r->print('<tr><td>Select Parts</td><td>'); |
|
$r->print('<td><select multiple name="psprt" size="5">'); |
|
$r->print('<option value="all"'); |
|
$r->print(' selected') unless (@psprt); |
|
$r->print('>All Parts</option>'); |
|
foreach $tempkey (sort keys %allparts) { |
|
unless ($tempkey =~ /\./) { |
|
$r->print('<option value="'.$tempkey.'"'); |
|
if ($psprt[0] eq "all" || grep $_ == $tempkey, @psprt) { |
|
$r->print(' selected'); |
|
} |
|
$r->print('>'.$allparts{$tempkey}.'</option>'); |
|
} |
|
} |
|
$r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>'); |
|
|
|
$r->print('<tr><td>Sort list by</td><td>'); |
|
$r->print('<select name="fcat">'); |
|
$r->print('<option value="">Enclosing Map</option>'); |
|
foreach (sort keys %allkeys) { |
|
$r->print('<option value="'.$_.'"'); |
|
if ($fcat eq $_) { $r->print(' selected'); } |
|
$r->print('>'.$allkeys{$_}.'</option>'); |
|
} |
|
$r->print('</select></td>'); |
|
|
|
$r->print('</tr><tr><td colspan="3"><hr /></td></tr>'); |
|
|
|
} else { # hide options - include any necessary extras here |
|
|
|
$r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n"); |
|
|
|
unless (@pscat) { |
|
foreach (keys %allparms ) { |
|
$r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n"); |
|
} |
|
} else { |
|
foreach (@pscat) { |
|
$r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n"); |
|
} |
|
} |
|
|
|
unless (@psprt) { |
|
foreach (keys %allparts ) { |
|
$r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n"); |
|
} |
|
} else { |
|
foreach (@psprt) { |
|
$r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n"); |
|
} |
|
} |
|
|
|
} |
|
$r->print('</table>'); |
|
|
|
my @temp_psprt; |
|
foreach my $t (@psprt) { |
|
push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts)); |
|
} |
|
|
|
@psprt = @temp_psprt; |
|
|
|
my @temp_pscat; |
|
map { |
|
my $cat = $_; |
|
push(@temp_pscat, map { $_.'.'.$cat } @psprt); |
|
} @pscat; |
|
|
|
@pscat = @temp_pscat; |
|
|
|
if (($prevvisit) || ($pschp) || ($pssymb)) { |
|
# ----------------------------------------------------------------- Start Table |
|
my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat; |
|
my $csuname=$ENV{'user.name'}; |
|
my $csudom=$ENV{'user.domain'}; |
|
|
|
|
|
if ($parmlev eq 'full' || $parmlev eq 'brief') { |
|
|
|
my $coursespan=$csec?8:5; |
|
$r->print('<p><table border=2>'); |
|
$r->print('<tr><td colspan=5></td>'); |
|
$r->print('<th colspan='.($coursespan).'>Any User</th>'); |
|
if ($uname) { |
|
$r->print("<th colspan=3 rowspan=2>"); |
|
$r->print("User $uname at Domain $udom</th>"); |
|
} |
|
$r->print(<<ENDTABLETWO); |
|
<th rowspan=3>Parameter in Effect</th> |
|
<th rowspan=3>Current Session Value<br>($csuname at $csudom)</th> |
|
</tr><tr><td colspan=5></td><th colspan=2>Resource Level</th> |
|
<th colspan=3>in Course</th> |
|
ENDTABLETWO |
|
if ($csec) { |
|
$r->print("<th colspan=3>in Section/Group $csec</th>"); |
|
} |
|
$r->print(<<ENDTABLEHEADFOUR); |
|
</tr><tr><th>Assessment URL and Title</th><th>Type</th> |
|
<th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th> |
|
<th>default</th><th>from Enclosing Map</th> |
|
<th>general</th><th>for Enclosing Map</th><th>for Resource</th> |
|
ENDTABLEHEADFOUR |
|
|
|
if ($csec) { |
|
$r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); |
|
} |
|
|
|
if ($uname) { |
|
$r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); |
|
} |
|
|
|
$r->print('</tr>'); |
|
|
|
my $defbgone=''; |
|
my $defbgtwo=''; |
|
|
|
foreach (@ids) { |
|
|
|
my $rid=$_; |
|
my ($inmapid)=($rid=~/\.(\d+)$/); |
|
|
|
if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) || |
|
($pssymb eq $symbp{$rid})) { |
# ------------------------------------------------------ Entry for one resource |
# ------------------------------------------------------ Entry for one resource |
@outpar=(); |
if ($defbgone eq '"E0E099"') { |
my $rid=$_; |
$defbgone='"E0E0DD"'; |
my $thistitle=''; |
} else { |
my @part=(0,1,1); |
$defbgone='"E0E099"'; |
my @name=('deadline','sig','tol'); |
} |
my @display=('Deadline','Significant Figures','Tolerance'); |
if ($defbgtwo eq '"FFFF99"') { |
my @type=('date','int','tolerance'); |
$defbgtwo='"FFFFDD"'; |
my %metadata=&Apache::lonmeta::unpackagemeta( |
} else { |
&Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1); |
$defbgtwo='"FFFF99"'; |
map { |
} |
if ($_=~/^parameter\_(\d+)\_(\w+)$/) { |
my $thistitle=''; |
$part[$#part+1]=$1; |
my %name= (); |
$name[$#name+1]=$2; |
undef %name; |
($type[$#type+1],$display[$#display+1])= |
my %part= (); |
split(/\_\_dis\_\_/,$metadata{$_}); |
my %display=(); |
unless ($display[$#display]) { |
my %type= (); |
$display[$#display]=$name[$#name]; |
my %default=(); |
|
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); |
|
|
|
foreach (split(/\,/,$keyp{$rid})) { |
|
my $tempkeyp = $_; |
|
if (grep $_ eq $tempkeyp, @catmarker) { |
|
$part{$_}=&Apache::lonnet::metadata($uri,$_.'.part'); |
|
$name{$_}=&Apache::lonnet::metadata($uri,$_.'.name'); |
|
$display{$_}=&Apache::lonnet::metadata($uri,$_.'.display'); |
|
unless ($display{$_}) { $display{$_}=''; } |
|
$display{$_}.=' ('.$name{$_}.')'; |
|
$default{$_}=&Apache::lonnet::metadata($uri,$_); |
|
$type{$_}=&Apache::lonnet::metadata($uri,$_.'.type'); |
|
$thistitle=&Apache::lonnet::metadata($uri,$_.'.title'); |
|
} |
|
} |
|
my $totalparms=scalar keys %name; |
|
if ($totalparms>0) { |
|
my $firstrow=1; |
|
|
|
$r->print('<tr><td bgcolor='.$defbgone. |
|
' rowspan='.$totalparms. |
|
'><tt><font size=-1>'. |
|
join(' / ',split(/\//,$uri)). |
|
'</font></tt><p><b>'. |
|
"<a href=\"javascript:openWindow('/res/".$uri. |
|
"', 'metadatafile', '450', '500', 'no', 'yes')\";". |
|
" TARGET=_self>$bighash{'title_'.$rid}"); |
|
|
|
if ($thistitle) { |
|
$r->print(' ('.$thistitle.')'); |
|
} |
|
$r->print('</a></b></td>'); |
|
$r->print('<td bgcolor='.$defbgtwo. |
|
' rowspan='.$totalparms.'>'.$typep{$rid}. |
|
'</td>'); |
|
|
|
$r->print('<td bgcolor='.$defbgone. |
|
' rowspan='.$totalparms. |
|
'><tt><font size=-1>'); |
|
|
|
$r->print(' / res / '); |
|
$r->print(join(' / ', split(/\//,$mapp{$rid}))); |
|
|
|
$r->print('</font></tt></td>'); |
|
|
|
foreach (sort keys %name) { |
|
unless ($firstrow) { |
|
$r->print('<tr>'); |
|
} else { |
|
undef $firstrow; |
|
} |
|
|
|
&print_row($r,$_,\%part,\%name,$rid,\%default, |
|
\%type,\%display,$defbgone,$defbgtwo, |
|
$parmlev); |
|
} |
} |
} |
} |
} |
if ($_ eq 'title') { |
} # end foreach ids |
$thistitle=$metadata{$_}; |
# -------------------------------------------------- End entry for one resource |
} |
$r->print('</table>'); |
} keys %metadata; |
} # end of brief/full |
my $totalparms=$#name+1; |
#--------------------------------------------------- Entry for parm level map |
$r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'. |
if ($parmlev eq 'map') { |
join(' / ',split(/\//,$bighash{'src_'.$rid})).'</font></tt><p><b>'. |
my $defbgone = '"E0E099"'; |
$bighash{'title_'.$rid}); |
my $defbgtwo = '"FFFF99"'; |
if ($thistitle) { |
|
$r->print(' ('.$thistitle.')'); |
my %maplist; |
|
|
|
if ($pschp eq 'all') { |
|
%maplist = %allmaps; |
|
} else { |
|
%maplist = ($pschp => $mapp{$pschp}); |
} |
} |
$r->print('</b></td>'); |
|
my $i; |
#-------------------------------------------- for each map, gather information |
for ($i=0;$i<$totalparms;$i++) { |
my $mapid; |
$r->print("<td>$part[$i]</td><td>$display[$i]</td>"); |
foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) { |
$r->print('<td>'.&valout($outpar[8],$type[$i]).'</td>'); |
my $maptitle = $maplist{$mapid}; |
$r->print('<td>'.&valout($outpar[7],$type[$i]).'</td>'); |
|
$r->print('<td>'. |
#----------------------- loop through ids and get all parameter types for map |
&plink($type[$i],$display[$i],$outpar[6]).'</td>'); |
#----------------------------------------- and associated information |
if ($csec) { |
my %name = (); |
$r->print('<td>'. |
my %part = (); |
&plink($type[$i],$display[$i],$outpar[5]).'</td>'); |
my %display = (); |
} |
my %type = (); |
$r->print('<td>'. |
my %default = (); |
&plink($type[$i],$display[$i],$outpar[4]).'</td>'); |
my $map = 0; |
if ($uname) { |
|
$r->print('<td>'. |
# $r->print("Catmarker: @catmarker<br />\n"); |
&plink($type[$i],$display[$i],$outpar[3]).'</td>'); |
|
if ($csec) { |
foreach (@ids) { |
$r->print('<td>'. |
($map)=(/([\d]*?)\./); |
&plink($type[$i],$display[$i],$outpar[2]).'</td>'); |
my $rid = $_; |
|
|
|
# $r->print("$mapid:$map: $rid <br /> \n"); |
|
|
|
if ($map eq $mapid) { |
|
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); |
|
# $r->print("Keys: $keyp{$rid} <br />\n"); |
|
|
|
#-------------------------------------------------------------------- |
|
# @catmarker contains list of all possible parameters including part #s |
|
# $fullkeyp contains the full part/id # for the extraction of proper parameters |
|
# $tempkeyp contains part 0 only (no ids - ie, subparts) |
|
# When storing information, store as part 0 |
|
# When requesting information, request from full part |
|
#------------------------------------------------------------------- |
|
foreach (split(/\,/,$keyp{$rid})) { |
|
my $tempkeyp = $_; |
|
my $fullkeyp = $tempkeyp; |
|
$tempkeyp =~ s/_[\d_]+_/_0_/; |
|
|
|
if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) { |
|
$part{$tempkeyp}="0"; |
|
$name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name'); |
|
$display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display'); |
|
unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; } |
|
$display{$tempkeyp}.=' ('.$name{$tempkeyp}.')'; |
|
$display{$tempkeyp} =~ s/_[\d_]+_/_0_/; |
|
$default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp); |
|
$type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type'); |
|
} |
|
} # end loop through keys |
|
} |
|
} # end loop through ids |
|
|
|
#---------------------------------------------------- print header information |
|
$r->print(<<ENDMAPONE); |
|
<center><h4> |
|
<font color="red">Set Defaults for All Resources in map |
|
<i>$maptitle</i><br /> |
|
Specifically for |
|
ENDMAPONE |
|
if ($uname) { |
|
my %name=&Apache::lonnet::userenvironment($udom,$uname, |
|
('firstname','middlename','lastname','generation', 'id')); |
|
my $person=$name{'firstname'}.' '.$name{'middlename'}.' ' |
|
.$name{'lastname'}.' '.$name{'generation'}; |
|
$r->print("User <i>$uname \($person\) </i> in \n"); |
|
} else { |
|
$r->print("<i>all</i> users in \n"); |
} |
} |
$r->print('<td>'. |
|
&plink($type[$i],$display[$i],$outpar[1]).'</td>'); |
if ($csec) {$r->print("Section <i>$csec</i> of \n")}; |
} |
|
$r->print("</tr>\n<tr>"); |
$r->print("<i>$coursename</i><br />"); |
} |
$r->print("</font></h4>\n"); |
# -------------------------------------------------- End entry for one resource |
#---------------------------------------------------------------- print table |
} @ids; |
$r->print('<p><table border="2">'); |
$r->print('</table></form></body></html>'); |
$r->print('<tr><th>Parameter Name</th>'); |
untie(%bighash); |
$r->print('<th>Default Value</th>'); |
untie(%parmhash); |
$r->print('<th>Parameter in Effect</th></tr>'); |
} |
|
} else { |
foreach (sort keys %name) { |
|
&print_row($r,$_,\%part,\%name,$mapid,\%default, |
|
\%type,\%display,$defbgone,$defbgtwo, |
|
$parmlev); |
|
# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n"); |
|
} |
|
$r->print("</table></center>"); |
|
} # end each map |
|
} # end of $parmlev eq map |
|
#--------------------------------- Entry for parm level general (Course level) |
|
if ($parmlev eq 'general') { |
|
my $defbgone = '"E0E099"'; |
|
my $defbgtwo = '"FFFF99"'; |
|
|
|
#-------------------------------------------- for each map, gather information |
|
my $mapid="0.0"; |
|
#----------------------- loop through ids and get all parameter types for map |
|
#----------------------------------------- and associated information |
|
my %name = (); |
|
my %part = (); |
|
my %display = (); |
|
my %type = (); |
|
my %default = (); |
|
|
|
foreach (@ids) { |
|
my $rid = $_; |
|
|
|
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); |
|
|
|
#-------------------------------------------------------------------- |
|
# @catmarker contains list of all possible parameters including part #s |
|
# $fullkeyp contains the full part/id # for the extraction of proper parameters |
|
# $tempkeyp contains part 0 only (no ids - ie, subparts) |
|
# When storing information, store as part 0 |
|
# When requesting information, request from full part |
|
#------------------------------------------------------------------- |
|
foreach (split(/\,/,$keyp{$rid})) { |
|
my $tempkeyp = $_; |
|
my $fullkeyp = $tempkeyp; |
|
$tempkeyp =~ s/_[\d_]+_/_0_/; |
|
if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) { |
|
$part{$tempkeyp}="0"; |
|
$name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name'); |
|
$display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display'); |
|
unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; } |
|
$display{$tempkeyp}.=' ('.$name{$tempkeyp}.')'; |
|
$display{$tempkeyp} =~ s/_[\d_]+_/_0_/; |
|
$default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp); |
|
$type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type'); |
|
} |
|
} # end loop through keys |
|
} # end loop through ids |
|
|
|
#---------------------------------------------------- print header information |
|
$r->print(<<ENDMAPONE); |
|
<center><h4> |
|
<font color="red">Set Defaults for All Resources in Course |
|
<i>$coursename</i><br /> |
|
ENDMAPONE |
|
if ($uname) { |
|
my %name=&Apache::lonnet::userenvironment($udom,$uname, |
|
('firstname','middlename','lastname','generation', 'id')); |
|
my $person=$name{'firstname'}.' '.$name{'middlename'}.' ' |
|
.$name{'lastname'}.' '.$name{'generation'}; |
|
$r->print(" User <i>$uname \($person\) </i> \n"); |
|
} else { |
|
$r->print("<i>ALL</i> USERS \n"); |
|
} |
|
|
|
if ($csec) {$r->print("Section <i>$csec</i>\n")}; |
|
$r->print("</font></h4>\n"); |
|
#---------------------------------------------------------------- print table |
|
$r->print('<p><table border="2">'); |
|
$r->print('<tr><th>Parameter Name</th>'); |
|
$r->print('<th>Default Value</th>'); |
|
$r->print('<th>Parameter in Effect</th></tr>'); |
|
|
|
foreach (sort keys %name) { |
|
&print_row($r,$_,\%part,\%name,$mapid,\%default, |
|
\%type,\%display,$defbgone,$defbgtwo,$parmlev); |
|
# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n"); |
|
} |
|
$r->print("</table></center>"); |
|
} # end of $parmlev eq general |
|
} |
|
$r->print('</form></body></html>'); |
|
untie(%bighash); |
|
untie(%parmhash); |
|
} # end sub assessparms |
|
|
|
|
|
################################################## |
|
################################################## |
|
|
|
=pod |
|
|
|
=item crsenv |
|
|
|
Show course data and parameters. This is a large routine that should |
|
be simplified and shortened... someday. |
|
|
|
Inputs: $r |
|
|
|
Returns: nothing |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
|
sub crsenv { |
|
my $r=shift; |
|
my $setoutput=''; |
|
my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
|
my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
|
# -------------------------------------------------- Go through list of changes |
|
foreach (keys %ENV) { |
|
if ($_=~/^form\.(.+)\_setparmval$/) { |
|
my $name=$1; |
|
my $value=$ENV{'form.'.$name.'_value'}; |
|
if ($name eq 'newp') { |
|
$name=$ENV{'form.newp_name'}; |
|
} |
|
if ($name eq 'url') { |
|
$value=~s/^\/res\///; |
|
my $bkuptime=time; |
|
my @tmp = &Apache::lonnet::get |
|
('environment',['url'],$dom,$crs); |
|
$setoutput.='Backing up previous URL: '. |
|
&Apache::lonnet::put |
|
('environment', |
|
{'top level map backup '.$bkuptime => $tmp[1] }, |
|
$dom,$crs). |
|
'<br>'; |
|
} |
|
if ($name) { |
|
$setoutput.='Setting <tt>'.$name.'</tt> to <tt>'. |
|
$value.'</tt>: '. |
|
&Apache::lonnet::put |
|
('environment',{$name=>$value},$dom,$crs). |
|
'<br>'; |
|
} |
|
} |
|
} |
|
# -------------------------------------------------------- Get parameters again |
|
|
|
my %values=&Apache::lonnet::dump('environment',$dom,$crs); |
|
my $output=''; |
|
if (! exists($values{'con_lost'})) { |
|
my %descriptions= |
|
('url' => '<b>Top Level Map</b> '. |
|
'<a href="javascript:openbrowser'. |
|
"('envform','url','sequence')\">". |
|
'Browse</a><br><font color=red> '. |
|
'Modification may make assessment data '. |
|
'inaccessible</font>', |
|
'description' => '<b>Course Description</b>', |
|
'courseid' => '<b>Course ID or number</b><br>'. |
|
'(internal, optional)', |
|
'default_xml_style' => '<b>Default XML Style File</b> '. |
|
'<a href="javascript:openbrowser'. |
|
"('envform','default_xml_style'". |
|
",'sty')\">Browse</a><br>", |
|
'question.email' => '<b>Feedback Addresses for Content '. |
|
'Questions</b><br>(<tt>user:domain,'. |
|
'user:domain,...</tt>)', |
|
'comment.email' => '<b>Feedback Addresses for Comments</b><br>'. |
|
'(<tt>user:domain,user:domain,...</tt>)', |
|
'policy.email' => '<b>Feedback Addresses for Course Policy</b>'. |
|
'<br>(<tt>user:domain,user:domain,...</tt>)', |
|
'hideemptyrows' => '<b>Hide Empty Rows in Spreadsheets</b><br>'. |
|
'("<tt>yes</tt>" for default hiding)', |
|
'pageseparators' => '<b>Visibly Separate Items on Pages</b><br>'. |
|
'("<tt>yes</tt>" for visible separation)', |
|
'pch.roles.denied'=> '<b>Disallow Resource Discussion for '. |
|
'Roles</b><br>"<tt>st</tt>": '. |
|
'student, "<tt>ta</tt>": '. |
|
'TA, "<tt>in</tt>": '. |
|
'instructor;<br><tt>role,role,...</tt>) '. |
|
Apache::loncommon::help_open_topic("Course_Disable_Discussion"), |
|
'pch.users.denied' => |
|
'<b>Disallow Resource Discussion for Users</b><br>'. |
|
'(<tt>user:domain,user:domain,...</tt>)', |
|
'spreadsheet_default_classcalc' |
|
=> '<b>Default Course Spreadsheet</b> '. |
|
'<a href="javascript:openbrowser'. |
|
"('envform','spreadsheet_default_classcalc'". |
|
",'spreadsheet')\">Browse</a><br>", |
|
'spreadsheet_default_studentcalc' |
|
=> '<b>Default Student Spreadsheet</b> '. |
|
'<a href="javascript:openbrowser'. |
|
"('envform','spreadsheet_default_calc'". |
|
",'spreadsheet')\">Browse</a><br>", |
|
'spreadsheet_default_assesscalc' |
|
=> '<b>Default Assessment Spreadsheet</b> '. |
|
'<a href="javascript:openbrowser'. |
|
"('envform','spreadsheet_default_assesscalc'". |
|
",'spreadsheet')\">Browse</a><br>", |
|
); |
|
foreach (keys(%values)) { |
|
unless ($descriptions{$_}) { |
|
$descriptions{$_}=$_; |
|
} |
|
} |
|
foreach (sort keys %descriptions) { |
|
# onchange is javascript to automatically check the 'Set' button. |
|
my $onchange = 'onchange="javascript:window.document.forms'. |
|
'[\'envform\'].elements[\''.$_.'_setparmval\']'. |
|
'.checked=true;"'; |
|
$output.='<tr><td>'.$descriptions{$_}.'</td>'. |
|
'<td><input name="'.$_.'_value" size=40 '. |
|
'value="'.$values{$_}.'" '.$onchange.' /></td>'. |
|
'<td><input type=checkbox name="'.$_.'_setparmval"></td>'. |
|
'</tr>'."\n"; |
|
} |
|
my $onchange = 'onchange="javascript:window.document.forms'. |
|
'[\'envform\'].elements[\'newp_setparmval\']'. |
|
'.checked=true;"'; |
|
$output.='<tr><td><i>Create New Environment Variable</i><br />'. |
|
'<input type="text" size=40 name="newp_name" '. |
|
$onchange.' /></td><td>'. |
|
'<input type="text" size=40 name="newp_value" '. |
|
$onchange.' /></td><td>'. |
|
'<input type="checkbox" name="newp_setparmval" /></td></tr>'; |
|
} |
|
$r->print(<<ENDENV); |
|
<html> |
|
<script type="text/javascript" language="Javascript" > |
|
var editbrowser; |
|
function openbrowser(formname,elementname,only,omit) { |
|
var url = '/res/?'; |
|
if (editbrowser == null) { |
|
url += 'launch=1&'; |
|
} |
|
url += 'catalogmode=interactive&'; |
|
url += 'mode=parmset&'; |
|
url += 'form=' + formname + '&'; |
|
if (only != null) { |
|
url += 'only=' + only + '&'; |
|
} |
|
if (omit != null) { |
|
url += 'omit=' + omit + '&'; |
|
} |
|
url += 'element=' + elementname + ''; |
|
var title = 'Browser'; |
|
var options = 'scrollbars=1,resizable=1,menubar=0'; |
|
options += ',width=700,height=600'; |
|
editbrowser = open(url,title,options,'1'); |
|
editbrowser.focus(); |
|
} |
|
</script> |
|
<head> |
|
<title>LON-CAPA Course Environment</title> |
|
</head> |
|
<body bgcolor="#FFFFFF"> |
|
<h1>Set Course Parameters</h1> |
|
<form method="post" action="/adm/parmset" name="envform"> |
|
<h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2> |
|
<h3>Course Environment</h3> |
|
$setoutput |
|
<p> |
|
<table border=2> |
|
<tr><th>Parameter</th><th>Value</th><th>Set?</th></tr> |
|
$output |
|
</table> |
|
<input type="submit" name="crsenv" value="Set Course Environment"> |
|
</form> |
|
</body> |
|
</html> |
|
ENDENV |
|
} |
|
|
|
################################################## |
|
################################################## |
|
|
|
=pod |
|
|
|
=item handler |
|
|
|
Main handler. Calls &assessparms and &crsenv subroutines. |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
|
sub handler { |
|
my $r=shift; |
|
|
|
if ($r->header_only) { |
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
return OK; |
|
} |
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); |
|
# ----------------------------------------------------- Needs to be in a course |
|
|
|
if (($ENV{'request.course.id'}) && |
|
(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { |
|
|
|
$coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; |
|
|
|
unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) { |
|
# --------------------------------------------------------- Bring up assessment |
|
&assessparms($r); |
|
# ---------------------------------------------- This is for course environment |
|
} else { |
|
&crsenv($r); |
|
} |
|
} 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/parmset: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; |
} |
} |
|
|
1; |
1; |
__END__ |
__END__ |
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |
|
|
|
|
|
|