--- loncom/interface/lonparmset.pm 2001/08/08 21:00:49 1.32 +++ loncom/interface/lonparmset.pm 2002/08/08 13:44:17 1.56 @@ -1,139 +1,164 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # +# $Id: lonparmset.pm,v 1.56 2002/08/08 13:44:17 www 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 Gerd Kortemeyer +# 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 %bighash; my %parmhash; -my @outpar; - my @ids; my %symbp; my %mapp; my %typep; my %keyp; -my %defp; - -my %allkeys; -my %allmaps; my $uname; my $udom; my $uhome; - my $csec; -my $fcat; - # -------------------------------------------- Figure out a cascading parameter sub parmval { my ($what,$id,$def)=@_; my $result=''; - @outpar=(); + my @outpar=(); # ----------------------------------------------------- Cascading lookup scheme - my $symbparm=$symbp{$id}.'.'.$what; - my $mapparm=$mapp{$id}.'___(all).'.$what; + 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; + 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; } + if ($def) { $outpar[11]=$def; $result=11; } # ----------------------------------------------------- second, check map parms - my $thisparm=$parmhash{$symbparm}; - if ($thisparm) { $outpar[10]=$thisparm; - $result=10; } + 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{$courselevel}) { + $outpar[9]=$courseopt{$courselevel}; + $result=9; + } - if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; - $result=8; } + if ($courseopt{$courselevelm}) { + $outpar[8]=$courseopt{$courselevelm}; + $result=8; + } - if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; - $result=7; } + 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; } - - } + 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; } + 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; + return ($result,@outpar); } # ------------------------------------------------------------ Output for value sub valout { my ($value,$type)=@_; - return - ($value?(($type=~/^date/)?localtime($value):$value):'  '); + return ($value?(($type=~/^date/)?localtime($value):$value):'  '); } # -------------------------------------------------------- Produces link anchor @@ -149,270 +174,17 @@ sub plink { } } return - ''. - &valout($value,$type).''; + ''. + &valout($value,$type).''; } -sub assessparms { - - my $r=shift; -# -------------------------------------------------------- Variable declaration - - %courseopt=(); - %useropt=(); - %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=''; - } else { - $ENV{'form.url'}=''; - } - - my $id=$ENV{'form.id'}; - if (($id) && ($udom)) { - $uname=(&Apache::lonnet::idget($udom,$id))[1]; - if ($uname) { - $id=''; - } else { - $message= - "Unknown ID '$id' at domain '$udom'"; - } - } else { - $uname=$ENV{'form.uname'}; - } - unless ($udom) { $uname=''; } - $uhome=''; - if ($uname) { - $uhome=&Apache::lonnet::homeserver($uname,$udom); - - if ($uhome eq 'no_host') { - $message= - "Unknown user '$uname' at domain '$udom'"; - $uname=''; - } else { - $csec=&Apache::lonnet::usection( - $udom,$uname,$ENV{'request.course.id'}); - if ($csec eq '-1') { - $message="". - "User '$uname' at domain '$udom' not in this course"; - $uname=''; - $csec=$ENV{'form.csec'}; - } else { - my %name=&Apache::lonnet::userenvironment($udom,$uname, - ('firstname','middlename','lastname','generation','id')); - $message="\n

\nFull Name: ". - $name{'firstname'}.' '.$name{'middlename'} - .$name{'lastname'}.' '.$name{'generation'}. - "
\nID: ".$name{'id'}.'

'; - } - } - } - - 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 all assessments - undef %allkeys; - undef %allmaps; - undef %defp; - map { - 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}=''; - map { - 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; - } - } - } split(/\,/, - &Apache::lonnet::metadata($srcf,'keys')); - $mapp{$id}= - &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); - $allmaps{$mapid}=$mapp{$id}; - $symbp{$id}=$mapp{$id}. - '___'.$resid.'___'. - &Apache::lonnet::declutter($srcf); - } - } - } keys %bighash; -# ---------------------------------------------------------- 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; } - $storeunder=&Apache::lonnet::escape($storeunder); - - my $storecontent= - $storeunder.'='.&Apache::lonnet::escape($ENV{'form.pres_value'}).'&'. - $storeunder.'.type='.&Apache::lonnet::escape($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::critical('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'. - $storecontent, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - } 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::critical('put:'.$udom.':'.$uname.':resourcedata:'. - $storecontent,$uhome); - } - - if ($reply=~/^error\:(.*)/) { - $message.="Write Error: $1"; - } -# ---------------------------------------------------------------- Done storing - } -# -------------------------------------------------------------- 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{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::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{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - } split(/\&/,$reply); - } - } - -# ------------------------------------------------------------------- Sort this - - @ids=sort { - if ($fcat eq '') { - $a<=>$b; - } else { - 1*$outpar[&parmval($fcat,$a,$defp{$a})]<=> - 1*$outpar[&parmval($fcat,$b,$defp{$b})]; - } - } @ids; - -# ------------------------------------------------------------------ Start page - $r->content_type('text/html'); - $r->send_http_header; - $r->print(<content_type('text/html'); + $r->send_http_header; + $r->print(< LON-CAPA Course Parameters @@ -469,7 +241,7 @@ sub assessparms {

Course Assessments

-Section/Group: +Section/Group:
For User @@ -481,222 +253,453 @@ at Domain
- + ENDHEAD - if ($ENV{'form.url'}) { - $r->print(''); - } - map { - $r->print(''); - } ('tolerance','date_default','date_start','date_end','date_interval', - 'int','float','string'); - - $r->print('

'.$message.'

'); +} + +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= + "Unknown ID '$id' at domain '$udom'"; + } + } else { + $uname=$ENV{'form.uname'}; + } + unless ($udom) { $uname=''; } + $uhome=''; + if ($uname) { + $uhome=&Apache::lonnet::homeserver($uname,$udom); + if ($uhome eq 'no_host') { + $message= + "Unknown user '$uname' at domain '$udom'"; + $uname=''; + } else { + $csec=&Apache::lonnet::usection($udom,$uname, + $ENV{'request.course.id'}); + if ($csec eq '-1') { + $message="". + "User '$uname' at domain '$udom' not ". + "in this course"; + $uname=''; + $csec=$ENV{'form.csec'}; + } else { + my %name=&Apache::lonnet::userenvironment($udom,$uname, + ('firstname','middlename','lastname','generation','id')); + $message="\n

\nFull Name: ". + $name{'firstname'}.' '.$name{'middlename'}.' ' + .$name{'lastname'}.' '.$name{'generation'}. + "
\nID: ".$name{'id'}.'

'; + } + } + } + + 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.="Write Error: $1"; + } +# ---------------------------------------------------------------- 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(''); +# } + foreach ('tolerance','date_default','date_start','date_end', + 'date_interval','int','float','string') { + $r->print(''); + } + + $r->print('

'.$message.'

Sort list by'); - $r->print('
Select Enclosing Map
Select Parameter'. + &plink($$type{$value},$$display{$value},$$outpar[$which], + $mprefix."$which",'parmform.pres','psub').'
Sort list by'); + $r->print('
Select Enclosing Map

' - ); - if (($pscat) || ($pschp) || ($pssymb)) { + if (($pssymb=~/^$allmaps{$_}/) || + ($pschp eq $_)) { $r->print(' selected'); } + $r->print('>'.$allmaps{$_}.''); + } + } else { + my ($map,$id,$resource)=split(/___/,$pssymb); + $r->print('Specfic Resource '); + $r->print(''); + } + $r->print('Select Parameter
'); + if (($pscat) || ($pschp) || ($pssymb)) { # ----------------------------------------------------------------- Start Table my $catmarker='parameter_'.$pscat; - $catmarker=~s/\./\_/g; - my $coursespan=$csec?8:5; - $r->print(<print(< ENDTABLEHEAD - if ($uname) { - $r->print(""); - } - $r->print(<Parameter in Effect + if ($uname) { + $r->print(""); + } + $r->print(<Parameter in Effect + + ENDTABLETWO - if ($csec) { - $r->print(""); - } - $r->print(<print(""); + } + $r->print(< ENDTABLEHEADFOUR - if ($csec) { - $r->print(''); - } - if ($uname) { - $r->print(''); - } - $r->print(''); - my $defbgone=''; - my $defbgtwo=''; - map { - my $rid=$_; - my ($inmapid)=($rid=~/\.(\d+)$/); - if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) || - ($pssymb eq $mapp{$rid}.'___'.$inmapid.'___'. - &Apache::lonnet::declutter($bighash{'src_'.$rid}))) { + if ($csec) { + $r->print(''); + } + if ($uname) { + $r->print(''); + } + $r->print(''); + 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"'; - } - @outpar=(); - my $thistitle=''; - my %name= (); - my %part= (); - my %display=(); - my %type= (); - my %default=(); - my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); - - map { - $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'); - } split(/\,/,$keyp{$rid}); - - my $totalparms=scalar keys %name; - my $isdef=1; - unless ($totalparms) { $totalparms=1; $isdef=0; } - if ($pscat ne 'all') { $totalparms=1; } - $r->print(''); - $r->print(''); - $r->print(''); - if ($isdef) { - map { - if (($_ eq $catmarker) || ($pscat eq 'all')) { - my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_}); - - $r->print(""); - my $thismarker=$_; - $thismarker=~s/^parameter\_//; - my $mprefix=$rid.'&'.$thismarker.'&'; - - $r->print(''); - $r->print(''); - - $r->print(''); - $r->print(''); - $r->print(''); - - if ($csec) { - $r->print(''); - $r->print(''); - $r->print(''); - } - - if ($uname) { - $r->print(''); - $r->print(''); - $r->print(''); - } - $r->print( - ''); - $r->print("\n"); - } - } sort keys %name; - } else { - $r->print("\n"); - } + 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(''); + $r->print(''); + $r->print(''); + foreach (sort keys %name) { + unless ($firstrow) { + $r->print(''); + } else { + $firstrow=0; + } + &print_row($r,$_,\%part,\%name,$rid,\%default, + \%type,\%display,$defbgone,$defbgtwo); + } + } # -------------------------------------------------- End entry for one resource - } - } @ids; - $r->print('
Any UserUser $uname at Domain $udom
User $uname at Domain $udomCurrent Session Value
($csuname at $csudom)
Resource Level in Coursein Section/Group $csecin Section/Group $csec
Assessment URL and TitleType Enclosing MapPart No.Parameter Name defaultfrom Enclosing Map generalfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resource
generalfor Enclosing Mapfor Resourcegeneralfor Enclosing Mapfor Resource
'. - join(' / ',split(/\//,$uri)). - '

'. - $bighash{'title_'.$rid}); - if ($thistitle) { - $r->print(' ('.$thistitle.')'); - } - $r->print('

'.$typep{$rid}.''. - join(' / ',split(/\//,$mapp{$rid})).'$part{$_}$display{$_}'. - &valout($outpar[11],$type{$_}).''. - &valout($outpar[10],$type{$_}).''. - &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2', - 'parmform.pres','psub').''. - &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1', - 'parmform.pres','psub').''.&valout($outpar[$result],$type{$_}).'
'. + join(' / ',split(/\//,$uri)). + '

'. + $bighash{'title_'.$rid}); + if ($thistitle) { + $r->print(' ('.$thistitle.')'); + } + $r->print('

'.$typep{$rid}.''. + join(' / ',split(/\//,$mapp{$rid})).'
'); - } - $r->print(''); - untie(%bighash); - untie(%parmhash); - } + } + } + $r->print(''); + } + $r->print(''); + 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 - map { + foreach (keys %ENV) { if ($_=~/^form\.(.+)\_setparmval$/) { my $name=$1; my $value=$ENV{'form.'.$name.'_value'}; @@ -705,80 +708,131 @@ sub crsenv { } if ($name eq 'url') { $value=~s/^\/res\///; + my @tmp = &Apache::lonnet::get + ('environment',['url'],$dom,$crs); $setoutput.='Backing up previous URL: '. - &Apache::lonnet::reply('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. - ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment:'. - &Apache::lonnet::escape('top level map backup '. - time).'='. - &Apache::lonnet::reply('get:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. - ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment:url', - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}), - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}). - '
'; - + &Apache::lonnet::put + ('environment', + {'top level map backup ' => $tmp[1] }, + $dom,$crs). + '
'; } if ($name) { - $setoutput.='Setting '.$name.' to '. - $value.': '. - &Apache::lonnet::reply('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. - ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment:'. - &Apache::lonnet::escape($name).'='. - &Apache::lonnet::escape($value), - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}). - '
'; + $setoutput.='Setting '.$name.' to '. + $value.': '. + &Apache::lonnet::put + ('environment',{$name=>$value},$dom,$crs). + '
'; } } - } keys %ENV; + } # -------------------------------------------------------- Get parameters again - my $rep=&Apache::lonnet::reply - ('dump:'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. - ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment', - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + + my %values=&Apache::lonnet::dump('environment',$dom,$crs); my $output=''; - if ($rep ne 'con_lost') { - my %values; + if (! exists($values{'con_lost'})) { my %descriptions= - ('url' => 'Top Level Map
'. - 'Modification may make assessment data inaccessible', - 'description' => 'Course Description', - 'courseid' => 'Course ID or number
(internal, optional)', - 'question.email' => 'Feedback Addresses for Content Questions
'. - '(user:domain,user:domain,...)', - 'comment.email' => 'Feedback Addresses for Comments
'. - '(user:domain,user:domain,...)', - 'policy.email' => 'Feedback Addresses for Course Policy
'. - '(user:domain,user:domain,...)' - ); - - map { - my ($name,$value)=split(/\=/,$_); - $name=&Apache::lonnet::unescape($name); - $values{$name}=&Apache::lonnet::unescape($value); - unless ($descriptions{$name}) { - $descriptions{$name}=$name; - } - } split(/\&/,$rep); - map { - $output.=''.$descriptions{$_}.''; - } keys %descriptions; - $output.='Create New Environment Variable
'. - ''. - ''. - ''; - } + ('url' => 'Top Level Map '. + '". + 'Browse
'. + 'Modification may make assessment data '. + 'inaccessible', + 'description' => 'Course Description', + 'courseid' => 'Course ID or number
'. + '(internal, optional)', + 'default_xml_style' => 'Default XML Style File '. + 'Browse
", + 'question.email' => 'Feedback Addresses for Content '. + 'Questions
(user:domain,'. + 'user:domain,...)', + 'comment.email' => 'Feedback Addresses for Comments
'. + '(user:domain,user:domain,...)', + 'policy.email' => 'Feedback Addresses for Course Policy'. + '
(user:domain,user:domain,...)', + 'hideemptyrows' => 'Hide Empty Rows in Spreadsheets
'. + '("yes" for default hiding)', + 'pageseparators' => 'Visibly Separate Items on Pages
'. + '("yes" for visible separation)', + 'pch.roles.denied'=> 'Disallow Resource Discussion for '. + 'Roles
"st": '. + 'student, "ta": '. + 'TA, "in": '. + 'instructor;
role,role,...) '. + Apache::loncommon::help_open_topic("Course_Disable_Discussion"), + 'pch.users.denied' => + 'Disallow Resource Discussion for Users
'. + '(user:domain,user:domain,...)', + 'spreadsheet_default_classcalc' + => 'Default Course Spreadsheet '. + 'Browse
", + 'spreadsheet_default_studentcalc' + => 'Default Student Spreadsheet '. + 'Browse
", + 'spreadsheet_default_assesscalc' + => 'Default Assessment Spreadsheet '. + 'Browse
", + ); + 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.=''.$descriptions{$_}.''. + ''. + ''. + ''."\n"; + } + my $onchange = 'onchange="javascript:window.document.forms'. + '[\'envform\'].elements[\'newp_setparmval\']'. + '.checked=true;"'; + $output.='Create New Environment Variable
'. + ''. + ''. + ''; + } $r->print(< + LON-CAPA Course Environment @@ -803,38 +857,106 @@ ENDENV # ================================================================ Main Handler sub handler { - my $r=shift; - - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } + 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'}))) { + if (($ENV{'request.course.id'}) && + (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { - unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) { + unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) { # --------------------------------------------------------- Bring up assessment - &assessparms($r); + &assessparms($r); # ---------------------------------------------- This is for course environment - } else { - &crsenv($r); - } - } else { + } 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; + $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: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonparmset + ErrorDocument 403 /adm/login + ErrorDocument 406 /adm/roles + ErrorDocument 500 /adm/errorhandler + + +=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 +