--- loncom/interface/lonnavmaps.pm 2001/01/06 20:17:33 1.5 +++ loncom/interface/lonnavmaps.pm 2001/01/30 19:31:32 1.10 @@ -9,7 +9,7 @@ # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23, # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer) # -# 3/1/1,6/1 Gerd Kortemeyer +# 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer package Apache::lonnavmaps; @@ -23,6 +23,23 @@ use GDBM_File; my %hash; my @rows; +# +# These cache hashes need to be independent of user, resource and course +# (user and course can/should be in the keys) +# + +my %courserdatas; +my %userrdatas; + +# +# These global hashes are dependent on user, course and resource, +# and need to be initialized every time when a sheet is calculated +# +my %courseopt; +my %useropt; +my %parmhash; + + # ------------------------------------------------------------------ Euclid gcd sub euclid { @@ -36,6 +53,158 @@ sub euclid { return $b; } +# --------------------------------------------------------------------- Parmval + +# -------------------------------------------- Figure out a cascading parameter +# +# For this function to work +# +# * parmhash needs to be tied +# * courseopt and useropt need to be initialized for this user and course +# + +sub parmval { + my ($what,$symb)=@_; + my $cid=$ENV{'request.course.id'}; + my $csec=$ENV{'request.course.sec'}; + my $uname=$ENV{'user.name'}; + my $udom=$ENV{'user.domain'}; + + unless ($symb) { return ''; } + my $result=''; + + my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); + +# ----------------------------------------------------- Cascading lookup scheme + my $rwhat=$what; + $what=~s/^parameter\_//; + $what=~s/\_/\./; + + my $symbparm=$symb.'.'.$what; + my $mapparm=$mapname.'___(all).'.$what; + my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; + + my $seclevel= + $usercourseprefix.'.['. + $csec.'].'.$what; + my $seclevelr= + $usercourseprefix.'.['. + $csec.'].'.$symbparm; + my $seclevelm= + $usercourseprefix.'.['. + $csec.'].'.$mapparm; + + my $courselevel= + $usercourseprefix.'.'.$what; + my $courselevelr= + $usercourseprefix.'.'.$symbparm; + my $courselevelm= + $usercourseprefix.'.'.$mapparm; + +# ---------------------------------------------------------- fourth, check user + + if ($uname) { + + if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; } + + if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; } + + if ($useropt{$courselevel}) { return $useropt{$courselevel}; } + + } + +# --------------------------------------------------------- third, check course + + if ($csec) { + + if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; } + + if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; } + + if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } + + } + + if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; } + + if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; } + + if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } + +# ----------------------------------------------------- second, check map parms + + my $thisparm=$parmhash{$symbparm}; + if ($thisparm) { return $thisparm; } + +# -------------------------------------------------------- first, check default + + return &Apache::lonnet::metadata($fn,$rwhat.'.default'); + +} + + + +# ------------------------------------------------------------- Find out status + +sub astatus { + my $rid=shift; + my $code=1; + my $ctext=''; + $rid=~/(\d+)\.(\d+)/; + my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'. + &Apache::lonnet::declutter($hash{'src_'.$rid}); + my $duedate=&parmval('0.duedate',$symb); + if ($duedate) { + $ctext.='Due: '.localtime($duedate); + } + my $answer=&Apache::lonnet::reply( + "restore:$ENV{'user.domain'}:$ENV{'user.name'}:". + $ENV{'request.course.id'}.':'. + &Apache::lonnet::escape($symb), + "$ENV{'user.home'}"); + my %returnhash=(); + map { + my ($name,$value)=split(/\=/,$_); + $returnhash{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } split(/\&/,$answer); + if ($returnhash{'version'}) { + my $version; + for ($version=1;$version<=$returnhash{'version'};$version++) { + map { + $returnhash{$_}=$returnhash{$version.':'.$_}; + } split(/\:/,$returnhash{$version.':keys'}); + } + map { + if (($_=~/\.(\w+)\.solved$/) && ($_!~/^\d+\:/)) { + my $part=$1; + if ($ctext) { $ctext.=', '; } + if ($part) { + $ctext.='Part '.$part.': '; + } + if ($returnhash{$_} eq 'correct_by_student') { + unless ($code==2) { $code=3; } + $ctext.='solved'; + } elsif ($returnhash{$_} eq 'correct_by_override') { + unless ($code==2) { $code=3; } + $ctext.='override'; + } elsif ($returnhash{$_} eq 'incorrect_attempted') { + $code=2; + $ctext.= + $returnhash{'resource.'.$part.'.tries'}.' attempt(s)'; + } elsif ($returnhash{$_} eq 'incorrect_by_override') { + $code=2; + $ctext.='override'; + } elsif ($returnhash{$_} eq 'excused') { + unless ($code==2) { $code=3; } + $ctext.='excused'; + } + } + } keys %returnhash; + } + return 'p'.$code.'"'.$ctext.'"'; +} + # ------------------------------------------------------------ Build page table sub tracetable { @@ -45,8 +214,20 @@ sub tracetable { $beenhere.=$rid.'&'; if (defined($hash{'is_map_'.$rid})) { + $sofar++; + my $tprefix=''; + if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}} + eq 'sequence') { + $tprefix='h'; + } + if (defined($rows[$sofar])) { + $rows[$sofar].='&'.$tprefix.$rid; + } else { + $rows[$sofar]=$tprefix.$rid; + } if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && - (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { + (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) && + ($tprefix eq 'h')) { my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; $sofar= &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}}, @@ -55,10 +236,16 @@ sub tracetable { if ($hash{'src_'.$frid}) { my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid}); if (($brepriv eq '2') || ($brepriv eq 'F')) { + my $pprefix=''; + if ($hash{'src_'.$frid}=~ + /\.(problem|exam|quiz|assess|survey|form)$/) { + $pprefix=&astatus($frid); + + } if (defined($rows[$sofar])) { - $rows[$sofar].='&'.$frid; + $rows[$sofar].='&'.$pprefix.$frid; } else { - $rows[$sofar]=$frid; + $rows[$sofar]=$pprefix.$frid; } } } @@ -68,10 +255,15 @@ sub tracetable { if ($hash{'src_'.$rid}) { my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid}); if (($brepriv eq '2') || ($brepriv eq 'F')) { + my $pprefix=''; + if ($hash{'src_'.$rid}=~ + /\.(problem|exam|quiz|assess|survey|form)$/) { + $pprefix=&astatus($rid); + } if (defined($rows[$sofar])) { - $rows[$sofar].='&'.$rid; + $rows[$sofar].='&'.$pprefix.$rid; } else { - $rows[$sofar]=$rid; + $rows[$sofar]=$pprefix.$rid; } } } @@ -128,12 +320,62 @@ sub handler { if ($ENV{'request.course.fn'}) { my $fn=$ENV{'request.course.fn'}; if (-e "$fn.db") { - if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { + if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) && + (tie(%parmhash,'GDBM_File', + $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { # ------------------------------------------------------------------- Hash tied my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; if (($firstres) && ($lastres)) { # ----------------------------------------------------------------- Render page +# -------------------------------------------------------------- Set parameters + + +# ---------------------------- initialize coursedata and userdata for this user + undef %courseopt; + undef %useropt; + + my $uname=$ENV{'user.name'}; + my $udom=$ENV{'user.domain'}; + my $uhome=$ENV{'user.home'}; + my $cid=$ENV{'request.course.id'}; + my $chome=$ENV{'course.'.$cid.'.home'}; + my ($cdom,$cnum)=split(/\_/,$cid); + + my $userprefix=$uname.'_'.$udom.'_'; + + unless ($uhome eq 'no_host') { +# -------------------------------------------------------------- Get coursedata + unless + ((time-$courserdatas{$cid.'.last_cache'})<240) { + my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. + ':resourcedata',$chome); + if ($reply!~/^error\:/) { + $courserdatas{$cid}=$reply; + $courserdatas{$cid.'.last_cache'}=time; + } + } + map { + my ($name,$value)=split(/\=/,$_); + $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } split(/\&/,$courserdatas{$cid}); +# --------------------------------------------------- Get userdata (if present) + unless + ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { + my $reply= + &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); + if ($reply!~/^error\:/) { + $userrdatas{$uname.'___'.$udom}=$reply; + $userrdatas{$uname.'___'.$udom.'.last_cache'}=time; + } + } + map { + my ($name,$value)=split(/\=/,$_); + $useropt{$userprefix.&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } split(/\&/,$userrdatas{$uname.'___'.$udom}); + } @rows=(); @@ -169,6 +411,7 @@ sub handler { $r->send_http_header; $r->print('
Empty Map.'); } else { + # ------------------------------------------------------------------ Build page # ---------------------------------------------------------------- Send headers @@ -179,6 +422,8 @@ sub handler { '