Diff for /rat/lonpage.pm between versions 1.3 and 1.14

version 1.3, 2000/09/14 09:26:37 version 1.14, 2000/10/19 10:09:59
Line 4 Line 4
 # (TeX Content Handler  # (TeX Content Handler
 #  #
 # 05/29/00,05/30 Gerd Kortemeyer)  # 05/29/00,05/30 Gerd Kortemeyer)
 # 08/30,08/31,09/06,09/14 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 Gerd Kortemeyer
   
 package Apache::lonpage;  package Apache::lonpage;
   
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet();  use Apache::lonnet();
   use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
 # -------------------------------------------------------------- Module Globals  # -------------------------------------------------------------- Module Globals
 my %hash;  my %hash;
 my @rows;  my @rows;
   
   # ------------------------------------------------------------------ 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;
   }
   
 # ------------------------------------------------------------ Build page table  # ------------------------------------------------------------ Build page table
   
 sub tracetable {  sub tracetable {
Line 28  sub tracetable { Line 43  sub tracetable {
        if (defined($hash{'is_map_'.$rid})) {         if (defined($hash{'is_map_'.$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}}))) {
                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}},
                 '&'.$frid.'&');                  '&'.$frid.'&');
                $sofar++;                $sofar++;
                 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')) {
                  if (defined($rows[$sofar])) {                   if (defined($rows[$sofar])) {
Line 41  sub tracetable { Line 57  sub tracetable {
                    $rows[$sofar]=$frid;                     $rows[$sofar]=$frid;
                  }                   }
        }         }
         }
    }     }
        } else {         } else {
            $sofar++;            $sofar++;
             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')) {
              if (defined($rows[$sofar])) {               if (defined($rows[$sofar])) {
Line 52  sub tracetable { Line 70  sub tracetable {
                $rows[$sofar]=$rid;                 $rows[$sofar]=$rid;
              }               }
    }     }
             }
        }         }
   
        if (defined($hash{'to_'.$rid})) {         if (defined($hash{'to_'.$rid})) {
     my $mincond=1;
             my $next='';
           map {            map {
               my $now=&tracetable($sofar,$hash{'goesto_'.$_},$beenhere);                my $thiscond=
               if ($now>$further) { $further=$now; }        &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});            } 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;      return $further;
 }  }
   
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
Line 87  sub handler { Line 123  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_WRCREAT,0640)) {            if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
 # ------------------------------------------------------------------- Hash tied  # ------------------------------------------------------------------- Hash tied
               my $firstres=$hash{'map_start_'.$requrl};                my $firstres=$hash{'map_start_'.$requrl};
               my $lastres=$hash{'map_finish_'.$requrl};                my $lastres=$hash{'map_finish_'.$requrl};
Line 97  sub handler { Line 133  sub handler {
                   @rows=();                    @rows=();
   
                   &tracetable(0,$firstres,'&'.$lastres.'&');                    &tracetable(0,$firstres,'&'.$lastres.'&');
                   $rows[$#rows+1]=''.$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;
        }
     }
   
   # ------------------------------------------------------------ Add to symb list
   
                   my $i;                    my $i;
                   my $maxcols=-1;                    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
   
                     my $j;
                     my $lcm=1;
                     my $contents=0;
                     my $nforms=0;
                     
                   my %ssibody=();                    my %ssibody=();
                   my %ssibgcolor=();                    my %ssibgcolor=();
                   my %ssitext=();                    my %ssitext=();
                   my %ssilink=();                    my %ssilink=();
                   my %ssivlink=();                    my %ssivlink=();
                   my %ssialink=();                    my %ssialink=();
        
                     my %metalink=();
   
                   my %cellemb=();                    my %cellemb=();
   
                     my $allscript='';
                     my $allmeta='';
   
                     my $isxml=0;
                     my $xmlheader='';
                     my $xmlbody='';
   
 # --------------------------------------------- Get SSI output, post parameters  # --------------------------------------------- Get SSI output, post parameters
   
                   for ($i=0;$i<=$#rows;$i++) {                    for ($i=0;$i<=$#rows;$i++) {
        if ($rows[$i]) {
         $contents++;
                       my @colcont=split(/\&/,$rows[$i]);                        my @colcont=split(/\&/,$rows[$i]);
                       $maxcols=$#colcont>$maxcols?$#colcont:$maxcols;                        $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
                       map {                        map {
                           my $src=$hash{'src_'.$_};                            my $src=$hash{'src_'.$_};
                           $src=~/\.\w+$/;                            $src=~/\.(\w+)$/;
                             $metalink{$_}=$src.'.meta';
                           $cellemb{$_}=Apache::lonnet::fileembstyle($1);                            $cellemb{$_}=Apache::lonnet::fileembstyle($1);
                           if ($cellemb{$_} eq 'ssi') {                            if ($cellemb{$_} eq 'ssi') {
 # --------------------------------------------------------- This is an SSI cell  # --------------------------------------------------------- This is an SSI cell
         my $prefix=$_.'_';
                                 my %posthash=('request.prefix' => $prefix);
                                 if (($ENV{'form.'.$prefix.'submit'}) 
                                  || ($ENV{'form.all_submit'})) {
                                  map {
     if ($_=~/^form.$prefix/) {
         my $name=$_;
                                         $name=~s/^form.$prefix//;
                                         $posthash{$name}=$ENV{$_};
                                     }
                                  } keys %ENV;
         }
                                 my $output=Apache::lonnet::ssi($src,%posthash);
                                 my $parser=HTML::TokeParser->new(\$output);
                                 my $token;
                                 my $thisdir=$src;
                                 my $bodydef=0;
                                 my $thisxml=0;
                                 my @rlinks=();
                                 if ($output=~/\?xml/) {
                                    $isxml=1;
                                    $thisxml=1;
                                    $output=~
            /((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\<body[^\>]*\>/si;
                                    $xmlheader=$1;
         }
                                 while ($token=$parser->get_token) {
    if ($token->[0] eq 'S') {
                                     if ($token->[1] eq 'a') {
         if ($token->[2]->{'href'}) {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'href'};
         }
     } elsif ($token->[1] eq 'img') {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'src'};
     } elsif ($token->[1] eq 'embed') {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'src'};
     } elsif ($token->[1] eq 'base') {
         $thisdir=$token->[2]->{'href'};
     } elsif ($token->[1] eq 'body') {
         $bodydef=1;
                                         $ssibgcolor{$_}=$token->[2]->{'bgcolor'};
                                         $ssitext{$_}=$token->[2]->{'text'};
                                         $ssilink{$_}=$token->[2]->{'link'};
                                         $ssivlink{$_}=$token->[2]->{'vlink'};
                                         $ssialink{$_}=$token->[2]->{'alink'};
                                         if ($thisxml) {
     $xmlbody=$token->[4];
                                         }
                                     } elsif ($token->[1] eq 'meta') {
         $allmeta.="\n".$token->[4].'</meta>';
                                     } elsif (($token->[1] eq 'script') &&
                                              ($bodydef==0)) {
         $allscript.="\n\n"
                                                   .$parser->get_text('/script');
                                     }
           }
         }
                                 if ($output=~/\<body[^\>]*\>(.*)/si) {
                                    $output=$1; 
                                 }
                                 $output=~s/\<\/body\>.*//si;
                                 if ($output=~/\<form/si) {
     $nforms++;
                                     $output=~s/\<form[^\>]*\>//gsi;
                                     $output=~s/\<\/form[^\>]*\>//gsi;
                                 }
                                 $thisdir=~s/\/[^\/]*$//;
         map {
     unless (($_=~/^http:\/\//i) ||
                                             ($_=~/^\//)) {
         my $newlocation=
       &Apache::lonnet::hreflocation($thisdir,$_);
                        $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/;
     }
         } @rlinks;
                        $output=~s/\<\s*applet/\<applet codebase=\"$thisdir\" /gi;
         $ssibody{$_}=$output;
 # ---------------------------------------------------------------- End SSI cell  # ---------------------------------------------------------------- End SSI cell
                           }                            }
                       } @colcont;                        } @colcont;
                                              } 
                   }                    }
                   if ($maxcols<0) {                    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 page.</body></html>');                        $r->print('<html><body>Empty page.</body></html>');
                   } else {                    } else {
 # ------------------------------------------------------------------ Build page  # ------------------------------------------------------------------ Build page
   
   # ---------------------------------------------------------------- Send headers
                         if ($isxml) {
     $r->content_type('text/xml');
                             $r->send_http_header;
                             $r->print($xmlheader);
         } else {
                             $r->content_type('text/html');
                             $r->send_http_header;
                             $r->print('<html>');
         }
   # ------------------------------------------------------------------------ Head
                         $r->print("\n<head>\n".$allmeta);
                         if ($allscript) {
     $r->print("\n<script>\n".$allscript."\n</script>\n");
                         }
                         $r->print("\n</head>\n");
   # ------------------------------------------------------------------ Start body
                         if ($isxml) {
                             $r->print($xmlbody);
                         } else {
     $r->print('<body bgcolor="#FFFFFF">');
                         }
   # ------------------------------------------------------------------ Start form
                         if ($nforms) {
     $r->print('<form method="post" action="'.
       $requrl.'">');
                         }
   # ----------------------------------------------------------------- Start table
                         $r->print('<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 $metainfo='<a href="'.
                                       $metalink{$rid}.'" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/cat_button.gif" border=0>'.
     '</img></a><br></br>';
                                 $r->print('<td colspan="'.$avespan.'"');
                                 if ($cellemb{$rid} eq 'ssi') {
     if ($ssibgcolor{$rid}) {
                                        $r->print(' bgcolor="'.
                                                  $ssibgcolor{$rid}.'"');
                                     }
                                     $r->print('>'.$metainfo.'<font');
                                     if ($ssitext{$rid}) {
        $r->print(' text="'.$ssitext{$rid}.'"');
                                     }
                                     if ($ssilink{$rid}) {
        $r->print(' link="'.$ssilink{$rid}.'"');
                                     }
                                     if ($ssitext{$rid}) {
        $r->print(' vlink="'.$ssivlink{$rid}.'"');
                                     }
                                     if ($ssialink{$rid}) {
        $r->print(' alink="'.$ssialink{$rid}.'"');
                                     }
                               
                                     $r->print('>'.$ssibody{$rid}.'</font>');
                                 } elsif ($cellemb{$rid} eq 'img') {
                                     $r->print('>'.$metainfo.'<img src="'.
                                       $hash{'src_'.$rid}.'"></img>');
         } elsif ($cellemb{$rid} eq 'emb') {
                                     $r->print('>'.$metainfo.'<embed src="'.
                                       $hash{'src_'.$rid}.'"></embed>');
                                 }
                                 $r->print('</td>');
                             }
                             $r->print('</tr>');
           }
                         }
                         $r->print("\n</table>");
   # ---------------------------------------------------------------- Submit, etc.
                         if ($nforms) {
                             $r->print(
                     '<input name="all_submit" value="Submit All" type="'.
     (($nforms>1)?'submit':'hidden').'"></input></form>');
                         }
                         $r->print('</body></html>');
 # -------------------------------------------------------------------- End page  # -------------------------------------------------------------------- End page
                   }                                      }                  
 # ------------------------------------------------------------- End render page  # ------------------------------------------------------------- End render page
Line 152  sub handler { Line 386  sub handler {
           }            }
       }         } 
   }    }
   $ENV{'user.error.msg'}="$requrl:bre:1:1: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.3  
changed lines
  Added in v.1.14


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.