[BACK]Return to lonnavmaps.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonnavmaps.pm between versions 1.4 and 1.46

version 1.4, 2001/01/06 20:08:10 version 1.46, 2002/09/02 19:35:31
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Navigate Maps Handler  # Navigate Maps Handler
 #  #
   # $Id$
   #
   # 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  # (Page Handler
 #  #
 # (TeX Content Handler  # (TeX Content Handler
Line 9 Line 33
 # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,  # 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)  # 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
   # YEAR=2002
   # 1/1 Gerd Kortemeyer
   #
   
 package Apache::lonnavmaps;  package Apache::lonnavmaps;
   
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet();  use Apache::lonnet();
   use Apache::loncommon();
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
Line 23  use GDBM_File; Line 51  use GDBM_File;
 my %hash;  my %hash;
 my @rows;  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  # ------------------------------------------------------------------ Euclid gcd
   
 sub euclid {  sub euclid {
Line 36  sub euclid { Line 80  sub euclid {
     return $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  # ------------------------------------------------------------ Build page table
   
 sub tracetable {  sub tracetable {
     my ($sofar,$rid,$beenhere)=@_;      my ($sofar,$rid,$beenhere,$showtypes,$indent,$linkid)=@_;
       my $newshowtypes=$showtypes;
     my $further=$sofar;      my $further=$sofar;
     unless ($beenhere=~/\&$rid\&/) {  # $Apache::lonxml::debug=1;
        $beenhere.=$rid.'&';        &Apache::lonxml::debug("$rid ; $linkid ; $sofar ; $beenhere ; ".$hash{'src_'.$rid});
       if ($beenhere=~/\&$rid\&/) { return $further; }
        if (defined($hash{'is_map_'.$rid})) {      $beenhere.=$rid.'&';
            if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&  
                (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {      if (defined($hash{'is_map_'.$rid})) {
               my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};   $sofar++;
       $sofar=   my $tprefix='';
                 &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},   if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
                 '&'.$frid.'&');      eq 'sequence') {
               $sofar++;      $tprefix='h';
               if ($hash{'src_'.$frid}) {   } elsif ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
                my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});   eq 'page') {
                if (($brepriv eq '2') || ($brepriv eq 'F')) {      $tprefix='j';
                  if (defined($rows[$sofar])) {      if ($indent) { $tprefix='i'.$indent.','.$tprefix; }
                    $rows[$sofar].='&'.$frid;      if ($linkid) { $tprefix='l'.$linkid.','.$tprefix; }
                  } else {      $newshowtypes='problems';
                    $rows[$sofar]=$frid;      $indent++;
                  }      #if in a .page continue to link the encompising .page
        }      if (!$linkid) { $linkid=$rid; }
       }   }
    }   if (defined($rows[$sofar])) {
        } else {      $rows[$sofar].='&'.$tprefix.$rid;
           $sofar++;   } else {
           if ($hash{'src_'.$rid}) {      $rows[$sofar]=$tprefix.$rid;
            my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});   }
            if (($brepriv eq '2') || ($brepriv eq 'F')) {   if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
              if (defined($rows[$sofar])) {      (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
                $rows[$sofar].='&'.$rid;      my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
              } else {      $sofar=&tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
                $rows[$sofar]=$rid;         '&'.$frid.'&',$newshowtypes,$indent,$linkid);
              }      &addresource($hash{'src_'.$frid},\$sofar,$frid,$newshowtypes,
    }   $indent,$linkid);
           }      if ($tprefix =~ /j$/) { $indent--; $linkid=''; }
        }   }
       } else {
        if (defined($hash{'to_'.$rid})) {   &addresource($hash{'src_'.$rid},\$sofar,$rid,$showtypes,
   my $mincond=1;       $indent,$linkid);
           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);  
   
        }      if (defined($hash{'to_'.$rid})) {
    $further=&followlinks($rid,$sofar,$beenhere,$further,$showtypes,
         $indent,$linkid);
     }      }
   
     return $further;      return $further;
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
   my $r=shift;      my $r=shift;
   
   
 # ------------------------------------------- Set document type for header only  # ------------------------------------------- Set document type for header only
   
   if ($r->header_only) {      if ($r->header_only) {
        if ($ENV{'browser.mathml'}) {   if ($ENV{'browser.mathml'}) {
            $r->content_type('text/xml');      $r->content_type('text/xml');
        } else {   } else {
            $r->content_type('text/html');      $r->content_type('text/html');
        }   }
        $r->send_http_header;   $r->send_http_header;
        return OK;   return OK;
    }      }
       my $requrl=$r->uri;
   my $requrl=$r->uri;      my $hashtied;
 # ----------------------------------------------------------------- Tie db file  # ----------------------------------------------------------------- Tie db file
   if ($ENV{'request.course.fn'}) {      my $fn;
       my $fn=$ENV{'request.course.fn'};      if ($ENV{'request.course.fn'}) {
       if (-e "$fn.db") {   $fn=$ENV{'request.course.fn'};
           if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {   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  # ------------------------------------------------------------------- Hash tied
               my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};  
               my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};      if ($ENV{'browser.mathml'}) {
               if (($firstres) && ($lastres)) {   $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('<html><body>Coursemap undefined.</body></html>');
       } else {
   
 # ----------------------------------------------------------------- Render page  # ----------------------------------------------------------------- Render page
   # -------------------------------------------------------------- Set parameters
   
   
                   @rows=();  # ---------------------------- 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);
       }
    }
   
                   &tracetable(0,$firstres,'&'.$lastres.'&');   @rows=();
                   if ($hash{'src_'.$lastres}) {  
                      my $brepriv=   &tracetable(0,$firstres,'&','',0);
                         &Apache::lonnet::allowed('bre',$hash{'src_'.$lastres});  
                      if (($brepriv eq '2') || ($brepriv eq 'F')) {  
                         $rows[$#rows+1]=''.$lastres;  
      }  
   }  
   
 # ------------------------------------------------------------------ Page parms  # ------------------------------------------------------------------ Page parms
   
                   my $j;   my $j;
                   my $lcm=1;   my $i;
                   my $contents=0;   my $lcm=1;
    my $contents=0;
   
 # ---------------------------------------------- Go through table to get layout  # ---------------------------------------------- Go through table to get layout
   
                   for ($i=0;$i<=$#rows;$i++) {   for ($i=0;$i<=$#rows;$i++) {
      if ($rows[$i]) {      if ($rows[$i]) {
       $contents++;   &Apache::lonxml::debug("Row $i is:".$rows[$i]);
                       my @colcont=split(/\&/,$rows[$i]);   $contents++;
                       $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));   my @colcont=split(/\&/,$rows[$i]);
                      }    $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
                   }      } 
               }   }
   
                   unless ($contents) {  
                       $r->content_type('text/html');   unless ($contents) {
                       $r->send_http_header;      $r->print('<html><body>Empty Map.</body></html>');
                       $r->print('<html><body>Empty Map.</body></html>');   } else {
                   } else {  
 # ------------------------------------------------------------------ Build page  # ------------------------------------------------------------------ Build page
   
       my $currenturl=$ENV{'form.postdata'};
       $currenturl=~s/^http\:\/\///;
       $currenturl=~s/^[^\/]+//;
   
 # ---------------------------------------------------------------- Send headers  # ---------------------------------------------------------------- Send headers
   
                           $r->content_type('text/html');      my $date=localtime;
                           $r->send_http_header;      my $now=time;
                           $r->print(  # ----------------------------------------- Get email status and discussiontime
                    '<html><head><title>Navigate LON-CAPA Maps</title></head>');  
       my %emailstatus=&Apache::lonnet::dump('email_status');
   $r->print('<body bgcolor="#FFFFFF">'.      my $logouttime=$emailstatus{'logout'};
                                     '<h1>Navigate Course Map</h1>');      my $courseleave=$emailstatus{'logout_'.$ENV{'request.course.id'}};
                           $r->rflush();      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(
                      '<html><head><title>Navigate Course Map</title></head>');
       if (($currenturl=~/^\/res/) &&
    ($currenturl!~/^\/res\/adm/)) {
    $bodytagadd='onLoad="window.location.hash='."'curloc'".'"';
       }
       $r->print(&Apache::loncommon::bodytag('Navigate Course Map','',
                                                     $bodytagadd));
       $r->print('<script>window.focus();</script>');
       my $desc=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
       if (defined($desc)) { $r->print("<h2>$desc</h2>\n"); }
       $r->print("<h3>$date</h3>\n");
       $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('&nbsp;&nbsp;&nbsp;<a href="#'.
         $rid.'">'.$hash{'title_'.$rid}.
         '</a><br>');
    }
       }
    }
       }
 # ----------------------------------------------------------------- Start table  # ----------------------------------------------------------------- Start table
                       $r->print('<table cols="'.$lcm.'" border="0">');      $r->print('<hr><table cols="'.$lcm.'" border="0">');
                       for ($i=0;$i<=$#rows;$i++) {      for ($i=0;$i<=$#rows;$i++) {
  if ($rows[$i]) {   if ($rows[$i]) {
                           $r->print("\n<tr>");      $r->print("\n<tr>");
                           my @colcont=split(/\&/,$rows[$i]);      my @colcont=split(/\&/,$rows[$i]);
                           my $avespan=$lcm/($#colcont+1);      my $avespan=$lcm/($#colcont+1);
                           for ($j=0;$j<=$#colcont;$j++) {  
                               my $rid=$colcont[$j];      # for each item I wish to print on this row...
                               $r->print('<td><a href="'.      for ($j=0;$j<=$#colcont;$j++) {
                                 $hash{'src_'.$rid}.'">'.   my $indent;my $indentstr;
                                 $hash{'title_'.$rid}.'</a>');   my $linkid;
                               $r->print('</td>');   my $rid=$colcont[$j];
                           }                          $rid=~/(\d+)\.(\d+)$/;
                           $r->print('</tr>');   my $src=
         }     &Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
                       }   my $symb=
                       $r->print("\n</table>");    &Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.$src;
    my $add='<td>';
                       $r->print('</body></html>');   my $adde='</td>';
    my $hwk='<font color="#223322">';
    my $hwke='</font>';
    if ($rid=~/^l(\d+\.\d+),(.+)/) { $linkid=$1; $rid=$2; }
    if ($rid=~/^i(\d+),(.+)/) { $indent=$1; $rid=$2; }
    if ($rid=~/^h(.+)/) {
       $rid=$1;
       $add='<th bgcolor="#AAFF55"><a name="'.$rid.'">';
       $adde='</th>';
                               if (($ENV{'user.adv'}) && 
    ($parmhash{$symb.'.0.parameter_randompick'})) {
                                  $adde=' (randomly select '.
      $parmhash{$symb.'.0.parameter_randompick'}.
                                      ')</th>';
                               }
    }
    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='<td bgcolor="#AAAAAA">';
       }
       if ($code eq '3') {
    $add='<td bgcolor="#AAFFAA">';
       } elsif ($code eq '4') {
    $add='<td bgcolor="#E0FFAA">';
       } else {
    $add='<td bgcolor="#CCCCFF">';
    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' || $code eq '4') {
    $hwk='<font color="#992222"><b>';
    $hwke='</b> ('.$ctext.')</font>';
       }
       if ($code eq '3') {
    $hwk='<font color="#229922"><b>';
    $hwke='</b> ('.$ctext.')</font>';
       }
    }
    if ($rid && $hash{'src_'.$rid} eq $currenturl) {
       $add=$add.'<a name="curloc"></a>'.
    '<font color=red size=+2><b>&gt; </b></font>';
       $adde=
    '<font color=red size=+2><b> &lt;</b></font>'.$adde;
    }
    if ($discussiontimes{$symb}>$lastcheck) {
       $adde=
    '<img border=0 src="/adm/lonMisc/chat.gif">'.
       $adde;
    }
    if ($error{$src}) {
       foreach (split(/\,/,$error{$src})) {
    if ($_) {
       $adde=
    '&nbsp;<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=
    '&nbsp;<a href="/adm/email?display='.
       &Apache::lonnet::escape($_).
    '"><img src="/adm/lonMisc/feedback.gif" border=0></a>'
       .$adde;
    }
       }
    }
    if ($indent) {
       my $is="&nbsp;&nbsp;";
       for(my $i=-1;$i<$indent;$i++) { $indentstr.=$is; }
    }
    if (!$linkid) { $linkid=$rid; }
                           if ($hash{'randomout_'.$rid}) {
                               $adde=' <i>(hidden)</i>'.$adde;
                           }
    $r->print($add.$indentstr);
    if ($rid) {
       $r->print('<a href="'.$hash{'src_'.$linkid}.
                                         (($hash{'src_'.$linkid}=~/\?/)?'&':'?').
                                         'symb='.&Apache::lonnet::escape($symb)
                                          .'">'.
         $hwk.$hash{'title_'.$rid}.$hwke.'</a>');
    }
    $r->print($adde);
       }
       $r->print('</tr>');
    }
       }
       $r->print("\n</table>");
       $r->print('</body></html>');
 # -------------------------------------------------------------------- End page  # -------------------------------------------------------------------- End page
                   }                     }                  
 # ------------------------------------------------------------- End render page  # ------------------------------------------------------------- End render page
               } else {      }
                   $r->content_type('text/html');  
                   $r->send_http_header;  
   $r->print('<html><body>Coursemap undefined.</body></html>');  
               }  
 # ------------------------------------------------------------------ Untie hash  # ------------------------------------------------------------------ Untie hash
               unless (untie(%hash)) {      unless (untie(%hash)) {
                    &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                        "Could not untie coursemap $fn (browse).</font>");    "Could not untie coursemap $fn (browse).</font>"); 
               }      }
 # -------------------------------------------------------------------- All done      unless (untie(%parmhash)) {
       return OK;   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
 # ----------------------------------------------- Errors, hash could no be tied   "Could not untie parmhash (browse).</font>"); 
           }      }
       }       return OK;
   }  
   
   $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";  
   return HTTP_NOT_ACCEPTABLE;   
 }  }
   
 1;  1;
Removed from v.1.4  
changed lines
  Added in v.1.46

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.