--- rat/lonpageflip.pm 2000/10/05 22:14:11 1.2 +++ rat/lonpageflip.pm 2000/10/16 20:47:39 1.7 @@ -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,10/10,10/11,10/16 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; - } - 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}); - } +sub addrid { + my ($current,$new,$condid)=@_; + unless ($condid) { $condid=0; } + if (&Apache::lonnet::allowed('bre',$hash{'src_'.$new})) { + if ($current) { + $current.=','.$new; + } else { + $current=''.$new; + } } - return $further; + return $current; } # ================================================================ Main Handler @@ -101,305 +50,152 @@ 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 $multichoice=0; + my %multichoicehash=(); + my $redirecturl=''; + my $next=''; + my @possibilities=(); if (($ENV{'form.postdata'})&&($ENV{'request.course.fn'})) { $ENV{'form.postdata'}=~/(\w+)\:(.*)/; my $direction=$1; my $currenturl=$2; - 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'); + unless ($currenturl=~/\/res\//) { + my $last; + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', + &GDBM_READER,0640)) { + $last=$hash{'last_known'}; + untie(%hash); } -# ------------------------------------- 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; + if ($last) { + $currenturl='/res/'.(split(/\_\_\_/,$last))[1]; + } else { + $r->content_type('text/html'); + $r->header_out(Location => + 'http://'.$ENV{'HTTP_HOST'}.'/adm/noidea.html'); + } + return REDIRECT; } -# -------------------------- Class was not initialized or page fliped strangely - } else { - $ENV{'user.error.msg'}="/adm/flip:bre:0:0:Choose Course"; - return HTTP_NOT_ACCEPTABLE; - } - - - - -# ------TRASH BELOW -# --------------------------- TRASH - - $r->print(''); - return OK; - - -# ========================================================= 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 - -# ---------------------------------------------------------------- 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(''); +# ------------------------------------------- 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; +# ============================================================ Tie the big hash + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER,0640)) { + my $rid=$hash{'map_pc_/res/'.$mapurl}.'.'.$mapnum; + my $next=''; + my $mincond=1; + my $posnext=''; + if ($direction eq 'forward') { +# --------------------------------------------------------------------- Forward + map { + my $thiscond= + &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}}); + if ($thiscond>=$mincond) { + if ($posnext) { + $posnext.=','.$_.':'.$thiscond; + } else { + $posnext=$_.':'.$thiscond; + } + if ($thiscond>$mincond) { $mincond=$thiscond; } + } + } split(/\,/,$hash{'to_'.$rid}); + map { + my ($linkid,$condval)=split(/\:/,$_); + if ($condval>=$mincond) { + $next=&addrid($next,$hash{'goesto_'.$linkid}, + $hash{'condid_'.$hash{'undercond_'.$linkid}}); } -# ----------------------------------------------------------------- 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(''); - } + } split(/\,/,$posnext); + } elsif ($direction eq 'back') { +# ------------------------------------------------------------------- Backwards + map { + my $thiscond= + &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}}); + if ($thiscond>=$mincond) { + if ($posnext) { + $posnext.=','.$_.':'.$thiscond; + } else { + $posnext=$_.':'.$thiscond; + } + if ($thiscond>$mincond) { $mincond=$thiscond; } + } + } split(/\,/,$hash{'from_'.$rid}); + map { + my ($linkid,$condval)=split(/\:/,$_); + if ($condval>=$mincond) { + $next=&addrid($next,$hash{'comesfrom_'.$linkid}, + $hash{'condid_'.$hash{'undercond_'.$linkid}}); } - $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.'); + } split(/\,/,$posnext); + } elsif ($direction eq 'up') { +# -------------------------------------------------------------------------- Up + } elsif ($direction eq 'down') { +# ------------------------------------------------------------------------ Down + } +# ----------------------------------------------------- Check out possibilities + if ($next) { + @possibilities=split(/\,/,$next); + if ($#possibilities==0) { +# ---------------------------------------------- Only one possibility, redirect + $redirecturl=$hash{'src_'.$next}; + $cachehash{&Apache::lonnet::declutter($redirecturl)} + =(split(/\./,$next))[1]; + } else { +# ------------------------ There are multiple possibilities for a next resource + $multichoice=1; + map { + $multichoicehash{'src_'.$_}=$hash{'src_'.$_}; + $multichoicehash{'title_'.$_}=$hash{'title_'.$_}; + $multichoicehash{'type_'.$_}=$hash{'type_'.$_}; + $cachehash + {&Apache::lonnet::declutter( + $multichoicehash + {'src_'.$_} + )} + =(split(/\./,$_))[1]; + } @possibilities; + } + } else { +# -------------------------------------------------------------- No place to go + $multichoice=-1; } -# ------------------------------------------------------------------ Untie hash - unless (untie(%hash)) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn (browse)."); +# ----------------- The program must come past this point to untie the big hash + untie(%hash); +# --------------------------------------------------------- Store position info + $cachehash{'last_direction'}=$direction; + $cachehash{'last_known'}=&Apache::lonnet::declutter($currenturl); + &Apache::lonnet::symblist($mapurl,%cachehash); +# ============================================== Do not return before this line + if ($redirecturl) { +# ----------------------------------------------------- There is a URL to go to + $r->content_type('text/html'); + $r->header_out(Location => + 'http://'.$ENV{'HTTP_HOST'}.$redirecturl); + return REDIRECT; + } else { +# --------------------------------------------------------- There was a problem } -# -------------------------------------------------------------------- All done - return OK; -# ----------------------------------------------- Errors, hash could no be tied + } else { +# ------------------------------------------------- Problem, could not tie hash + $ENV{'user.error.msg'}="/adm/flip:bre:0:1:Course Data Missing"; + return HTTP_NOT_ACCEPTABLE; } - } - } - $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; - return HTTP_NOT_ACCEPTABLE; + } else { +# ---------------------------------------- No, could not determine where we are + $r->internal_redirect('/adm/ambiguous'); + } + } else { +# -------------------------- Class was not initialized or page fliped strangely + $ENV{'user.error.msg'}="/adm/flip:bre:0:0:Choose Course"; + return HTTP_NOT_ACCEPTABLE; + } } 1; 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.