--- loncom/interface/lonparmset.pm 2000/11/23 20:42:55 1.6 +++ loncom/interface/lonparmset.pm 2002/02/12 00:14:07 1.43 @@ -1,23 +1,57 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # +# $Id: lonparmset.pm,v 1.43 2002/02/12 00:14:07 albertel 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 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 +# +### package Apache::lonparmset; use strict; use Apache::lonnet; use Apache::Constants qw(:common :http REDIRECT); +use Apache::loncommon; use GDBM_File; -use Apache::lonmeta; my %courseopt; @@ -25,9 +59,13 @@ my %useropt; my %bighash; my %parmhash; +my @outpar; + my @ids; my %symbp; +my %mapp; my %typep; +my %keyp; my $uname; my $udom; @@ -40,170 +78,370 @@ my $fcat; # -------------------------------------------- Figure out a cascading parameter sub parmval { - my ($what,$id)=@_; + my ($what,$id,$def)=@_; + my $result=''; + @outpar=(); # ----------------------------------------------------- Cascading lookup scheme - my $symbparm=$symbp{$id}.'.'.$what; - my $reslevel= - $ENV{'request.course.id'}.'.'.$symbparm; - my $seclevel= - $ENV{'request.course.id'}.'.'. - $ENV{'request.course.sec'}.'.'.$what; - my $courselevel= - $ENV{'request.course.id'}.'.'.$what; - -# ----------------------------------------------------------- first, check user - - if ($uname) { - if ($useropt{$reslevel}) { return $useropt{$reslevel}; } - if ($useropt{$seclevel}) { return $useropt{$seclevel}; } - if ($useropt{$courselevel}) { return $useropt{$courselevel}; } - } - -# -------------------------------------------------------- second, check course - - if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; } - if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } - if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } - -# ------------------------------------------------------ third, check map parms - - my $thisparm=$parmhash{$symbparm}; - if ($thisparm) { return $thisparm; } - -# --------------------------------------------- last, look in resource metadata - - my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta'; - if (-e $filename) { - my @content; - { - my $fh=Apache::File->new($filename); - @content=<$fh>; - } - if (join('',@content)=~ - /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) { - return $1; - } - } - return ''; -} -# ---------------------------------------------------------------- Sort routine + my $symbparm=$symbp{$id}.'.'.$what; + my $mapparm=$mapp{$id}.'___(all).'.$what; -sub bycat { - if ($fcat eq '') { - $a<=>$b; - } else { - &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); + 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)=@_; - return ''. - (($type=~/^date/)?localtime($value):$value).''; + 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).''; } -# ================================================================ Main Handler - -sub handler { - my $r=shift; +sub assessparms { - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } + my $r=shift; +# -------------------------------------------------------- Variable declaration + my %allkeys; + my %allmaps; + my %defp; + %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'}=''; + } -# ----------------------------------------------------- Needs to be in a course + 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'}.'
'; + } + } + } - if (($ENV{'request.course.fn'}) && - (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { -# -------------------------------------------------------- Variable declaration + unless ($csec) { $csec=''; } - %courseopt=(); - %useropt=(); - %bighash=(); - - @ids=(); - %symbp=(); - %typep=(); - - $uname=$ENV{'form.uname'}; - $udom=$ENV{'form.udom'}; - unless ($udom) { $uname=''; } - $uhome=''; - my $message=''; - if ($uname) { - $uhome=&Apache::lonnet::homeserver($uname,$udom); - } - if ($uhome eq 'no_host') { - $message= - "