--- rat/lonpageflip.pm 2000/10/05 22:14:11 1.2 +++ rat/lonpageflip.pm 2000/11/14 19:14:03 1.12 @@ -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,10/17,11/14 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,224 @@ 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; + if ($direction eq 'return') { +# -------------------------------------------------------- Return to last known + my $last; + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', + &GDBM_READER,0640)) { + $last=$hash{'last_known'}; + untie(%hash); + } + my $newloc; + if ($last) { + $newloc='/res/'.(split(/\_\_\_/,$last))[1]; + } else { + $newloc='/adm/noidea.html'; + } + $r->content_type('text/html'); + $r->header_out(Location => + 'http://'.$ENV{'HTTP_HOST'}.$newloc); + + return REDIRECT; + } $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); + } + 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; } -# ------------------------------------- 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; } -# -------------------------- 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( - '
'); + } 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]; + if ($hash{'param_'.$next}) { + my ($mapid,$resid)=split(/\./,$next); + &Apache::lonnet::appendparms( + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &Apache::lonnet::declutter($redirecturl), + $hash{'param_'.$next}); } - $r->print(''); -# -------------------------------------------------------------------- End page - } -# ------------------------------------------------------------- End render page - } else { + } 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]; + if ($hash{'param_'.$_}) { + my ($mapid,$resid)=split(/\./,$_); + &Apache::lonnet::appendparms( + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &Apache::lonnet::declutter($hash{'src_'.$_}), + $hash{'param_'.$_}); + } + } @possibilities; + } + } else { +# -------------------------------------------------------------- No place to go + $multichoice=-1; + } +# ----------------- 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 $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 + if ($#possibilities>0) { + $r->print(<Choose Next Location + +

LON-CAPA

+There are several possibilities of where to go next. +

+Please click on the the resource you intend to access: +

+ + +ENDSTART + map { + $r->print( + ''); + } @possibilities; + $r->print('
TitleType
'. + $multichoicehash{'title_'.$_}. + ''.$multichoicehash{'type_'.$_}. + '
'); + return OK; + } else { + $r->print(<Choose Next Location + + +

Sorry!

+

Next resource could not be identified.

+ + +ENDNONE + return OK; + } + } + } 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;