[BACK]Return to lonpage.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

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

version 1.3, 2000/09/14 09:26:37 version 1.19, 2000/11/14 15:44:05
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,10/31,11/6,11/14 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;
                                     $output=~
         s/\<((?:input|select|button|textarea)[^\>]+)name\s*\=\s*[\'\"]*([\w\.\:]+)[\'\"]*([^\>]*)\>/\<$1 name="$prefix$2" $3\>/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;
   # ------------------------------------------------------------- Any parameters?
                                 if ($hash{'param_'.$_}) {
     my ($mapid,$resid)=split(/\./,$_);
                                     &Apache::lonnet::appendparms(
    &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
                           '___'.$resid.'___'.&Apache::lonnet::declutter($src),
         $hash{'param_'.$_});
                                 }
   
 # ---------------------------------------------------------------- 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 397  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.19

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>