--- rat/lonpageflip.pm 2000/10/03 20:33:06 1.1 +++ rat/lonpageflip.pm 2000/10/11 21:16:29 1.6 @@ -10,341 +10,175 @@ # 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 Gerd Kortemeyer +# 10/03,10/05,10/06,10/07,10/09,10/10,10/11 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 sub handler { - my $r=shift; + my $r=shift; # ------------------------------------------- Set document type for header only -# if ($r->headers_only) { + if ($r->header_only) { $r->content_type('text/html'); $r->send_http_header; -# return OK; -# } - - - - - - $r->print('
'.$ENV{'form.postdata'}.''); - return OK; - - - - 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=~/\'); - } - $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; + &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;