File:
[LON-CAPA] /
loncom /
interface /
lonparmset.pm
Revision
1.55:
download - view:
text,
annotated -
select for diffs
Mon Jul 22 14:23:29 2002 UTC (22 years, 10 months ago) by
bowersj2
Branches:
MAIN
CVS tags:
HEAD
Checking commit of scripts to make sure I don't get too far out of sync. Added help
links to the message sender describing 'critical message', and several help links in
the course parameters screen. (These will not work until some .tex files are checked
in.)
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
# $Id: lonparmset.pm,v 1.55 2002/07/22 14:23:29 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# 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.
#
# 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/
#
# (Handler to resolve ambiguous file locations
#
# (TeX Content Handler
#
# YEAR=2000
# 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,11/24,11/25,11/27,11/28,
# 12/08,12/12,
# YEAR=2001
# 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09,
# 07/05,07/06,08/08,08/09,09/01,09/21 Gerd Kortemeyer
# 12/17 Scott Harrison
# 12/19 Guy Albertelli
# 12/26,12/27 Gerd Kortemeyer
#
# YEAR=2002
# 7/19 Jeremy Bowers
###
package Apache::lonparmset;
use strict;
use Apache::lonnet;
use Apache::Constants qw(:common :http REDIRECT);
use Apache::loncommon;
use GDBM_File;
my %courseopt;
my %useropt;
my %parmhash;
my @ids;
my %symbp;
my %mapp;
my %typep;
my %keyp;
my $uname;
my $udom;
my $uhome;
my $csec;
# -------------------------------------------- Figure out a cascading parameter
sub parmval {
my ($what,$id,$def)=@_;
my $result='';
my @outpar=();
# ----------------------------------------------------- Cascading lookup scheme
my $symbparm=$symbp{$id}.'.'.$what;
my $mapparm=$mapp{$id}.'___(all).'.$what;
my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
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
sub valout {
my ($value,$type)=@_;
return ($value?(($type=~/^date/)?localtime($value):$value):' ');
}
# -------------------------------------------------------- Produces link anchor
sub plink {
my ($type,$dis,$value,$marker,$return,$call)=@_;
my $winvalue=$value;
unless ($winvalue) {
if ($type=~/^date/) {
$winvalue=$ENV{'form.recent_'.$type};
} else {
$winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
}
}
return
'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
.$marker."','".$return."','".$call."'".');">'.
&valout($value,$type).'</a><a name="'.$marker.'"></a>';
}
sub startpage {
my ($r,$id,$udom,$csec,$uname)=@_;
$r->content_type('text/html');
$r->send_http_header;
$r->print(<<ENDHEAD);
<html>
<head>
<title>LON-CAPA Course 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) {
document.parmform.pres_marker.value='';
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");
}
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='';
}
}
</script>
</head>
<body bgcolor="#FFFFFF" onUnload="pclose()">
<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>
<input type="submit" name="crsenv" value="Set Course Environment">
</form>
<form method="post" action="/adm/parmset" name="parmform">
<h3>Course Assessments</h3>
<b>
Section/Group:
<input type="text" value="$csec" size="6" name="csec">
<br>
For User
<input type="text" value="$uname" size="12" name="uname">
or ID
<input type="text" value="$id" size="12" name="id">
at Domain
<input type="text" value="$udom" size="6" name="udom">
</b>
<input type="hidden" value='' name="pres_value">
<input type="hidden" value='' name="pres_type">
<input type="hidden" value='' name="pres_marker">
ENDHEAD
}
sub print_row {
my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone,
$defbgtwo)=@_;
my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
$rid,$$default{$which});
$r->print("<td bgcolor=".$defbgtwo.
'>'.$$part{$which}.'</td><td bgcolor='.$defbgone.
'>'.$$display{$which}.'</td>');
my $thismarker=$which;
$thismarker=~s/^parameter\_//;
my $mprefix=$rid.'&'.$thismarker.'&';
&print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
&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);
}
$r->print('<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$$type{$which}).'</td>');
my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
'.'.$$name{$which},$symbp{$rid});
$r->print('<td bgcolor=#999999><font color=#FFFFFF>'.
&valout($sessionval,$$type{$which}).' '.
'</font></td>');
$r->print('</tr>');
}
sub print_td {
my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_;
$r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).'>'.
&plink($$type{$value},$$display{$value},$$outpar[$which],
$mprefix."$which",'parmform.pres','psub').'</td>');
}
sub assessparms {
my $r=shift;
# -------------------------------------------------------- Variable declaration
my %allkeys;
my %allmaps;
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=$ENV{'form.pscat'};
my $pschp=$ENV{'form.pschp'};
my $pssymb='';
# ----------------------------------------------- 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='';
} elsif ($ENV{'form.symb'}) {
$pssymb=$ENV{'form.symb'};
$pscat='all';
$pschp='';
} else {
$ENV{'form.url'}='';
}
my $id=$ENV{'form.id'};
if (($id) && ($udom)) {
$uname=(&Apache::lonnet::idget($udom,$id))[1];
if ($uname) {
$id='';
} else {
$message=
"<font color=red>Unknown ID '$id' at domain '$udom'</font>";
}
} else {
$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
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/\_/\./;
my $display=
&Apache::lonnet::metadata($srcf,$key.'.display');
unless ($display) {
$display=
&Apache::lonnet::metadata($srcf,$key.'.name');
}
$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});
$allmaps{$mapid}=$mapp{$id};
$symbp{$id}=$mapp{$id}.
'___'.$resid.'___'.
&Apache::lonnet::declutter($srcf);
}
}
}
# ---------------------------------------------------------- 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;
# ------------------------------------------------------------------ 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">');
# }
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><tr><td>Sort list by</td><td>');
$r->print('<select name="fcat">');
$r->print('<option value="">Enclosing Map</option>');
foreach (reverse sort keys %allkeys) {
$r->print('<option value="'.$_.'"');
if ($fcat eq $_) { $r->print(' selected'); }
$r->print('>'.$allkeys{$_}.'</option>');
}
if (!$pssymb) {
$r->print('</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>');
$r->print('<option value=all>All Maps</option>');
foreach (sort keys %allmaps) {
$r->print('<option value="'.$_.'"');
if (($pssymb=~/^$allmaps{$_}/) ||
($pschp eq $_)) { $r->print(' selected'); }
$r->print('>'.$allmaps{$_}.'</option>');
}
} else {
my ($map,$id,$resource)=split(/___/,$pssymb);
$r->print('<tr><td>Specfic Resource</td><td> </td></tr>');
$r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
}
$r->print('</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>');
$r->print('<option value=all>All Parameters</option>');
foreach (reverse sort keys %allkeys) {
$r->print('<option value="'.$_.'"');
if ($pscat eq $_) { $r->print(' selected'); }
$r->print('>'.$allkeys{$_}.'</option>');
}
$r->print('</select></td></tr></table><br><input name=dis type="submit" value="Display">');
if (($pscat) || ($pschp) || ($pssymb)) {
# ----------------------------------------------------------------- Start Table
my $catmarker='parameter_'.$pscat;
$catmarker=~s/\./\_/g;
my $coursespan=$csec?8:5;
my $csuname=$ENV{'user.name'};
my $csudom=$ENV{'user.domain'};
$r->print(<<ENDTABLEHEAD);
<p><table border=2>
<tr><td colspan=5></td>
<th colspan=$coursespan>Any User</th>
ENDTABLEHEAD
if ($uname) {
$r->print("<th colspan=3 rowspan=2>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
if ($defbgone eq '"E0E099"') {
$defbgone='"E0E0DD"';
} else {
$defbgone='"E0E099"';
}
if ($defbgtwo eq '"FFFF99"') {
$defbgtwo='"FFFFDD"';
} else {
$defbgtwo='"FFFF99"';
}
my $thistitle='';
my %name= ();
undef %name;
my %part= ();
my %display=();
my %type= ();
my %default=();
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
foreach (split(/\,/,$keyp{$rid})) {
if (($_ eq $catmarker) || ($pscat eq 'all')) {
$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>'.
$bighash{'title_'.$rid});
if ($thistitle) {
$r->print(' ('.$thistitle.')');
}
$r->print('</b></td>');
$r->print('<td bgcolor='.$defbgtwo.
' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
$r->print('<td bgcolor='.$defbgone.
' rowspan='.$totalparms.'><tt><font size=-1>'.
join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
foreach (sort keys %name) {
unless ($firstrow) {
$r->print('<tr>');
} else {
$firstrow=0;
}
&print_row($r,$_,\%part,\%name,$rid,\%default,
\%type,\%display,$defbgone,$defbgtwo);
}
}
# -------------------------------------------------- End entry for one resource
}
}
$r->print('</table>');
}
$r->print('</form></body></html>');
untie(%bighash);
untie(%parmhash);
}
# Set course environment parameters
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 @tmp = &Apache::lonnet::get
('environment',['url'],$dom,$crs);
$setoutput.='Backing up previous URL: '.
&Apache::lonnet::put
('environment',
{'top level map backup ' => $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> ' .
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
}
# ================================================================ Main Handler
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'}))) {
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
$ENV{'user.error.msg'}=
"/adm/parmset:opa:0:0:Cannot modify assessment parameters";
return HTTP_NOT_ACCEPTABLE;
}
return OK;
}
1;
__END__
=head1 NAME
Apache::lonparmset - Handler to set parameters for assessments
=head1 SYNOPSIS
Invoked by /etc/httpd/conf/srm.conf:
<Location /adm/parmset>
PerlAccessHandler Apache::lonacc
SetHandler perl-script
PerlHandler Apache::lonparmset
ErrorDocument 403 /adm/login
ErrorDocument 406 /adm/roles
ErrorDocument 500 /adm/errorhandler
</Location>
=head1 INTRODUCTION
This module sets assessment parameters.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
=head1 HANDLER SUBROUTINE
This routine is called by Apache and mod_perl.
=over 4
=item *
need to be in course
=item *
bring up assessment screen or course environment
=back
=head1 OTHER SUBROUTINES
=over 4
=item *
parmval() : figure out a cascading parameter
=item *
valout() : format a value for output
=item *
plink() : produces link anchor
=item *
assessparms() : show assess data and parameters
=item *
crsenv() : for the course environment
=back
=cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonparmset.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface