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

Diff for /loncom/interface/lonnavmaps.pm between versions 1.2 and 1.17

version 1.2, 2001/01/06 13:45:37 version 1.17, 2001/09/25 18:24:37
Line 9 Line 9
 # 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
   
 package Apache::lonnavmaps;  package Apache::lonnavmaps;
   
Line 23  use GDBM_File; Line 23  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 53  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;
   
   # ---------------------------------------------------------- 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  # ------------------------------------------------------------ Build page table
   
 sub tracetable {  sub tracetable {
Line 45  sub tracetable { Line 236  sub tracetable {
        $beenhere.=$rid.'&';           $beenhere.=$rid.'&';  
   
        if (defined($hash{'is_map_'.$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}})) &&             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}};                my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
       $sofar=        $sofar=
                 &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},                  &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
Line 55  sub tracetable { Line 258  sub tracetable {
               if ($hash{'src_'.$frid}) {                if ($hash{'src_'.$frid}) {
                my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});                 my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});
                if (($brepriv eq '2') || ($brepriv eq 'F')) {                 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])) {                   if (defined($rows[$sofar])) {
                    $rows[$sofar].='&'.$frid;                     $rows[$sofar].='&'.$pprefix.$frid;
                  } else {                   } else {
                    $rows[$sofar]=$frid;                     $rows[$sofar]=$pprefix.$frid;
                  }                   }
        }         }
       }        }
Line 68  sub tracetable { Line 277  sub tracetable {
           if ($hash{'src_'.$rid}) {            if ($hash{'src_'.$rid}) {
            my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});             my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});
            if (($brepriv eq '2') || ($brepriv eq 'F')) {             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])) {               if (defined($rows[$sofar])) {
                $rows[$sofar].='&'.$rid;                  $rows[$sofar].='&'.$pprefix.$rid;
              } else {               } else {
                $rows[$sofar]=$rid;                 $rows[$sofar]=$pprefix.$rid;
              }               }
    }     }
           }            }
Line 128  sub handler { Line 342  sub handler {
   if ($ENV{'request.course.fn'}) {    if ($ENV{'request.course.fn'}) {
       my $fn=$ENV{'request.course.fn'};        my $fn=$ENV{'request.course.fn'};
       if (-e "$fn.db") {        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  # ------------------------------------------------------------------- Hash tied
               my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};                my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
               my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};                my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
               if (($firstres) && ($lastres)) {                if (($firstres) && ($lastres)) {
 # ----------------------------------------------------------------- Render page  # ----------------------------------------------------------------- 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=();                    @rows=();
   
Line 146  sub handler { Line 410  sub handler {
      }       }
   }    }
   
 # ------------------------------------------------------------ Add to symb list  
   
                   my $i;  
                   my %symbhash=();  
                   for ($i=0;$i<=$#rows;$i++) {  
      if ($rows[$i]) {  
                         my @colcont=split(/\&/,$rows[$i]);  
                         map {  
                            $symbhash{$hash{'src_'.$_}}='';  
         } @colcont;  
      }  
   }  
                   &Apache::lonnet::symblist($requrl,%symbhash);  
   
 # ------------------------------------------------------------------ Page parms  # ------------------------------------------------------------------ Page parms
   
                   my $j;                    my $j;
                     my $i;
                   my $lcm=1;                    my $lcm=1;
                   my $contents=0;                    my $contents=0;
   
Line 176  sub handler { Line 427  sub handler {
                      }                        } 
                   }                    }
   
   
                   unless ($contents) {                    unless ($contents) {
                       $r->content_type('text/html');                        $r->content_type('text/html');
                       $r->send_http_header;                        $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');                            $r->content_type('text/html');
Line 190  sub handler { Line 447  sub handler {
                           $r->print(                            $r->print(
                    '<html><head><title>Navigate LON-CAPA Maps</title></head>');                     '<html><head><title>Navigate LON-CAPA Maps</title></head>');
   
   $r->print('<body bgcolor="#FFFFFF">'.    $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>');                                      '<h1>Navigate Course Map</h1>');
         $r->rflush();
                         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>");
Line 202  sub handler { Line 485  sub handler {
                           my $avespan=$lcm/($#colcont+1);                            my $avespan=$lcm/($#colcont+1);
                           for ($j=0;$j<=$#colcont;$j++) {                            for ($j=0;$j<=$#colcont;$j++) {
                               my $rid=$colcont[$j];                                my $rid=$colcont[$j];
                               $r->print('<td><a href="'.                                my $add='<td>&nbsp;&nbsp;';
                                 $hash{'src_'.$rid}.'">'.                                my $adde='</td>';
                                 $hash{'title_'.$rid}.'</a>');                                my $hwk='<font color="#223322">';
                               $r->print('</td>');                                my $hwke='</font>';
                                 if ($rid=~/^h(.+)/) {
     $rid=$1;
                                     $add=
                                      '<th bgcolor="#AAFF55"><a name="'.$rid.'">';
                                     $adde='</th>';
                                 }
                               if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) {
                                     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"><blink>';
                                            $adde='</blink></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><b>-&gt; </b></font>';
                                     $adde=
                                   '<font color=red><b> &lt;-</b></font>'.$adde;
                                 }
                                 $r->print($add.'<a href="'.$hash{'src_'.$rid}.
                                   '">'.$hwk.
                                   $hash{'title_'.$rid}.$hwke.'</a>'.$adde);
                           }                            }
                           $r->print('</tr>');                            $r->print('</tr>');
         }          }
                       }                        }
                       $r->print("\n</table>");                        $r->print("\n</table>");
   
                       $r->print('</body></html>');                        $r->print('</body></html>');
 # -------------------------------------------------------------------- End page  # -------------------------------------------------------------------- End page
                   }                                      }                  
Line 226  sub handler { Line 557  sub handler {
                    &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>"); 
               }                }
                 unless (untie(%parmhash)) {
                      &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                          "Could not untie parmhash (browse).</font>"); 
                 }
 # -------------------------------------------------------------------- All done  # -------------------------------------------------------------------- All done
       return OK;        return OK;
 # ----------------------------------------------- Errors, hash could no be tied  # ----------------------------------------------- Errors, hash could no be tied
           }            }
       }         } 
   }    }
   
   $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";    $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
   return HTTP_NOT_ACCEPTABLE;     return HTTP_NOT_ACCEPTABLE; 
 }  }
Removed from v.1.2  
changed lines
  Added in v.1.17

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.