--- loncom/interface/lonparmset.pm 2000/11/23 20:42:55 1.6 +++ loncom/interface/lonparmset.pm 2001/07/06 12:11:22 1.30 @@ -9,7 +9,10 @@ # # 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, +# 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09, +# 07/05,07/06 Gerd Kortemeyer package Apache::lonparmset; @@ -17,7 +20,6 @@ use strict; use Apache::lonnet; use Apache::Constants qw(:common :http REDIRECT); use GDBM_File; -use Apache::lonmeta; my %courseopt; @@ -25,9 +27,17 @@ 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; @@ -40,87 +50,113 @@ 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 $mapparm=$mapp{$id}.'___(all).'.$what; + my $seclevel= - $ENV{'request.course.id'}.'.'. - $ENV{'request.course.sec'}.'.'.$what; + $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 user +# -------------------------------------------------------- first, check default - if ($uname) { - if ($useropt{$reslevel}) { return $useropt{$reslevel}; } - if ($useropt{$seclevel}) { return $useropt{$seclevel}; } - if ($useropt{$courselevel}) { return $useropt{$courselevel}; } + 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; } + } -# -------------------------------------------------------- second, check course +# ---------------------------------------------------------- fourth, check user + + if ($uname) { - if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; } - if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } - if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } + if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel}; + $result=3; } -# ------------------------------------------------------ third, check map parms + if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; + $result=2; } - my $thisparm=$parmhash{$symbparm}; - if ($thisparm) { return $thisparm; } - -# --------------------------------------------- last, look in resource metadata + if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; + $result=1; } - 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 ''; + } + + return $result; } -# ---------------------------------------------------------------- Sort routine +# ------------------------------------------------------------ Output for value -sub bycat { - if ($fcat eq '') { - $a<=>$b; - } else { - &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); - } +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; - - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } - -# ----------------------------------------------------- Needs to be in a course +sub assessparms { - if (($ENV{'request.course.fn'}) && - (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { + my $r=shift; # -------------------------------------------------------- Variable declaration %courseopt=(); @@ -131,22 +167,71 @@ sub handler { %symbp=(); %typep=(); - $uname=$ENV{'form.uname'}; + 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=''; - my $message=''; if ($uname) { $uhome=&Apache::lonnet::homeserver($uname,$udom); - } - if ($uhome eq 'no_host') { + + if ($uhome eq 'no_host') { $message= - "
\nFull Name: ".
+ $name{'firstname'}.' '.$name{'middlename'}
+ .$name{'lastname'}.' '.$name{'generation'}.
+ "
\nID: ".$name{'id'}.'
';
+ }
+ }
}
- $csec=$ENV{'form.csec'};
unless ($csec) { $csec=''; }
+
$fcat=$ENV{'form.fcat'};
unless ($fcat) { $fcat=''; }
@@ -156,6 +241,138 @@ sub handler {
(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/\_/\./;
+# ---------------------------------------------------------- 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'}.':'.
@@ -164,7 +381,8 @@ sub handler {
if ($reply!~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
- $courseopt{unescape($name)}=unescape($value);
+ $courseopt{&Apache::lonnet::unescape($name)}=
+ &Apache::lonnet::unescape($value);
} split(/\&/,$reply);
}
# --------------------------------------------------- Get userdata (if present)
@@ -174,36 +392,32 @@ sub handler {
if ($reply!~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
- $useropt{unescape($name)}=unescape($value);
+ $useropt{&Apache::lonnet::unescape($name)}=
+ &Apache::lonnet::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;
+
+ @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 Assessment Parameters
+Set Course Parameters
+
+