--- rat/lonpageflip.pm 2000/10/05 22:14:11 1.2 +++ rat/lonpageflip.pm 2000/10/09 19:37:35 1.4 @@ -10,82 +10,31 @@ # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23, # 10/02 Gerd Kortemeyer) # -# 10/03,10/05 Gerd Kortemeyer +# 10/03,10/05,10/06,10/07,10/09 Gerd Kortemeyer package Apache::lonpageflip; use strict; -use Apache::Constants qw(:common :http); +use Apache::Constants qw(:common :http REDIRECT); use Apache::lonnet(); use HTML::TokeParser; use GDBM_File; -# -------------------------------------------------------------- Module Globals +# ========================================================== Module Global Hash + 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; +sub addrid { + my ($current,$new,$condid)=@_; + unless ($condid) { $condid=0; } + if (&Apache::lonnet::allowed('bre',$hash{'src_'.$new})) { + if ($current) { + $current.=','.$new.':'.$condid; + } else { + $current=''.$new.':'.$condid; + } } - 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; + return $current; } # ================================================================ Main Handler @@ -101,14 +50,10 @@ sub handler { return OK; } - -# --------BEGIN DEBUG ONLY TRASH - $r->content_type('text/html'); - $r->send_http_header; - - $r->print(''); -# --------END DEBUG ONLY TRASH - + my %cachehash=(); + my $redirecturl=''; + my $next=''; + my @possibilities=(); if (($ENV{'form.postdata'})&&($ENV{'request.course.fn'})) { $ENV{'form.postdata'}=~/(\w+)\:(.*)/; @@ -117,36 +62,57 @@ sub handler { my $redirecturl=$currenturl; $currenturl=~s/^http\:\/\///; $currenturl=~s/^[^\/]+//; - $currenturl=Apache::lonnet::declutter($currenturl); -# ---------------------------------------------------------------- Tie database - if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', - &GDBM_READER,0640)) { -# ---------------------------------------------- Get ID(s) for current resource - my $syval=$hash{'ids_/res/'.$currenturl}; - if ($syval) { -# ------------------------------------------------------------------- Has ID(s) - my @possiblities=split(/\,/,$syval); - $r->print($direction.' '.$currenturl.' '.$syval); - - } else { -# --------------------------------------------------------- Does not have ID(s) - $r->print('Weird'); - } -# ------------------------------------- Program needs to get here to untie hash - unless(untie(%hash)) { - $r->log_reason('Could not untie database hash '. - $ENV{'request.course.fn'}.' for '.$ENV{'user.name'}. - ' at '.$ENV{'user.domain'}); - return HTTP_SERVICE_UNAVAILABLE; - } -# ------------------------------------------------------------ Now do something - } else { -# ----------------------------------------- Serious problem, could not tie hash - $r->log_reason('Could not tie database hash '. - $ENV{'request.course.fn'}.' for '.$ENV{'user.name'}. - ' at '.$ENV{'user.domain'}); - return HTTP_SERVICE_UNAVAILABLE; +# ------------------------------------------- Do we have any idea where we are? + my $position; + if ($position=Apache::lonnet::symbread($currenturl)) { +# ------------------------------------------------------------------------- Yes + my ($mapurl,$mapnum,$thisurl)=split(/\_\_\_/,$position); + $cachehash{$thisurl}=$mapnum; + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER,0640)) { + my $rid=$hash{'map_pc_/res/'.$mapurl}.'.'.$mapnum; + my $next=''; + if ($direction eq 'forward') { + map { + $next=&addrid($next,$hash{'goesto_'.$_}, + $hash{'condid_'.$hash{'undercond_'.$_}}); + } split(/\,/,$hash{'to_'.$rid}); + } elsif ($direction eq 'back') { + map { + $next=&addrid($next,$hash{'comesfrom_'.$_}, + $hash{'condid_'.$hash{'undercond_'.$_}}); + } split(/\,/,$hash{'from_'.$rid}); + } elsif ($direction eq 'up') { + } elsif ($direction eq 'down') { + } + my $redirectid=''; +# ----------------------------------------------------- Check out possibilities + if ($next) { + @possibilities=split(/\,/,$next); + if ($#possibilities==0) { + $redirectid=(split(/\:/,$next))[0]; + } else { + } + } + if ($redirectid) { + $redirecturl=$hash{'src_'.$redirectid}; + } + untie(%hash); + if ($redirecturl) { + $r->content_type('text/html'); + $r->header_out(Location => + 'http://'.$ENV{'HTTP_HOST'}.$redirecturl); + return REDIRECT; + } + } } +# -------------------------------------------------------- No, could not decide + } + $r->content_type('text/html'); + $r->send_http_header; + + $r->print(''); + # -------------------------- Class was not initialized or page fliped strangely } else { $ENV{'user.error.msg'}="/adm/flip:bre:0:0:Choose Course"; @@ -165,241 +131,8 @@ sub handler { # ========================================================= TOTAL TRASH - my $requrl=$r->uri; -# ----------------------------------------------------------------- Tie db file - if ($ENV{'request.course.fn'}) { - my $fn=$ENV{'request.course.fn'}; - if (-e "$fn.db") { - 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 - - @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 +# &Apache::lonnet::symblist($requrl,%symbhash); -# ---------------------------------------------------------------- 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->content_type('text/html'); - $r->send_http_header; - $r->print('Page undefined.'); - } -# ------------------------------------------------------------------ Untie hash - unless (untie(%hash)) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn (browse)."); - } -# -------------------------------------------------------------------- All done - return OK; -# ----------------------------------------------- Errors, hash could no be tied - } - } - } - $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; - return HTTP_NOT_ACCEPTABLE; } 1;