# The LearningOnline Network with CAPA # Navigate Maps Handler # # $Id: lonnavmaps.pm,v 1.45 2002/09/02 18:25:55 bowersj2 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/ # # (Page Handler # # (TeX Content Handler # # 05/29/00,05/30 Gerd Kortemeyer) # 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,17/1,29/1,30/1,2/8,9/21,9/24,9/25 Gerd Kortemeyer # YEAR=2002 # 1/1 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; # -------------------------------------------------------------- Module Globals 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 { my ($e,$f)=@_; my $a; my $b; my $r; if ($e>$f) { $b=$e; $r=$f; } else { $r=$e; $b=$f; } while ($r!=0) { $a=$b; $b=$r; $r=$a%$b; } 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; # ---------------------------------------------------------- first, check user if ($uname) { if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; } if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; } if ($useropt{$courselevel}) { return $useropt{$courselevel}; } } # ------------------------------------------------------- second, 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}; } # ----------------------------------------------------- third, check map parms my $thisparm=$parmhash{$symbparm}; if ($thisparm) { return $thisparm; } # ----------------------------------------------------- fourth , check default my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default'); if ($default) { return $default} # --------------------------------------------------- fifth , cascade up parts my ($space,@qualifier)=split(/\./,$rwhat); my $qualifier=join('.',@qualifier); unless ($space eq '0') { my ($part,$id)=split(/\_/,$space); if ($id) { my $partgeneral=&parmval($part.".$qualifier",$symb); if ($partgeneral) { return $partgeneral; } } else { my $resourcegeneral=&parmval("0.$qualifier",$symb); if ($resourcegeneral) { return $resourcegeneral; } } } return ''; } # ------------------------------------------------------------- Find out status # return codes # tcode (timecode) # 1: will open later # 2: is open and not past due yet # 3: is past due date # 4: due in the next 24 hours # # code (curent solved status) # 1: not attempted # 2: attempted but wrong, or incorrect by instructor # 3: solved or correct by instructor # 4: partially correct (one or more parts correct) # "excused" needs to be supported, but is not yet. sub astatus { my $rid=shift; my $code=0; 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=(); # need to always check part 0's open/due/answer status foreach (sort(split(/\,/,&Apache::lonnet::metadata($hash{'src_'.$rid},'keys')))) { if ($_=~/^parameter\_(.*)\_opendate$/) { my $part=$1; $duedate{$part}=&parmval($part.'.duedate',$symb); $opendate{$part}=&parmval($part.'.opendate',$symb); $answerdate{$part}=&parmval($part.'.answerdate',$symb); } } my $now=time; my $tcode=0; my %returnhash=&Apache::lonnet::restore($symb); foreach (sort(keys(%opendate))) { my $duedate=$duedate{$_}; my $opendate=$opendate{$_}; my $answerdate=$answerdate{$_}; my $preface=''; unless ($_ eq '0') { $preface=' Part: '.$_.' '; } if ($opendate) { if ($now<$duedate || (!$duedate)) { unless ($tcode==4) { $tcode=2; } if ($duedate) { $ctext.=$preface.'Due: '.localtime($duedate); } else { $ctext.=$preface.'No Due Date'; } if ($now<$opendate) { unless ($tcode) { $tcode=1; } $ctext.=$preface.'Open: '.localtime($opendate); } if ($duedate && $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') { if ($code==0||$code==3) { $code=3; } else { $code=4; } $ctext.=' solved'; } elsif ($status eq 'correct_by_override') { if ($code==0||$code==3) { $code=3; } else { $code=4; } $ctext.=' override'; } elsif ($status eq 'incorrect_attempted') { if ($code!=4 && $code!=3) { $code=2; } if ($code==3) { $code=4; } $ctext.=' ('. ($returnhash{'resource.'.$_.'.tries'}? $returnhash{'resource.'.$_.'.tries'}:'0'); my $numtries = &parmval($_.'.maxtries',$symb); if ($numtries) { $ctext.='/'.$numtries.' tries'; } $ctext.=')'; } elsif ($status eq 'incorrect_by_override') { if ($code!=4 && $code!=3) { $code=2; } if ($code==3) { $code=4; } $ctext.=' override'; } elsif ($status eq 'excused') { if ($code==0||$code==3) { $code=3; } else { $code=4; } $ctext.=' excused'; } else { if ($code==0) { $code=1; } } } return 'p'.$code.$tcode.'"'.$ctext.'"'; } sub addresource { my ($resource,$sofar,$rid,$showtypes,$indent,$linkid)=@_; if ($showtypes eq 'problems') { if ($resource!~/\.(problem|exam|quiz|assess|survey|form)$/) { return; } } my $brepriv=&Apache::lonnet::allowed('bre',$resource); if ($hash{'src_'.$rid}) { if (($brepriv eq '2') || ($brepriv eq 'F')) { my $pprefix=''; if ($resource=~/\.(problem|exam|quiz|assess|survey|form)$/) { $pprefix=&astatus($rid); } $$sofar++; if ($indent) { $pprefix='i'.$indent.','.$pprefix; } if ($linkid) { $pprefix='l'.$linkid.','.$pprefix; } if (defined($rows[$$sofar])) { $rows[$$sofar].='&'.$pprefix.$rid; } else { $rows[$$sofar]=$pprefix.$rid; } } } } sub followlinks () { my ($rid,$sofar,$beenhere,$further,$showtypes,$indent,$linkid)=@_; my $mincond=1; my $next=''; foreach (split(/\,/,$hash{'to_'.$rid})) { my $thiscond= &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}}); if ($thiscond>=$mincond) { if ($next) { $next.=','.$_.':'.$thiscond; } else { $next=$_.':'.$thiscond; } if ($thiscond>$mincond) { $mincond=$thiscond; } } } my $col=0; &Apache::lonxml::debug("following links -$next-"); foreach (split(/\,/,$next)) { my ($nextlinkid,$condval)=split(/\:/,$_); if ($condval>=$mincond) { my $now=&tracetable($sofar,$hash{'goesto_'.$nextlinkid}, $beenhere,$showtypes,$indent,$linkid); if ($now>$further) { if ($col>0) { my $string; for(my $i=0;$i<$col;$i++) { $string.='&'; } for(my $i=$further+1;$now-1>$i;$i++) { $rows[$i]=$string.$rows[$i]; } } $further=$now; } } $col++; } return $further; } # ------------------------------------------------------------ Build page table sub tracetable { my ($sofar,$rid,$beenhere,$showtypes,$indent,$linkid)=@_; my $newshowtypes=$showtypes; my $further=$sofar; # $Apache::lonxml::debug=1; &Apache::lonxml::debug("$rid ; $linkid ; $sofar ; $beenhere ; ".$hash{'src_'.$rid}); if ($beenhere=~/\&$rid\&/) { return $further; } $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'; } elsif ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}} eq 'page') { $tprefix='j'; if ($indent) { $tprefix='i'.$indent.','.$tprefix; } if ($linkid) { $tprefix='l'.$linkid.','.$tprefix; } $newshowtypes='problems'; $indent++; #if in a .page continue to link the encompising .page if (!$linkid) { $linkid=$rid; } } 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}}))) { my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; $sofar=&tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}}, '&'.$frid.'&',$newshowtypes,$indent,$linkid); &addresource($hash{'src_'.$frid},\$sofar,$frid,$newshowtypes, $indent,$linkid); if ($tprefix =~ /j$/) { $indent--; $linkid=''; } } } else { &addresource($hash{'src_'.$rid},\$sofar,$rid,$showtypes, $indent,$linkid); } if (defined($hash{'to_'.$rid})) { $further=&followlinks($rid,$sofar,$beenhere,$further,$showtypes, $indent,$linkid); } return $further; } # ================================================================ Main Handler sub handler { my $r=shift; # ------------------------------------------- Set document type for header only if ($r->header_only) { if ($ENV{'browser.mathml'}) { $r->content_type('text/xml'); } else { $r->content_type('text/html'); } $r->send_http_header; return OK; } my $requrl=$r->uri; my $hashtied; # ----------------------------------------------------------------- Tie db file my $fn; if ($ENV{'request.course.fn'}) { $fn=$ENV{'request.course.fn'}; if (-e "$fn.db") { if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) && (tie(%parmhash,'GDBM_File', $ENV{'request.course.fn'}.'_parms.db', &GDBM_READER(),0640))) { $hashtied=1; } } } if (!$hashtied) { $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; return HTTP_NOT_ACCEPTABLE; } # ------------------------------------------------------------------- Hash tied if ($ENV{'browser.mathml'}) { $r->content_type('text/xml'); } else { $r->content_type('text/html'); } &Apache::loncommon::no_cache($r); $r->send_http_header; my $firstres=$hash{'map_start_'. &Apache::lonnet::clutter($ENV{'request.course.uri'})}; my $lastres=$hash{'map_finish_'. &Apache::lonnet::clutter($ENV{'request.course.uri'})}; if (!(($firstres) && ($lastres))) { $r->print('Coursemap undefined.'); } else { # ----------------------------------------------------------------- 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; } } foreach (split(/\&/,$courserdatas{$cid})) { my ($name,$value)=split(/\=/,$_); $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= &Apache::lonnet::unescape($value); } # --------------------------------------------------- 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; } } foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { my ($name,$value)=split(/\=/,$_); $useropt{$userprefix.&Apache::lonnet::unescape($name)}= &Apache::lonnet::unescape($value); } } @rows=(); &tracetable(0,$firstres,'&','',0); # ------------------------------------------------------------------ Page parms my $j; my $i; my $lcm=1; my $contents=0; # ---------------------------------------------- Go through table to get layout for ($i=0;$i<=$#rows;$i++) { if ($rows[$i]) { &Apache::lonxml::debug("Row $i is:".$rows[$i]); $contents++; my @colcont=split(/\&/,$rows[$i]); $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1)); } } unless ($contents) { $r->print('Empty Map.'); } else { # ------------------------------------------------------------------ Build page my $currenturl=$ENV{'form.postdata'}; $currenturl=~s/^http\:\/\///; $currenturl=~s/^[^\/]+//; # ---------------------------------------------------------------- Send headers my $date=localtime; my $now=time; # ----------------------------------------- Get email status and discussiontime my %emailstatus=&Apache::lonnet::dump('email_status'); my $logouttime=$emailstatus{'logout'}; my $courseleave=$emailstatus{'logout_'.$ENV{'request.course.id'}}; my $lastcheck=($courseleave>$logouttime?$courseleave:$logouttime); my %discussiontimes=&Apache::lonnet::dump('discussiontimes', $cdom,$cnum); my %feedback=(); my %error=(); foreach my $msgid (split(/\&/,&Apache::lonnet::reply('keys:'. $ENV{'user.domain'}.':'. $ENV{'user.name'}.':nohist_email', $ENV{'user.home'}))) { $msgid=&Apache::lonnet::unescape($msgid); my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid)); if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) { my ($what,$url)=($1,$2); my %status= &Apache::lonnet::get('email_status',[$msgid]); if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } if (($status{$msgid} eq 'new') || (!$status{$msgid})) { if ($what eq 'Error') { $error{$url}.=','.$msgid; } else { $feedback{$url}.=','.$msgid; } } } } # ----------------------------------------------------------- Start Page Output my $bodytagadd=''; $r->print( 'Navigate Course Map'); if (($currenturl=~/^\/res/) && ($currenturl!~/^\/res\/adm/)) { $bodytagadd='onLoad="window.location.hash='."'curloc'".'"'; } $r->print(&Apache::loncommon::bodytag('Navigate Course Map','', $bodytagadd)); $r->print(''); my $desc=$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; if (defined($desc)) { $r->print("

$desc

\n"); } $r->print("

$date

\n"); $r->rflush(); $r->print(' New discussion since '. localtime($lastcheck). '
New message (click to open)

'); 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('


'); for ($i=0;$i<=$#rows;$i++) { if ($rows[$i]) { $r->print("\n"); my @colcont=split(/\&/,$rows[$i]); my $avespan=$lcm/($#colcont+1); # for each item I wish to print on this row... for ($j=0;$j<=$#colcont;$j++) { my $indent;my $indentstr; my $linkid; my $rid=$colcont[$j]; # bug? $rid can't accept a list of two elements $rid=~/(\d+)\.(\d+)$/; my $src= &Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2}); my $symb= &Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.$src; my $add=''; my $hwk=''; my $hwke=''; if ($rid=~/^l(\d+\.\d+),(.+)/) { $linkid=$1; $rid=$2; } if ($rid=~/^i(\d+),(.+)/) { $indent=$1; $rid=$2; } if ($rid=~/^h(.+)/) { $rid=$1; $add=''; if (($ENV{'user.adv'}) && ($parmhash{$symb.'.0.parameter_randompick'})) { $adde=' (randomly select '. $parmhash{$symb.'.0.parameter_randompick'}. ')'; } } if ($rid=~/^j(.+)/) { $rid=$1; } if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) { # sub astatus describes what code/tcode mean my $code=$1; 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' || $code eq '4') { $hwk=''; $hwke=' ('.$ctext.')'; } if ($code eq '3') { $hwk=''; $hwke=' ('.$ctext.')'; } } if ($rid && $hash{'src_'.$rid} eq $currenturl) { $add=$add.''. '> '; $adde= ' <'.$adde; } if ($discussiontimes{$symb}>$lastcheck) { $adde= ''. $adde; } if ($error{$src}) { foreach (split(/\,/,$error{$src})) { if ($_) { $adde= ' ' .$adde; } } } if ($feedback{$src}) { foreach (split(/\,/,$feedback{$src})) { if ($_) { $adde= ' ' .$adde; } } } if ($indent) { my $is="  "; for(my $i=-1;$i<$indent;$i++) { $indentstr.=$is; } } if (!$linkid) { $linkid=$rid; } if ($hash{'randomout_'.$rid}) { $adde=' (hidden)'.$adde; } $r->print($add.$indentstr); if ($rid) { $r->print(''. $hwk.$hash{'title_'.$rid}.$hwke.''); } $r->print($adde); } $r->print(''); } } $r->print("\n
'; my $adde=''; $adde=''; } if ($code eq '3') { $add=''; } elsif ($code eq '4') { $add=''; } else { $add=''; if ($tcode eq '2') { $add=''; } if ($tcode eq '4') { $add=''; $adde='
"); $r->print(''); # -------------------------------------------------------------------- End page } # ------------------------------------------------------------- End render page } # ------------------------------------------------------------------ Untie hash unless (untie(%hash)) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn (browse)."); } unless (untie(%parmhash)) { &Apache::lonnet::logthis("WARNING: ". "Could not untie parmhash (browse)."); } return OK; } 1; __END__