--- rat/lonpageflip.pm 2000/10/05 22:14:11 1.2 +++ rat/lonpageflip.pm 2003/03/08 01:39:29 1.37 @@ -2,6 +2,30 @@ # # Page flip handler # +# $Id: lonpageflip.pm,v 1.37 2003/03/08 01:39:29 www Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # (Page Handler # # (TeX Content Handler @@ -10,82 +34,136 @@ # 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,11/16, +# 10/01/01,05/01,05/28,07/05 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 cleanup { + if (tied(%hash)){ + &Apache::lonnet::logthis('Cleanup pageflip: hash'); + unless (untie(%hash)) { + &Apache::lonnet::logthis('Failed cleanup pageflip: hash'); + } } - return $b; } -# ------------------------------------------------------------ Build page table +sub addrid { + my ($current,$new,$condid)=@_; + unless ($condid) { $condid=0; } + + if ($current) { + $current.=','.$new; + } else { + $current=''.$new; + } -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; - } - } - } - } + return $current; +} - if (defined($hash{'to_'.$rid})) { - map { - my $now=&tracetable($sofar,$hash{'goesto_'.$_},$beenhere); - if ($now>$further) { $further=$now; } - } split(/\,/,$hash{'to_'.$rid}); - } +sub fullmove { + my ($rid,$mapurl,$direction)=@_; + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + ($rid,$mapurl)=&move($rid,$mapurl,$direction); + untie(%hash); } - return $further; + return($rid,$mapurl); +} + +sub move { + my ($rid,$mapurl,$direction)=@_; + my $startoutrid=$rid; + + my $next=''; + + my $mincond=1; + my $posnext=''; + if ($direction eq 'forward') { +# --------------------------------------------------------------------- Forward + while ($hash{'type_'.$rid} eq 'finish') { + $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}}; + } + 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}}); + } + } split(/\,/,$posnext); + if ($hash{'is_map_'.$next}) { +# This jumps to the beginning of a new map (going down level) + if ( + $hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'sequence') { + $mapurl=$hash{'src_'.$next}; + $next=$hash{'map_start_'.$hash{'src_'.$next}}; + } + } elsif + ((split(/\./,$startoutrid))[0]!=(split(/\./,$next))[0]) { +# This comes up from a map (coming up one level); + $mapurl=$hash{'map_id_'.(split(/\./,$next))[0]}; + } + } elsif ($direction eq 'back') { +# ------------------------------------------------------------------- Backwards + while ($hash{'type_'.$rid} eq 'start') { + $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}}; + } + 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}}); + } + } split(/\,/,$posnext); + if ($hash{'is_map_'.$next}) { +# This jumps to the end of a new map (going down one level) + if ( + $hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'sequence') { + $mapurl=$hash{'src_'.$next}; + $next=$hash{'map_finish_'.$hash{'src_'.$next}}; + } + } elsif + ((split(/\./,$startoutrid))[0]!=(split(/\./,$next))[0]) { +# This comes back up from a map (going up one level); + $mapurl=$hash{'map_id_'.(split(/\./,$next))[0]}; + } + } + return ($next,$mapurl); } # ================================================================ Main Handler @@ -101,305 +179,216 @@ 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=(); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['postdata']); 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) && (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER(),0640))) { + my ($murl,$fn)=split(/\_\_\_/,$last); + my $id; + ($murl,$id,$fn)=split(/\_\_\_/,&Apache::lonnet::symbread($fn)); + $newloc=$hash{'src_'. + $hash{'map_pc_'.&Apache::lonnet::clutter($murl)}.'.'.$id}; + unless ($newloc) { $newloc='/adm/noidea.html'; } + untie %hash; + } 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'); +# +# Is the current URL on the map? If not, start with last known URL +# + unless (&Apache::lonnet::is_on_map($currenturl)) { + 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=&Apache::lonnet::clutter((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)); +# ------------------------------------------- Do we have any idea where we are? + my $position; + if ($position=Apache::lonnet::symbread($currenturl)) { +# ------------------------------------------------------------------------- Yes + my ($startoutmap,$mapnum,$thisurl)=split(/\_\_\_/,$position); + $cachehash{$startoutmap}{$thisurl}=$mapnum; + $cachehash{$startoutmap}{'last_known'}= + &Apache::lonnet::declutter($currenturl); + +# ============================================================ Tie the big hash + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + my $rid=$hash{'map_pc_'.&Apache::lonnet::clutter($startoutmap)}. + '.'.$mapnum; + +# ------------------------------------------------- Move forward, backward, etc + my $endupmap; + ($next,$endupmap)=&move($rid,$startoutmap,$direction); +# -------------------------------------- Do we have one and only one empty URL? + my $safecount=0; + while (($next) && ($next!~/\,/) && + ((!$hash{'src_'.$next}) || ($hash{'randomout_'.$next})) + && ($safecount<10000)) { + ($next,$endupmap)=&move($next,$endupmap,$direction); + $safecount++; + } +# We are now at at least one non-empty URL +# ----------------------------------------------------- Check out possibilities + if ($next) { + @possibilities=split(/\,/,$next); + if ($#possibilities==0) { +# ---------------------------------------------- Only one possibility, redirect + $redirecturl=$hash{'src_'.$next}; + $cachehash{$endupmap} + {&Apache::lonnet::declutter($redirecturl)} + =(split(/\./,$next))[1]; + } else { +# ------------------------ There are multiple possibilities for a next resource + $multichoice=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; - } + $multichoicehash{'src_'.$_}=$hash{'src_'.$_}; + $multichoicehash{'title_'.$_}=$hash{'title_'.$_}; + $multichoicehash{'type_'.$_}=$hash{'type_'.$_}; + (my $first, my $second) = $_ =~ /(\d+).(\d+)/; + my $symbSrc = Apache::lonnet::declutter($hash{'src_'.$_}); + $multichoicehash{'symb_'.$_} = + Apache::lonnet::declutter($hash{'map_id_'.$first}.'___'. + $second.'___'.$symbSrc); + + my ($choicemap,$choiceres)=split(/\./,$_); + $cachehash + {&Apache::lonnet::declutter($hash{'src_'.$choicemap})} + {&Apache::lonnet::declutter( + $multichoicehash + {'src_'.$_} + )} + =$choiceres; + } @possibilities; } - unless ($contents) { - $r->content_type('text/html'); - $r->send_http_header; - $r->print('Empty page.'); - } else { -# ------------------------------------------------------------------ Build page + } 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{$startoutmap}{'last_direction'}=$direction; + foreach my $thismap (keys %cachehash) { + &Apache::lonnet::symblist($thismap,%{$cachehash{$thismap}}); + } +# ============================================== Do not return before this line + if ($redirecturl) { +# ----------------------------------------------------- There is a URL to go to +# ------------------------------------------------- Check for critical messages + if ((time-$ENV{'user.criticalcheck.time'})>300) { + my @what=&Apache::lonnet::dump + ('critical',$ENV{'user.domain'}, + $ENV{'user.name'}); + if ($what[0]) { + if (($what[0] ne 'con_lost') && + ($what[0]!~/^error\:/)) { + $redirecturl='/adm/email?critical=display'; + } + } + &Apache::lonnet::appenv('user.criticalcheck.time'=>time); + } -# ---------------------------------------------------------------- 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->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) { + my $bodytag= + &Apache::loncommon::bodytag('Multiple Resources'); + $r->print(<Choose Next Location +$bodytag +

There are several possibilities of where to go next

+

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

+ + +ENDSTART + foreach (@possibilities) { + $r->print( + ''); + } + $r->print('
TitleType
'. + $multichoicehash{'title_'.$_}. + ''.$multichoicehash{'type_'.$_}. + '
'); + return OK; + } else { + my $bodytag=&Apache::loncommon::bodytag('No Resource'); + $r->print(<No Resource +$bodytag +

Next resource could not be identified.

+

You probably are at the beginning or the end of the +course.

+ + + +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;