version 1.1, 2001/01/03 16:20:59
|
version 1.25, 2002/02/11 18:59:36
|
Line 1
|
Line 1
|
# The LearningOnline Network |
# The LearningOnline Network with CAPA |
# Navigate Maps |
# Navigate Maps Handler |
# |
# |
# (Internal Server Error Handler |
# $Id$ |
# |
# |
# (Login Screen |
# Copyright Michigan State University Board of Trustees |
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, |
|
# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) |
|
# |
# |
# 3/1/1 Gerd Kortemeyer) |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# |
# |
# 3/1 Gerd Kortemeyer |
# 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; |
package Apache::lonnavmaps; |
|
|
use strict; |
use strict; |
use Apache::Constants qw(:common); |
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 |
|
# "excused" needs to be supported, but is not yet. Could be code=4. |
|
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}); |
|
$Apache::lonxml::debug=1; |
|
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') { |
|
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'); |
|
my $numtries = &parmval($_.'.maxtries',$symb); |
|
if ($numtries) { $ctext.='/'.$numtries.' tries'; } |
|
$ctext.=')'; |
|
} elsif ($status eq 'incorrect_by_override') { |
|
$code=2; |
|
$ctext.=' override'; |
|
} elsif ($status eq 'excused') { |
|
unless ($code==2) { $code=3; } |
|
$ctext.=' excused'; |
|
} |
|
} |
|
|
|
return 'p'.$code.$tcode.'"'.$ctext.'"'; |
|
} |
|
|
|
# ------------------------------------------------------------ Build page table |
|
|
|
sub tracetable { |
|
my ($sofar,$rid,$beenhere)=@_; |
|
my $further=$sofar; |
|
unless ($beenhere=~/\&$rid\&/) { |
|
$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}})) && |
|
($tprefix eq 'h')) { |
|
my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; |
|
$sofar= |
|
&tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}}, |
|
'&'.$frid.'&'); |
|
$sofar++; |
|
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].='&'.$pprefix.$frid; |
|
} else { |
|
$rows[$sofar]=$pprefix.$frid; |
|
} |
|
} |
|
} |
|
} |
|
} else { |
|
$sofar++; |
|
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].='&'.$pprefix.$rid; |
|
} else { |
|
$rows[$sofar]=$pprefix.$rid; |
|
} |
|
} |
|
} |
|
} |
|
|
|
if (defined($hash{'to_'.$rid})) { |
|
my $mincond=1; |
|
my $next=''; |
|
map { |
|
my $thiscond= |
|
&Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}}); |
|
if ($thiscond>=$mincond) { |
|
if ($next) { |
|
$next.=','.$_.':'.$thiscond; |
|
} else { |
|
$next=$_.':'.$thiscond; |
|
} |
|
if ($thiscond>$mincond) { $mincond=$thiscond; } |
|
} |
|
} split(/\,/,$hash{'to_'.$rid}); |
|
map { |
|
my ($linkid,$condval)=split(/\:/,$_); |
|
if ($condval>=$mincond) { |
|
my $now=&tracetable($sofar,$hash{'goesto_'.$linkid},$beenhere); |
|
if ($now>$further) { $further=$now; } |
|
} |
|
} split(/\,/,$next); |
|
|
|
} |
|
} |
|
return $further; |
|
} |
|
|
|
# ================================================================ Main Handler |
|
|
sub handler { |
sub handler { |
my $r = shift; |
my $r=shift; |
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
return OK if $r->header_only; |
# ------------------------------------------- Set document type for header only |
|
|
# --------------------------------------------------- Print login screen header |
if ($r->header_only) { |
$r->print(<<ENDDOCUMENT); |
if ($ENV{'browser.mathml'}) { |
<html> |
$r->content_type('text/xml'); |
<head> |
} else { |
<title>The LearningOnline Network with CAPA</title> |
$r->content_type('text/html'); |
</head> |
} |
<body bgcolor="#FFFFFF"> |
$r->send_http_header; |
<h1>Navigate Maps</h1> |
return OK; |
<img src="/adm/lonKaputt/lonconstruct.gif"> |
} |
</body> |
my $requrl=$r->uri; |
</html> |
# ----------------------------------------------------------------- Tie db file |
ENDDOCUMENT |
if ($ENV{'request.course.fn'}) { |
return OK; |
my $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))) { |
|
# ------------------------------------------------------------------- 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=(); |
|
|
|
&tracetable(0,$firstres,'&'.$lastres.'&'); |
|
if ($hash{'src_'.$lastres}) { |
|
my $brepriv= |
|
&Apache::lonnet::allowed('bre',$hash{'src_'.$lastres}); |
|
if (($brepriv eq '2') || ($brepriv eq 'F')) { |
|
$rows[$#rows+1]=''.$lastres; |
|
} |
|
} |
|
|
|
# ------------------------------------------------------------------ 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]) { |
|
$contents++; |
|
my @colcont=split(/\&/,$rows[$i]); |
|
$lcm*=($#colcont+1)/euclid($lcm,($#colcont+1)); |
|
} |
|
} |
|
|
|
|
|
unless ($contents) { |
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
$r->print('<html><body>Empty Map.</body></html>'); |
|
} 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; |
|
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', |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); |
|
|
|
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 |
|
$r->print( |
|
'<html><head><title>Navigate LON-CAPA Maps</title></head>'); |
|
$r->print('<body bgcolor="#FFFFFF"'); |
|
if (($currenturl=~/^\/res/) && |
|
($currenturl!~/^\/res\/adm/)) { |
|
$r->print(' onLoad="window.location.hash='. |
|
"'curloc'".'"'); |
|
} |
|
$r->print('><script>window.focus();</script>'. |
|
'<img align=right src=/adm/lonIcons/lonlogos.gif>'. |
|
'<h1>Navigate Course Map</h1>'. |
|
"<h3>$date</h3>"); |
|
$r->rflush(); |
|
$r->print( |
|
'<img src="/adm/lonMisc/chat.gif"> New discussion since '. |
|
localtime($lastcheck). |
|
'<br><img src="/adm/lonMisc/feedback.gif"> New message (click to open)<p>'); |
|
if (($currenturl=~/^\/res/) && |
|
($currenturl!~/^\/res\/adm/)) { |
|
$r->print('<a href="#curloc">Current Location</a><p>'); |
|
} |
|
# ----------------------------------------------------- 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( |
|
' <a href="#'.$rid.'">'.$hash{'title_'.$rid}.'</a><br>'); |
|
} |
|
} |
|
} |
|
} |
|
# ----------------------------------------------------------------- Start table |
|
$r->print('<hr><table cols="'.$lcm.'" border="0">'); |
|
for ($i=0;$i<=$#rows;$i++) { |
|
if ($rows[$i]) { |
|
$r->print("\n<tr>"); |
|
my @colcont=split(/\&/,$rows[$i]); |
|
my $avespan=$lcm/($#colcont+1); |
|
for ($j=0;$j<=$#colcont;$j++) { |
|
my $rid=$colcont[$j]; |
|
my $add='<td> '; |
|
my $adde='</td>'; |
|
my $hwk='<font color="#223322">'; |
|
my $hwke='</font>'; |
|
if ($rid=~/^h(.+)/) { |
|
$rid=$1; |
|
$add= |
|
'<th bgcolor="#AAFF55"><a name="'.$rid.'">'; |
|
$adde='</th>'; |
|
} |
|
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='<td bgcolor="#AAAAAA">'; |
|
} |
|
if ($code eq '3') { |
|
$add='<td bgcolor="#AAFFAA">'; |
|
} else { |
|
$add='<td bgcolor="#FFAAAA">'; |
|
if ($tcode eq '2') { |
|
$add='<td bgcolor="#FFFFAA">'; |
|
} |
|
if ($tcode eq '4') { |
|
$add='<td bgcolor="#FFFF33">'; |
|
$adde='</td>'; |
|
} |
|
} |
|
$hwk='<font color="#888811"><b>'; |
|
$hwke='</b></font>'; |
|
if ($code eq '1') { |
|
$hwke='</b> ('.$ctext.')</font>'; |
|
} |
|
if ($code eq '2') { |
|
$hwk='<font color="#992222"><b>'; |
|
$hwke='</b> ('.$ctext.')</font>'; |
|
} |
|
if ($code eq '3') { |
|
$hwk='<font color="#229922"><b>'; |
|
$hwke='</b> ('.$ctext.')</font>'; |
|
} |
|
} |
|
if ($hash{'src_'.$rid} eq $currenturl) { |
|
$add=$add.'<a name="curloc"></a>'. |
|
'<font color=red size=+2><b>> </b></font>'; |
|
$adde= |
|
'<font color=red size=+2><b> <</b></font>'.$adde; |
|
} |
|
my $src= |
|
&Apache::lonnet::declutter($hash{'src_'.$rid}); |
|
$rid=~/^(\d+)\.(\d+)$/; |
|
my $symb= |
|
&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.$src; |
|
if ($discussiontimes{$symb}>$lastcheck) { |
|
$adde= |
|
'<img border=0 src="/adm/lonMisc/chat.gif">'. |
|
$adde; |
|
} |
|
if ($error{$src}) { |
|
foreach (split(/\,/,$error{$src})) { |
|
if ($_) { |
|
$adde= |
|
' <a href="/adm/email?display='. |
|
&Apache::lonnet::escape($_). |
|
'"><img src="/adm/lonMisc/bomb.gif" border=0></a>' |
|
.$adde; |
|
} |
|
} |
|
} |
|
if ($feedback{$src}) { |
|
foreach (split(/\,/,$feedback{$src})) { |
|
if ($_) { |
|
$adde= |
|
' <a href="/adm/email?display='. |
|
&Apache::lonnet::escape($_). |
|
'"><img src="/adm/lonMisc/feedback.gif" border=0></a>' |
|
.$adde; |
|
} |
|
} |
|
} |
|
$r->print($add.'<a href="'.$hash{'src_'.$rid}. |
|
'">'.$hwk. |
|
$hash{'title_'.$rid}.$hwke.'</a>'.$adde); |
|
} |
|
$r->print('</tr>'); |
|
} |
|
} |
|
$r->print("\n</table>"); |
|
$r->print('</body></html>'); |
|
# -------------------------------------------------------------------- End page |
|
} |
|
# ------------------------------------------------------------- End render page |
|
} else { |
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
$r->print('<html><body>Coursemap undefined.</body></html>'); |
|
} |
|
# ------------------------------------------------------------------ Untie hash |
|
unless (untie(%hash)) { |
|
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not untie coursemap $fn (browse).</font>"); |
|
} |
|
unless (untie(%parmhash)) { |
|
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not untie parmhash (browse).</font>"); |
|
} |
|
# -------------------------------------------------------------------- All done |
|
return OK; |
|
# ----------------------------------------------- Errors, hash could no be tied |
|
} |
|
} |
|
} |
|
|
|
$ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; |
|
return HTTP_NOT_ACCEPTABLE; |
|
} |
|
|
1; |
1; |
__END__ |
__END__ |
|
|
|
|
|
|
|
|
|
|
|
|
|
|