--- rat/lonpage.pm 2000/08/30 11:10:23 1.1 +++ rat/lonpage.pm 2000/10/02 21:33:40 1.10 @@ -4,49 +4,323 @@ # (TeX Content Handler # # 05/29/00,05/30 Gerd Kortemeyer) -# 08/30 Gerd Kortemeyer +# 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23, +# 10/02 Gerd Kortemeyer package Apache::lonpage; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet(); +use HTML::TokeParser; use GDBM_File; +# -------------------------------------------------------------- Module Globals +my %hash; +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 + +sub tracetable { + my ($sofar,$rid,$beenhere)=@_; + my $further=$sofar; + unless ($beenhere=~/\&$rid\&/) { + $beenhere.=$rid.'&'; + + if (defined($hash{'is_map_'.$rid})) { + if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && + (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { + my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; + $sofar= + &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}}, + '&'.$frid.'&'); + $sofar++; + if ($hash{'src_'.$frid}) { + my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid}); + if (($brepriv eq '2') || ($brepriv eq 'F')) { + if (defined($rows[$sofar])) { + $rows[$sofar].='&'.$frid; + } else { + $rows[$sofar]=$frid; + } + } + } + } + } else { + $sofar++; + if ($hash{'src_'.$rid}) { + my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid}); + if (($brepriv eq '2') || ($brepriv eq 'F')) { + if (defined($rows[$sofar])) { + $rows[$sofar].='&'.$rid; + } else { + $rows[$sofar]=$rid; + } + } + } + } + + if (defined($hash{'to_'.$rid})) { + map { + my $now=&tracetable($sofar,$hash{'goesto_'.$_},$beenhere); + if ($now>$further) { $further=$now; } + } split(/\,/,$hash{'to_'.$rid}); + } + } + return $further; +} + # ================================================================ Main Handler sub handler { my $r=shift; -# ----------------------------------------------------------- Set document type - - if ($ENV{'browser.mathml'}) { - $r->content_type('text/xml'); - } else { - $r->content_type('text/html'); - } - $r->send_http_header; +# ------------------------------------------- Set document type for header only - return OK if $r->header_only; + if ($r->header_only) { + if ($ENV{'browser.mathml'}) { + $r->content_type('text/xml'); + } else { + $r->content_type('text/html'); + } + $r->send_http_header; + return OK; + } my $requrl=$r->uri; # ----------------------------------------------------------------- Tie db file if ($ENV{'request.course.fn'}) { my $fn=$ENV{'request.course.fn'}; if (-e "$fn.db") { - my %hash; - if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { # ------------------------------------------------------------------- Hash tied my $firstres=$hash{'map_start_'.$requrl}; my $lastres=$hash{'map_finish_'.$requrl}; if (($firstres) && ($lastres)) { # ----------------------------------------------------------------- Render page - $r->print("

All is cool.

"); + @rows=(); + &tracetable(0,$firstres,'&'.$lastres.'&'); + if ($hash{'src_'.$lastres}) { + my $brepriv= + &Apache::lonnet::allowed('bre',$hash{'src_'.$lastres}); + if (($brepriv eq '2') || ($brepriv eq 'F')) { + $rows[$#rows+1]=''.$lastres; + } + } + +# ------------------------------------------------------------ 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 + + my $j; + my $lcm=1; + my $contents=0; + my $nforms=0; + + my %ssibody=(); + my %ssibgcolor=(); + my %ssitext=(); + my %ssilink=(); + my %ssivlink=(); + my %ssialink=(); + my %cellemb=(); + + my $allscript=''; + my $allmeta=''; + + my $isxml=0; + my $xmlheader=''; + my $xmlbody=''; + +# --------------------------------------------- Get SSI output, post parameters + + for ($i=0;$i<=$#rows;$i++) { + if ($rows[$i]) { + $contents++; + my @colcont=split(/\&/,$rows[$i]); + $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1)); + map { + my $src=$hash{'src_'.$_}; + $src=~/\.(\w+)$/; + $cellemb{$_}=Apache::lonnet::fileembstyle($1); + if ($cellemb{$_} eq 'ssi') { +# --------------------------------------------------------- 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 $bodydef=0; + my $thisxml=0; + if ($output=~/\?xml/) { + $isxml=1; + $thisxml=1; + $output=~ + /((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\]*\>/si; + $xmlheader=$1; + } + while (($bodydef==0) && + ($token=$parser->get_token)) { + if ($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]; + } + } + if ($token->[1] eq 'meta') { + $allmeta.="\n".$token->[4].''; + } + if ($token->[1] eq 'script') { + $allscript.="\n\n" + .$parser->get_text('/script'); + } + } + if ($output=~/\]*\>(.*)/si) { + $output=$1; + } + $output=~s/\<\/body\>.*//si; + if ($output=~/\
]*\>//gsi; + $output=~s/\<\/form[^\>]*\>//gsi; + } + $ssibody{$_}=$output; + +# ---------------------------------------------------------------- End SSI cell + } + } @colcont; + } + } + unless ($contents) { + $r->content_type('text/html'); + $r->send_http_header; + $r->print('Empty page.'); + } else { +# ------------------------------------------------------------------ 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(''); + } +# ------------------------------------------------------------------------ Head + $r->print("\n\n".$allmeta); + if ($allscript) { + $r->print("\n\n"); + } + $r->print("\n\n"); +# ------------------------------------------------------------------ Start body + if ($isxml) { + $r->print($xmlbody); + } else { + $r->print(''); + } +# ------------------------------------------------------------------ Start form + if ($nforms) { + $r->print(''); + } +# ----------------------------------------------------------------- Start table + $r->print(''); + for ($i=0;$i<=$#rows;$i++) { + if ($rows[$i]) { + $r->print("\n"); + my @colcont=split(/\&/,$rows[$i]); + my $avespan=$lcm/($#colcont+1); + for ($j=0;$j<=$#colcont;$j++) { + my $rid=$colcont[$j]; + $r->print(''); + } + $r->print(''); + } + } + $r->print("\n
print(' bgcolor="'. + $ssibgcolor{$rid}.'"'); + } + $r->print('>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}.''); + } elsif ($cellemb{$rid} eq 'img') { + $r->print('>'); + } + $r->print('
"); +# ---------------------------------------------------------------- Submit, etc. + if ($nforms) { + $r->print( + '
'); + } + $r->print(''); +# -------------------------------------------------------------------- End page + } # ------------------------------------------------------------- End render page } else { - $r->print("

Page undefined.

"); + $r->content_type('text/html'); + $r->send_http_header; + $r->print('Page undefined.'); } # ------------------------------------------------------------------ Untie hash unless (untie(%hash)) { @@ -59,7 +333,7 @@ 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; }