--- rat/lonpageflip.pm 2000/10/05 22:14:11 1.2 +++ rat/lonpageflip.pm 2000/10/07 22:30:30 1.3 @@ -10,7 +10,7 @@ # 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 Gerd Kortemeyer package Apache::lonpageflip; @@ -20,72 +20,20 @@ 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)=@_; + if (&Apache::lonnet::allowed('bre',$hash{'src_'.$new})) { + if ($current) { + $current.=','.$new; + } else { + $current=''.$new; + } } - return $further; + return $current; } # ================================================================ Main Handler @@ -109,6 +57,8 @@ sub handler { $r->print(''); # --------END DEBUG ONLY TRASH + my %cachehash=(); + my $redir=0; if (($ENV{'form.postdata'})&&($ENV{'request.course.fn'})) { $ENV{'form.postdata'}=~/(\w+)\:(.*)/; @@ -117,35 +67,34 @@ 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 +# ------------------------------------------- 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_'.$_}); + } split(/\,/,$hash{'to_'.$rid}); + my @possibilities=split(/,/,$next); + if ($#possibilities==1) { + my $goto=$possibilities[0]; + } + } elsif ($direction eq 'back') { + } elsif ($direction eq 'up') { + } elsif ($direction eq 'down') { + } + untie(%hash); + $r->print($rid.' - '.$next); + } } 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; +# -------------------------------------------------------------------------- No + $r->print('No idea '.$currenturl); } # -------------------------- Class was not initialized or page fliped strangely } else { @@ -165,241 +114,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 +# &Apache::lonnet::symblist($requrl,%symbhash); - 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(''); - } -# ----------------------------------------------------------------- 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;