--- loncom/interface/lonnavmaps.pm 2001/01/16 22:19:18 1.7 +++ loncom/interface/lonnavmaps.pm 2001/10/31 17:44:42 1.19 @@ -9,13 +9,14 @@ # 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,2/8,9/21,9/24,9/25 Gerd Kortemeyer package Apache::lonnavmaps; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet(); +use Apache::loncommon(); use HTML::TokeParser; use GDBM_File; @@ -23,6 +24,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 +54,180 @@ 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=(); + my %opendate=(); + my %answerdate=(); + map { + if ($_=~/^parameter\_(.*)\_opendate$/) { + my $part=$1; + $duedate{$part}=&parmval($part.'.duedate',$symb); + $opendate{$part}=&parmval($part.'.opendate',$symb); + $answerdate{$part}=&parmval($part.'.answerdate',$symb); + } + } sort split(/\,/,&Apache::lonnet::metadata($hash{'src_'.$rid},'keys')); + + my $now=time; + my $tcode=0; + + my %returnhash=&Apache::lonnet::restore($symb); + + map { + + my $duedate=$duedate{$_}; + my $opendate=$opendate{$_}; + my $answerdate=$answerdate{$_}; + my $preface=''; + unless ($_ eq '0') { $preface=' Part: '.$_.' '; } + if ($opendate) { + if ($now<$duedate) { + unless ($tcode==4) { $tcode=2; } + $ctext.=$preface.'Due: '.localtime($duedate); + if ($now<$opendate) { + unless ($tcode) { $tcode=1; } + $ctext.=$preface.'Open: '.localtime($opendate); + } + if ($duedate-$now<86400) { + $tcode=4; + $ctext.=$preface.'Due: '.localtime($duedate); + } + } else { + unless (($tcode==4) || ($tcode eq 2)) { $tcode=3; } + if ($now<$answerdate) { + $ctext.='Answer: '.localtime($duedate); + } + } + } else { + unless (($tcode==2) || ($tcode==4)) { $tcode=1; } + } + + my $status=$returnhash{'resource.'.$_.'.solved'}; + + if ($status eq 'correct_by_student') { + unless ($code==2) { $code=3; } + $ctext.=' solved'; + } elsif ($status eq 'correct_by_override') { + unless ($code==2) { $code=3; } + $ctext.=' override'; + } elsif ($status eq 'incorrect_attempted') { + $code=2; + $ctext.=' ('. + ($returnhash{'resource.'.$_.'.tries'}? + $returnhash{'resource.'.$_.'.tries'}:'0').'/'. + &parmval($_.'.maxtries',$symb).' tries)'; + } elsif ($status eq 'incorrect_by_override') { + $code=2; + $ctext.=' override'; + } elsif ($status eq 'excused') { + unless ($code==2) { $code=3; } + $ctext.=' excused'; + } + + } sort keys %opendate; + + return 'p'.$code.$tcode.'"'.$ctext.'"'; +} + # ------------------------------------------------------------ Build page table sub tracetable { @@ -68,8 +260,10 @@ sub tracetable { my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid}); if (($brepriv eq '2') || ($brepriv eq 'F')) { my $pprefix=''; - if ($hash{'src_'.$frid}=~/\.problem$/) { - $pprefix='p1'; + if ($hash{'src_'.$frid}=~ + /\.(problem|exam|quiz|assess|survey|form)$/) { + $pprefix=&astatus($frid); + } if (defined($rows[$sofar])) { $rows[$sofar].='&'.$pprefix.$frid; @@ -85,8 +279,9 @@ sub tracetable { my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid}); if (($brepriv eq '2') || ($brepriv eq 'F')) { my $pprefix=''; - if ($hash{'src_'.$rid}=~/\.problem$/) { - $pprefix='p1'; + if ($hash{'src_'.$rid}=~ + /\.(problem|exam|quiz|assess|survey|form)$/) { + $pprefix=&astatus($rid); } if (defined($rows[$sofar])) { $rows[$sofar].='&'.$pprefix.$rid; @@ -148,12 +343,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=(); @@ -189,21 +434,52 @@ sub handler { $r->send_http_header; $r->print('Empty Map.'); } else { + # ------------------------------------------------------------------ Build page + my $currenturl=$ENV{'form.postdata'}; + $currenturl=~s/^http\:\/\///; + $currenturl=~s/^[^\/]+//; + # ---------------------------------------------------------------- Send headers $r->content_type('text/html'); + &Apache::loncommon::no_cache($r); $r->send_http_header; + my $date=localtime; $r->print( - 'Navigate LON-CAPA Maps'); - - $r->print(''. + 'Navigate LON-CAPA Maps'); + $r->print('print(' onLoad="window.location.hash='. + "'curloc'".'"'); + } + $r->print('>'. ''. '

Navigate Course Map

'); - $r->rflush(); + $r->rflush(); + if (($currenturl=~/^\/res/) && + ($currenturl!~/^\/res\/adm/)) { + $r->print('Current Location

'); + } +# ----------------------------------------------------- The little content list + for ($i=0;$i<=$#rows;$i++) { + if ($rows[$i]) { + my @colcont=split(/\&/,$rows[$i]); + my $avespan=$lcm/($#colcont+1); + for ($j=0;$j<=$#colcont;$j++) { + my $rid=$colcont[$j]; + if ($rid=~/^h(.+)/) { + $rid=$1; + $r->print( + '   '.$hash{'title_'.$rid}.'
'); + } + } + } + } # ----------------------------------------------------------------- Start table - $r->print(''); + $r->print('
'); for ($i=0;$i<=$#rows;$i++) { if ($rows[$i]) { $r->print("\n"); @@ -217,23 +493,50 @@ sub handler { my $hwke=''; if ($rid=~/^h(.+)/) { $rid=$1; - $add=''; } - if ($rid=~/^p(\d)(.+)/) { + if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) { my $code=$1; - $rid=$2; - $hwk=''; + my $tcode=$2; + my $ctext=$3; + $rid=$4; + if ($tcode eq '1') { + $add=''; + } + } + $hwk=''; + $hwke=''; + if ($code eq '1') { + $hwke=' ('.$ctext.')'; + } if ($code eq '2') { - $hwk=''; - $hwke=''; + $hwk=''; + $hwke=' ('.$ctext.')'; } if ($code eq '3') { - $hwk=''; - } elsif ($code eq '4') { - $hwk=''; + $hwk=''; + $hwke=' ('.$ctext.')'; } } + if ($hash{'src_'.$rid} eq $currenturl) { + $add=$add.''. + '-> '; + $adde= + ' <-'.$adde; + } $r->print($add.''.$hwk. $hash{'title_'.$rid}.$hwke.''.$adde); @@ -242,7 +545,6 @@ sub handler { } } $r->print("\n
'; + $add= + ''; $adde=''; + } + if ($code eq '3') { + $add=''; + } else { + $add=''; + if ($tcode eq '2') { + $add=''; + } + if ($tcode eq '4') { + $add=''; + $adde='
"); - $r->print(''); # -------------------------------------------------------------------- End page } @@ -257,6 +559,10 @@ sub handler { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn (browse)."); } + unless (untie(%parmhash)) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie parmhash (browse)."); + } # -------------------------------------------------------------------- All done return OK; # ----------------------------------------------- Errors, hash could no be tied