--- loncom/interface/lonparmset.pm 2000/11/24 20:00:27 1.10 +++ loncom/interface/lonparmset.pm 2001/02/08 12:36:57 1.22 @@ -9,7 +9,9 @@ # # 10/11,10/12,10/16 Gerd Kortemeyer) # -# 11/20,11/21,11/22,11/23,11/24,11/25 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 Gerd Kortemeyer package Apache::lonparmset; @@ -17,7 +19,6 @@ use strict; use Apache::lonnet; use Apache::Constants qw(:common :http REDIRECT); use GDBM_File; -use Apache::lonmeta; my %courseopt; @@ -31,6 +32,10 @@ my @ids; my %symbp; my %mapp; my %typep; +my %keyp; +my %defp; + +my %allkeys; my $uname; my $udom; @@ -43,8 +48,9 @@ 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; @@ -52,13 +58,13 @@ sub parmval { my $seclevel= $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$what; + $csec.'].'.$what; my $seclevelr= $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$symbparm; + $csec.'].'.$symbparm; my $seclevelm= $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$mapparm; + $csec.'].'.$mapparm; my $courselevel= $ENV{'request.course.id'}.'.'.$what; @@ -67,65 +73,57 @@ sub parmval { my $courselevelm= $ENV{'request.course.id'}.'.'.$mapparm; -# ----------------------------------------------------------- first, check user - - if ($uname) { - if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; - $result=1; } - if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; - $result=2; } - if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel}; - $result=3; } - } +# -------------------------------------------------------- first, check default -# -------------------------------------------------------- second, check course + if ($def) { $outpar[11]=$def; + $result=11; } - if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr}; - $result=4; } - if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm}; - $result=5; } - if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel}; - $result=6; } +# ----------------------------------------------------- second, check map parms + + my $thisparm=$parmhash{$symbparm}; + if ($thisparm) { $outpar[10]=$thisparm; + $result=10; } + +# --------------------------------------------------------- third, check course - if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; - $result=7; } - if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; - $result=8; } if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel}; $result=9; } -# ------------------------------------------------------ third, check map parms + if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; + $result=8; } - my $thisparm=$parmhash{$symbparm}; - if ($thisparm) { $outpar[10]=$thisparm; - $result=10; } - -# --------------------------------------------- last, look in resource metadata + if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; + $result=7; } - 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\>/) { - $outpar[11]=$1; - $result=11; - } - } - return $result; -} + if ($csec) { -# ---------------------------------------------------------------- Sort routine + if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel}; + $result=6; } -sub bycat { - if ($fcat eq '') { - $a<=>$b; - } else { - &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); - } + 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 @@ -142,7 +140,7 @@ sub plink { my ($type,$dis,$value,$marker,$return,$call)=@_; return ''. - &valout($value,$type).''; + &valout($value,$type).''; } # ================================================================ Main Handler @@ -170,22 +168,54 @@ 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 $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=''; } @@ -195,6 +225,110 @@ sub handler { (tie(%parmhash,'GDBM_File', $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { +# --------------------------------------------------------- Get all assessments + %allkeys=(); + %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}); + $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 + $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 + $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'}.':'. @@ -203,7 +337,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) @@ -213,29 +348,22 @@ 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; - $mapp{$id}= - &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); - $symbp{$id}=$mapp{$id}. - '___'.$resid.'___'. - &Apache::lonnet::declutter($bighash{$_}); - } - } - } keys %bighash; + # ------------------------------------------------------------------- Sort this - @ids=sort bycat @ids; + + @ids=sort { + if ($fcat eq '') { + $a<=>$b; + } else { + $outpar[&parmval($fcat,$a,$defp{$a})]<=> + $outpar[&parmval($fcat,$b,$defp{$b})]; + } + } @ids; # ------------------------------------------------------------------ Start page $r->content_type('text/html'); $r->send_http_header; @@ -244,6 +372,7 @@ sub handler {
Sort list by '); + + $r->print('
Sort list by ');
$r->print('');
# ----------------------------------------------------------------- Start Table
my $coursespan=$csec?8:5;
$r->print(< '.
+ $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; }
+ $r->print(' '.
$bighash{'title_'.$rid});
if ($thistitle) {
$r->print(' ('.$thistitle.')');
}
- $r->print('
-
+
Any User
ENDTABLEHEAD
if ($uname) {
$r->print("User $uname at Domain $udom ");
}
$r->print(<
+ Parameter in Effect
Resource Level
in Course
ENDTABLETWO
if ($csec) {
$r->print("in Section/Group $csec ");
}
- $r->print('');
$r->print(< Assessment URL and Title
+Assessment URL and Title Type
Enclosing Map Part No. Parameter Name
-from Metadata from Enclosing Map
+default from Enclosing Map
general for Enclosing Map for Resource
ENDTABLEHEADFOUR
if ($csec) {
@@ -323,67 +463,126 @@ ENDTABLEHEADFOUR
$r->print('general for Enclosing Map for Resource ');
}
$r->print('');
+ my $defbgone='';
+ my $defbgtwo='';
map {
# ------------------------------------------------------ Entry for one resource
+ if ($defbgone eq '"E0E099"') {
+ $defbgone='"E0E0DD"';
+ } else {
+ $defbgone='"E0E099"';
+ }
+ if ($defbgtwo eq '"FFFF99"') {
+ $defbgtwo='"FFFFDD"';
+ } else {
+ $defbgtwo='"FFFF99"';
+ }
@outpar=();
my $rid=$_;
my $thistitle='';
- my @part=(0,1,1);
- my @name=('deadline','sig','tol');
- my @display=('Deadline','Significant Figures','Tolerance');
- my @type=('date','int','tolerance');
- my %metadata=&Apache::lonmeta::unpackagemeta(
-&Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
+ my %name= ();
+ my %part= ();
+ my %display=();
+ my %type= ();
+ my %default=();
+ my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
+
map {
- if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
- $part[$#part+1]=$1;
- $name[$#name+1]=$2;
- ($type[$#type+1],$display[$#display+1])=
- split(/\_\_dis\_\_/,$metadata{$_});
- unless ($display[$#display]) {
- $display[$#display]=$name[$#name];
- }
- }
- if ($_ eq 'title') {
- $thistitle=$metadata{$_};
- }
- } keys %metadata;
- my $totalparms=$#name+1;
- $r->print(' \n'.
- join(' / ',split(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))).
- ' '.
+ join(' / ',split(/\//,$uri)).
+ ' ');
- $r->print(''.
+ $r->print(' ');
+ $r->print(''.$typep{$rid}.' ');
+ $r->print(''.
join(' / ',split(/\//,$mapp{$rid})).' ');
- my $i;
- for ($i=0;$i<$totalparms;$i++) {
- $r->print("$part[$i] $display[$i] ");
- $r->print(''.&valout($outpar[8],$type[$i]).' ');
- $r->print(''.&valout($outpar[7],$type[$i]).' ');
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[6]).' ');
+ if ($isdef) {
+ map {
+ my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
+
+ $r->print("$part{$_} $display{$_} ");
+ my $thismarker=$_;
+ $thismarker=~s/^parameter\_//;
+ my $mprefix=$rid.'&'.$thismarker.'&';
+
+ $r->print(''.
+ &valout($outpar[11],$type{$_}).' ');
+ $r->print(''.
+ &valout($outpar[10],$type{$_}).' ');
+
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
+ 'parmform.pres','psub').' ');
+
if ($csec) {
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[5]).' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
+ 'parmform.pres','psub').' ');
}
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[4]).' ');
+
if ($uname) {
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[3]).' ');
- if ($csec) {
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[2]).' ');
- }
- $r->print(''.
- &plink($type[$i],$display[$i],$outpar[1]).' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
+ 'parmform.pres','psub').' ');
+ $r->print(''.
+ &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
+ 'parmform.pres','psub').' ');
}
+
+ $r->print(
+ ''.&valout($outpar[$result],$type{$_}).' ');
$r->print("");
- }
+ } sort keys %name;
+ } else {
+ $r->print(" \n");
+ }
# -------------------------------------------------- End entry for one resource
} @ids;
$r->print('