# The LearningOnline Network with CAPA # Handler to set parameters for assessments # # $Id: lonparmset.pm,v 1.41 2001/12/26 21:45:29 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,08/09,09/01,09/21 Gerd Kortemeyer # 12/17 Scott Harrison # 12/19 Guy Albertelli # 12/26 Gerd Kortemeyer # ### 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=(); # ----------------------------------------------------- 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; } # ------------------------------------------------------------ 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 ''. &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=''; } 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=''; }
$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;
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; }
$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\:/) {
foreach (split(/\&/,$reply)) {
my ($name,$value)=split(/\=/,$_);
$courseopt{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
}
}
# --------------------------------------------------- Get userdata (if present)
if ($uname) {
my $reply=
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
if ($reply!~/^error\:/) {
foreach (split(/\&/,$reply)) {
my ($name,$value)=split(/\=/,$_);
$useropt{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
}
}
}
# ------------------------------------------------------------------- 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(<Set Course Parameters