[BACK]Return to lonpageflip.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

Diff for /rat/lonpageflip.pm between versions 1.54 and 1.79.6.1

version 1.54, 2005/08/02 20:51:18 version 1.79.6.1, 2010/12/30 21:15:40
Line 27 Line 27
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   
   
 package Apache::lonpageflip;  package Apache::lonpageflip;
   
 use strict;  use strict;
   use LONCAPA;
 use Apache::Constants qw(:common :http REDIRECT);  use Apache::Constants qw(:common :http REDIRECT);
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon();
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
Line 46  sub cleanup { Line 50  sub cleanup {
     &Apache::lonnet::logthis('Failed cleanup pageflip: hash');      &Apache::lonnet::logthis('Failed cleanup pageflip: hash');
         }          }
     }      }
       return OK;
 }  }
   
 sub addrid {  sub addrid {
Line 73  sub fullmove { Line 78  sub fullmove {
   
 sub hash_src {  sub hash_src {
     my ($id)=@_;      my ($id)=@_;
       my ($mapid,$resid)=split(/\./,$id);
       my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
     $resid,$hash{'src_'.$id});
     if ($hash{'encrypted_'.$id}) {      if ($hash{'encrypted_'.$id}) {
  return &Apache::lonenc::encrypted($hash{'src_'.$id});   return (&Apache::lonenc::encrypted($hash{'src_'.$id}),
    &Apache::lonenc::encrypted($symb));
     }      }
     return $hash{'src_'.$id};      return ($hash{'src_'.$id},$symb);
 }  }
   
 sub move {  sub move {
       my ($next,$endupmap,$direction) = @_;
       my $safecount=0;
       my $allowed=0;
       do {
    ($next,$endupmap)=&get_next_possible_move($next,$endupmap,$direction);
   
    my $url = $hash{'src_'.$next};
    my ($mapid,$resid)=split(/\./,$next);
    my $symb = &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
    $resid,$url);
    if ($url eq '' || $symb eq '') {
       $allowed = 0;
    } else {
       my $priv = &Apache::lonnet::allowed('bre',$url,$symb);
       $allowed = (($priv eq 'F') || ($priv eq '2'));
    }
    $safecount++;
       } while (   ($next)
        && ($next!~/\,/)
        && (
       (!$hash{'src_'.$next})
    || (
           (!$env{'request.role.adv'})
        &&  $hash{'randomout_'.$next}
       )
    || (!$allowed)
    )
        && ($safecount<10000));
   
       return ($next,$endupmap);
   }
   
   sub get_next_possible_move {
     my ($rid,$mapurl,$direction)=@_;      my ($rid,$mapurl,$direction)=@_;
     my $startoutrid=$rid;      my $startoutrid=$rid;
   
Line 92  sub move { Line 134  sub move {
                   while ($hash{'type_'.$rid} eq 'finish') {                    while ($hash{'type_'.$rid} eq 'finish') {
              $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}};               $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}};
                   }                    }
                   map {    foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
                       my $thiscond=       my $condition= $hash{'conditions_'.$hash{'goesto_'.$id}};
       &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});       my $rescond  = &Apache::lonnet::docondval($condition);
                       if ($thiscond>=$mincond) {       my $linkcond = &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$id}});
        my $thiscond = ($rescond<$linkcond)?$rescond:$linkcond;
        if ($thiscond>=$mincond) {
           if ($posnext) {            if ($posnext) {
              $posnext.=','.$_.':'.$thiscond;               $posnext.=','.$id.':'.$thiscond;
                           } else {                            } else {
                              $posnext=$_.':'.$thiscond;                               $posnext=$id.':'.$thiscond;
           }            }
                           if ($thiscond>$mincond) { $mincond=$thiscond; }                            if ($thiscond>$mincond) { $mincond=$thiscond; }
               }                }
                   } split(/\,/,$hash{'to_'.$rid});                    } 
                   map {    foreach my $id (split(/\,/,$posnext))  {
                       my ($linkid,$condval)=split(/\:/,$_);                        my ($linkid,$condval)=split(/\:/,$id);
                       if ($condval>=$mincond) {                        if ($condval>=$mincond) {
           $next=&addrid($next,$hash{'goesto_'.$linkid},            $next=&addrid($next,$hash{'goesto_'.$linkid},
                                 $hash{'condid_'.$hash{'undercond_'.$linkid}});                                  $hash{'condid_'.$hash{'undercond_'.$linkid}});
                       }                        }
                   } split(/\,/,$posnext);                    }
                   if ($hash{'is_map_'.$next}) {                    if ($hash{'is_map_'.$next}) {
 # This jumps to the beginning of a new map (going down level)  # This jumps to the beginning of a new map (going down level)
                       if (                        if (
Line 126  sub move { Line 170  sub move {
                     ((split(/\./,$startoutrid))[0]!=(split(/\./,$next))[0]) {                      ((split(/\./,$startoutrid))[0]!=(split(/\./,$next))[0]) {
 # This comes up from a map (coming up one level);  # This comes up from a map (coming up one level);
       $mapurl=$hash{'map_id_'.(split(/\./,$next))[0]};        $mapurl=$hash{'map_id_'.(split(/\./,$next))[0]};
                   }    }
               } elsif ($direction eq 'back') {                } elsif ($direction eq 'back') {
 # ------------------------------------------------------------------- Backwards  # ------------------------------------------------------------------- Backwards
                  while ($hash{'type_'.$rid} eq 'start') {                   while ($hash{'type_'.$rid} eq 'start') {
              $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}};               $rid=$hash{'ids_'.$hash{'map_id_'.(split(/\./,$rid))[0]}};
  }   }
                   map {   foreach my $id (split(/\,/,$hash{'from_'.$rid})) {
                       my $thiscond=       my $condition= $hash{'conditions_'.$hash{'comesfrom_'.$id}};
       &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});       my $rescond  = &Apache::lonnet::docondval($condition);
                       if ($thiscond>=$mincond) {       my $linkcond = &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$id}});
           if ($posnext) {       my $thiscond = ($rescond<$linkcond)?$rescond:$linkcond;
              $posnext.=','.$_.':'.$thiscond;       if ($thiscond>=$mincond) {
                           } else {   if ($posnext) {
                              $posnext=$_.':'.$thiscond;               $posnext.=','.$id.':'.$thiscond;
           }   } else {
                           if ($thiscond>$mincond) { $mincond=$thiscond; }                               $posnext=$id.':'.$thiscond;
               }   }
                   } split(/\,/,$hash{'from_'.$rid});   if ($thiscond>$mincond) { $mincond=$thiscond; }
                   map {       }
                       my ($linkid,$condval)=split(/\:/,$_);   } 
                       if ($condval>=$mincond) {   foreach my $id (split(/\,/,$posnext)) {
           $next=&addrid($next,$hash{'comesfrom_'.$linkid},       my ($linkid,$condval)=split(/\:/,$id);
                                 $hash{'condid_'.$hash{'undercond_'.$linkid}});       if ($condval>=$mincond) {
                       }   $next=&addrid($next,$hash{'comesfrom_'.$linkid},
                   } split(/\,/,$posnext);         $hash{'condid_'.$hash{'undercond_'.$linkid}});
        }
    }
                   if ($hash{'is_map_'.$next}) {                    if ($hash{'is_map_'.$next}) {
 # This jumps to the end of a new map (going down one level)  # This jumps to the end of a new map (going down one level)
                       if (                        if (
Line 176  sub navlaunch { Line 222  sub navlaunch {
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     $r->send_http_header;      $r->send_http_header;
     my $html=&Apache::lonxml::xmlbegin();      $r->print(&Apache::loncommon::start_page('Launched'));   
     $r->print("$html<head>\n");  
     $r->print('</head>'.  
       &Apache::loncommon::bodytag('Launched'));     
     $r->print(<<ENDNAV);      $r->print(<<ENDNAV);
     <p><a href="/adm/flip?postdata=firstres%3a">Goto first resource</a></p>      <p><a href="/adm/flip?postdata=firstres%3a">Goto first resource</a></p>
     <script type="text/javascript">      <script type="text/javascript">
Line 189  sub navlaunch { Line 232  sub navlaunch {
     this.document.location='/adm/navmaps?turningOffExternal';      this.document.location='/adm/navmaps?turningOffExternal';
  }   }
     </script>      </script>
     <p><a href="javascript:collapse();">Collapse External Navigation Window</a></p>      <p><a href="javascript:collapse();">Collapse external navigation window</a></p>
 ENDNAV  ENDNAV
     $r->print(&Apache::loncommon::endbodytag().'</html>');      $r->print(&Apache::loncommon::end_page());
 }  }
   
   sub first_accessible_resource {
       my $furl;
       if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'.db',
       &GDBM_READER(),0640)) {
    $furl=$hash{'first_url'};
    my %args;
    my ($url,$args) = split(/\?/,$furl);
    foreach my $pair (split(/\&/,$args)) {
       my ($name,$value) = split(/=/,$pair);
       $args{&unescape($name)} = &unescape($value);
    }
           if ((($env{'environment.remotenavmap'} eq 'on') && ($furl =~ m{^/adm/navmaps})) ||
               (!&Apache::lonnet::allowed('bre',$url,$args{'symb'}))) {
   # Wow, we cannot see this ... move forward to the next one that we can see
       my ($newrid,$newmap)=&move($hash{'first_rid'},$hash{'first_mapurl'},'forward');
   # Build the new URL
       my ($newmapid,$newresid)=split(/\./,$newrid);
       my $symb=&Apache::lonnet::encode_symb($newmap,$newresid,$hash{'src_'.$newrid});
       $furl=&add_get_param($hash{'src_'.$newrid},{ 'symb' => $symb });
       if ($hash{'encrypted_'.$newrid}) {
    $furl=&Apache::lonenc::encrypted($furl);
       }
    }
    untie(%hash);
    return $furl;
       } else {
    return '/adm/navmaps';
       }
   }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
Line 209  sub handler { Line 283  sub handler {
   my %cachehash=();     my %cachehash=(); 
   my $multichoice=0;    my $multichoice=0;
   my %multichoicehash=();    my %multichoicehash=();
   my $redirecturl='';    my ($redirecturl,$redirectsymb);
   my $next='';    my $next='';
   my @possibilities=();    my @possibilities=();
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['postdata']);     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['postdata']);
Line 222  sub handler { Line 296  sub handler {
       }        }
       $currenturl=~s/\.\d+\.(\w+)$/\.$1/;        $currenturl=~s/\.\d+\.(\w+)$/\.$1/;
       if ($direction eq 'firstres') {        if ($direction eq 'firstres') {
   my $furl;    my $furl=&first_accessible_resource();
   if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',  
   &GDBM_READER(),0640)) {  
       $furl=$bighash{'first_url'};  
       untie(%bighash);  
   }  
   &Apache::loncommon::content_type($r,'text/html');    &Apache::loncommon::content_type($r,'text/html');
   $r->header_out(Location =>     $r->header_out(Location => 
  'http://'.$ENV{'HTTP_HOST'}.$furl);   &Apache::lonnet::absolute_url().$furl);
             
   return REDIRECT;    return REDIRECT;
       }        }
Line 252  sub handler { Line 321  sub handler {
  if ($hash{'encrypted_'.$id}) { $newloc=&Apache::lonenc::encrypted($newloc); }   if ($hash{'encrypted_'.$id}) { $newloc=&Apache::lonenc::encrypted($newloc); }
               
     } else {      } else {
  $newloc='/adm/noidea.html';   $newloc='/adm/navmaps';
     }      }
             untie %hash;              untie %hash;
          } else {           } else {
     $newloc='/adm/noidea.html';      $newloc='/adm/navmaps';
          }             }
  if ($newloc eq '/adm/noidea.html' && $direction eq 'navlaunch') {   if (($newloc =~ m{^/adm/navmaps}) && ($direction eq 'navlaunch')) {
      &navlaunch($r);       &navlaunch($r);
      return OK;       return OK;
  } else {   } else {
      &Apache::loncommon::content_type($r,'text/html');       &Apache::loncommon::content_type($r,'text/html');
      $r->header_out(Location =>        $r->header_out(Location => 
     'http://'.$ENV{'HTTP_HOST'}.$newloc);      &Apache::lonnet::absolute_url().$newloc);
             
      return REDIRECT;       return REDIRECT;
  }   }
       }        }
       $currenturl=~s/^http\:\/\///;        $currenturl=~s/^https?\:\/\///;
       $currenturl=~s/^[^\/]+//;        $currenturl=~s/^[^\/]+//;
 #  #
 # Is the current URL on the map? If not, start with last known URL  # Is the current URL on the map? If not, start with last known URL
Line 287  sub handler { Line 356  sub handler {
      if ($direction eq 'return') {       if ($direction eq 'return') {
  &Apache::loncommon::content_type($r,'text/html');   &Apache::loncommon::content_type($r,'text/html');
  $r->header_out(Location =>    $r->header_out(Location => 
  'http://'.$ENV{'HTTP_HOST'}.'/adm/noidea.html');   &Apache::lonnet::absolute_url().
    '/adm/noidea.html');
  return REDIRECT;   return REDIRECT;
      } else {       } else {
  &navlaunch($r);   &navlaunch($r);
Line 314  sub handler { Line 384  sub handler {
               my $endupmap;                my $endupmap;
               ($next,$endupmap)=&move($rid,$startoutmap,$direction);                ($next,$endupmap)=&move($rid,$startoutmap,$direction);
 # -------------------------------------- Do we have one and only one empty URL?  # -------------------------------------- Do we have one and only one empty URL?
               my $safecount=0;  
               while (($next) && ($next!~/\,/) &&   
                      ((!$hash{'src_'.$next}) ||   
       ((!$env{'request.role.adv'}) && $hash{'randomout_'.$next}))  
                      && ($safecount<10000)) {  
                   ($next,$endupmap)=&move($next,$endupmap,$direction);  
                   $safecount++;  
               }  
 # We are now at at least one non-empty URL  # We are now at at least one non-empty URL
 # ----------------------------------------------------- Check out possibilities  # ----------------------------------------------------- Check out possibilities
               if ($next) {                if ($next) {
                   @possibilities=split(/\,/,$next);                    @possibilities=split(/\,/,$next);
                   if ($#possibilities==0) {                    if ($#possibilities==0) {
 # ---------------------------------------------- Only one possibility, redirect  # ---------------------------------------------- Only one possibility, redirect
               $redirecturl=&hash_src($next);                ($redirecturl,$redirectsymb)=&hash_src($next);
                       $cachehash{$endupmap}{$redirecturl}=                        $cachehash{$endupmap}{$redirecturl}=
   [$redirecturl,(split(/\./,$next))[1]];    [$redirecturl,(split(/\./,$next))[1]];
                   } else {                    } else {
 # ------------------------ There are multiple possibilities for a next resource  # ------------------------ There are multiple possibilities for a next resource
                       $multichoice=1;                        $multichoice=1;
                       map {        foreach my $id (@possibilities) {
   $multichoicehash{'src_'.$_}=$hash{'src_'.$_};    $multichoicehash{'src_'.$id}=$hash{'src_'.$id};
                           $multichoicehash{'title_'.$_}=$hash{'title_'.$_};                            $multichoicehash{'title_'.$id}=$hash{'title_'.$id};
                           $multichoicehash{'type_'.$_}=$hash{'type_'.$_};                            $multichoicehash{'type_'.$id}=$hash{'type_'.$id};
                           (my $first, my $second) = $_ =~ /(\d+).(\d+)/;                            (my $first, my $second) = $id =~ /(\d+).(\d+)/;
                           my $symbSrc = Apache::lonnet::declutter($hash{'src_'.$_});                            my $symbSrc = Apache::lonnet::declutter($hash{'src_'.$id});
                           $multichoicehash{'symb_'.$_} =                             $multichoicehash{'symb_'.$id} = 
                               Apache::lonnet::declutter($hash{'map_id_'.$first}.'___'.                                Apache::lonnet::declutter($hash{'map_id_'.$first}.'___'.
                                                         $second.'___'.$symbSrc);                                                          $second.'___'.$symbSrc);
                                                                                                                     
                           my ($choicemap,$choiceres)=split(/\./,$_);                            my ($choicemap,$choiceres)=split(/\./,$id);
   my $map=&Apache::lonnet::declutter($hash{'src_'.$choicemap});    my $map=&Apache::lonnet::declutter($hash{'src_'.$choicemap});
   my $url=$multichoicehash{'src_'.$_};    my $url=$multichoicehash{'src_'.$id};
                           $cachehash{$map}{$url}=[$url,$choiceres];                            $cachehash{$map}{$url}=[$url,$choiceres];
                       } @possibilities;                        }
                   }                    }
       } else {        } else {
 # -------------------------------------------------------------- No place to go  # -------------------------------------------------------------- No place to go
Line 382  sub handler { Line 444  sub handler {
                 if (($what[0] ne 'con_lost') &&                   if (($what[0] ne 'con_lost') && 
                             ($what[0]!~/^error\:/)) {                              ($what[0]!~/^error\:/)) {
                    $redirecturl='/adm/email?critical=display';                     $redirecturl='/adm/email?critical=display';
      $redirectsymb='';
                         }                          }
                      }                       }
                      &Apache::lonnet::appenv('user.criticalcheck.time'=>time);                       &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
   }    }
   
                     if (($redirecturl =~ m{^/adm/navmaps}) &&
                         ($env{'environment.remotenavmap'} eq 'on')) {
                         &navlaunch($r);
                         return OK;
                     }
   &Apache::loncommon::content_type($r,'text/html');    &Apache::loncommon::content_type($r,'text/html');
                   $r->header_out(Location =>     my $url=&Apache::lonnet::absolute_url().$redirecturl;
                                 'http://'.$ENV{'HTTP_HOST'}.$redirecturl);    $url = &add_get_param($url, { 'symb' => $redirectsymb});
                     $r->header_out(Location => $url);
                   return REDIRECT;                    return REDIRECT;
       } else {        } else {
 # --------------------------------------------------------- There was a problem  # --------------------------------------------------------- There was a problem
                   &Apache::loncommon::content_type($r,'text/html');                    &Apache::loncommon::content_type($r,'text/html');
                   $r->send_http_header;                    $r->send_http_header;
     my %lt=&Apache::lonlocal::texthash('title' => 'End of Sequence',
        'explain' =>
        'You have reached the end of the sequence of materials.',
        'back' => 'Go Back',
        'nav' => 'Navigate Course Content',
        'wherenext' =>
        'There are several possibilities of where to go next',
        'pick' =>
        'Please click on the the resource you intend to access',
        'titleheader' => 'Title',
        'type' => 'Type');
                   if ($#possibilities>0) {                    if ($#possibilities>0) {
       my $bodytag=        my $start_page=
                              &Apache::loncommon::bodytag('Multiple Resources');    &Apache::loncommon::start_page('Multiple Resources');
                      $r->print(<<ENDSTART);                       $r->print(<<ENDSTART);
 <head><title>Choose Next Location</title></head>  $start_page
 $bodytag  <h3>$lt{'wherenext'}</h3>
 <h3>There are several possibilities of where to go next</h3>  
 <p>  <p>
 Please click on the the resource you intend to access:  $lt{'pick'}:
 <p>  <p>
 <table border=2>  <table border="2">
 <tr><th>Title</th><th>Type</th></tr>  <tr><th>$lt{'titleheader'}</th><th>$lt{'type'}</th></tr>
 ENDSTART  ENDSTART
                      foreach (@possibilities) {                       foreach my $id (@possibilities) {
                         $r->print(                          $r->print(
                               '<tr><td><a href="'.                                '<tr><td><a href="'.
                               $multichoicehash{'src_'.$_}.'?symb=' .    &add_get_param($multichoicehash{'src_'.$id},
                                   Apache::lonnet::escape($multichoicehash{'symb_'.$_}).'">'.   {'symb' =>
                               $multichoicehash{'title_'.$_}.        $multichoicehash{'symb_'.$id},
                               '</a></td><td>'.$multichoicehash{'type_'.$_}.    }).'">'.
                                 $multichoicehash{'title_'.$id}.
                                 '</a></td><td>'.$multichoicehash{'type_'.$id}.
       '</td></tr>');        '</td></tr>');
                      }                       }
                      $r->print('</table></body></html>');                       $r->print('</table>');
      return OK;  
                   } else {                    } else {
       my $bodytag=&Apache::loncommon::bodytag('No Resource');        my $start_page=
                      $r->print(<<ENDNONE);    &Apache::loncommon::start_page('No Resource');
 <head><title>No Resource</title></head>        $r->print(<<ENDNONE);
 $bodytag  $start_page
 <h3>Next resource could not be identified.</h3>  <h3>$lt{'title'}</h3>
 <p>You probably are at the <b>beginning</b> or the <b>end</b> of the   <p>$lt{'explain'}</p>
 course.</p>  ENDNONE
     }
     $r->print(<<ENDMENU);
 <ul>  <ul>
 <li><a href="/adm/flip?postdata=return:">Go Back</a></li>  <li><a href="/adm/flip?postdata=return:">$lt{'back'}</a></li>
 <li><a href="/adm/navmaps">Navigate Course Content</a></li>  <li><a href="/adm/navmaps">$lt{'nav'}</a></li>
 </ul>  </ul>
 </body>  ENDMENU
 </html>                    $r->print(&Apache::loncommon::end_page());
 ENDNONE                    return OK;
                      return OK;        }
          }  
      }  
   } else {    } else {
 # ------------------------------------------------- Problem, could not tie hash  # ------------------------------------------------- Problem, could not tie hash
               $env{'user.error.msg'}="/adm/flip:bre:0:1:Course Data Missing";                $env{'user.error.msg'}="/adm/flip:bre:0:1:Course Data Missing";
Line 444  ENDNONE Line 524  ENDNONE
           }            }
       } else {        } else {
 # ---------------------------------------- No, could not determine where we are  # ---------------------------------------- No, could not determine where we are
   if ( &Apache::lonnet::mod_perl_version() == 2 ) {  
       &Apache::lonnet::cleanenv();  
   }  
   $r->internal_redirect('/adm/ambiguous');    $r->internal_redirect('/adm/ambiguous');
       }        }
   } else {    } else {
Line 459  ENDNONE Line 536  ENDNONE
 1;  1;
 __END__  __END__
   
   =pod
   
   =head1 NAME
   
   Apache::lonpageflip
   
   =head1 SYNOPSIS
   
   Deals with forward, backward, and other page flips.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 OVERVIEW
   
   (empty)
   
   =head1 SUBROUTINES
   
   =over cleanup()
   
   =item addrid()
   
   =item fullmove()
   
   =item hash_src()
   
   =item move()
   
   =item get_next_possible_move()
   
   =item navlaunch()
   
   =item first_accessible_resource()
   
   =item handler()
   
   =back
   
   =cut
   
   
   
Removed from v.1.54  
changed lines
  Added in v.1.79.6.1

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>