# The LearningOnline Network with CAPA
#
# Page flip handler
#
# $Id: lonpageflip.pm,v 1.74 2006/10/20 22:04:16 albertel 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/
#
package Apache::lonpageflip;
use strict;
use LONCAPA;
use Apache::Constants qw(:common :http REDIRECT);
use Apache::lonnet;
use Apache::loncommon();
use HTML::TokeParser;
use GDBM_File;
# ========================================================== Module Global Hash
my %hash;
sub cleanup {
if (tied(%hash)){
&Apache::lonnet::logthis('Cleanup pageflip: hash');
unless (untie(%hash)) {
&Apache::lonnet::logthis('Failed cleanup pageflip: hash');
}
}
return OK;
}
sub addrid {
my ($current,$new,$condid)=@_;
unless ($condid) { $condid=0; }
if ($current) {
$current.=','.$new;
} else {
$current=''.$new;
}
return $current;
}
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($rid,$mapurl);
}
sub hash_src {
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}) {
return (&Apache::lonenc::encrypted($hash{'src_'.$id}),
&Apache::lonenc::encrypted($symb));
}
return ($hash{'src_'.$id},$symb);
}
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 $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]}};
}
foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
my $condition= $hash{'conditions_'.$hash{'goesto_'.$id}};
my $rescond = &Apache::lonnet::docondval($condition);
my $linkcond = &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$id}});
my $thiscond = ($rescond<$linkcond)?$rescond:$linkcond;
if ($thiscond>=$mincond) {
if ($posnext) {
$posnext.=','.$id.':'.$thiscond;
} else {
$posnext=$id.':'.$thiscond;
}
if ($thiscond>$mincond) { $mincond=$thiscond; }
}
}
foreach my $id (split(/\,/,$posnext)) {
my ($linkid,$condval)=split(/\:/,$id);
if ($condval>=$mincond) {
$next=&addrid($next,$hash{'goesto_'.$linkid},
$hash{'condid_'.$hash{'undercond_'.$linkid}});
}
}
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 (
# This jumps back up from an empty sequence, to a page up one level
$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'page') {
$mapurl=$hash{'map_id_'.(split(/\./,$next))[0]};
}
} 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]}};
}
foreach my $id (split(/\,/,$hash{'from_'.$rid})) {
my $condition= $hash{'conditions_'.$hash{'comesfrom_'.$id}};
my $rescond = &Apache::lonnet::docondval($condition);
my $linkcond = &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$id}});
my $thiscond = ($rescond<$linkcond)?$rescond:$linkcond;
if ($thiscond>=$mincond) {
if ($posnext) {
$posnext.=','.$id.':'.$thiscond;
} else {
$posnext=$id.':'.$thiscond;
}
if ($thiscond>$mincond) { $mincond=$thiscond; }
}
}
foreach my $id (split(/\,/,$posnext)) {
my ($linkid,$condval)=split(/\:/,$id);
if ($condval>=$mincond) {
$next=&addrid($next,$hash{'comesfrom_'.$linkid},
$hash{'condid_'.$hash{'undercond_'.$linkid}});
}
}
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 (
$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'page') {
# This jumps back up from an empty sequence, to a page up one level
$mapurl=$hash{'map_id_'.(split(/\./,$next))[0]};
}
} 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);
}
sub navlaunch {
my ($r)=@_;
&Apache::loncommon::content_type($r,'text/html');
&Apache::loncommon::no_cache($r);
$r->send_http_header;
$r->print(&Apache::loncommon::start_page('Launched'));
$r->print(<
Collapse external navigation window
ENDNAV $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 (!&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 sub handler { my $r=shift; # ------------------------------------------- Set document type for header only if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } my %cachehash=(); my $multichoice=0; my %multichoicehash=(); my ($redirecturl,$redirectsymb); 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; if ($currenturl=~m|^/enc/|) { $currenturl=&Apache::lonenc::unencrypted($currenturl); } $currenturl=~s/\.\d+\.(\w+)$/\.$1/; if ($direction eq 'firstres') { my $furl=&first_accessible_resource(); &Apache::loncommon::content_type($r,'text/html'); $r->header_out(Location => &Apache::lonnet::absolute_url().$furl); return REDIRECT; } if ($direction eq 'return' || $direction eq 'navlaunch') { # -------------------------------------------------------- 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,$id,$fn)=&Apache::lonnet::decode_symb($last); $id=$hash{'map_pc_'.&Apache::lonnet::clutter($murl)}.'.'.$id; $newloc=$hash{'src_'.$id}; if ($newloc) { if ($hash{'encrypted_'.$id}) { $newloc=&Apache::lonenc::encrypted($newloc); } } else { $newloc='/adm/navmaps'; } untie %hash; } else { $newloc='/adm/navmaps'; } if ($newloc eq '/adm/navmaps' && $direction eq 'navlaunch') { &navlaunch($r); return OK; } else { &Apache::loncommon::content_type($r,'text/html'); $r->header_out(Location => &Apache::lonnet::absolute_url().$newloc); return REDIRECT; } } $currenturl=~s/^http\:\/\///; $currenturl=~s/^[^\/]+//; # # 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((&Apache::lonnet::decode_symb($last))[2]); } else { if ($direction eq 'return') { &Apache::loncommon::content_type($r,'text/html'); $r->header_out(Location => &Apache::lonnet::absolute_url(). '/adm/noidea.html'); return REDIRECT; } else { &navlaunch($r); return OK; } } } # ------------------------------------------- Do we have any idea where we are? my $position; if ($position=Apache::lonnet::symbread($currenturl)) { # ------------------------------------------------------------------------- Yes my ($startoutmap,$mapnum,$thisurl)=&Apache::lonnet::decode_symb($position); $cachehash{$startoutmap}{$thisurl}=[$thisurl,$mapnum]; $cachehash{$startoutmap}{'last_known'}= [&Apache::lonnet::declutter($currenturl),$mapnum]; # ============================================================ 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? # 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,$redirectsymb)=&hash_src($next); $cachehash{$endupmap}{$redirecturl}= [$redirecturl,(split(/\./,$next))[1]]; } else { # ------------------------ There are multiple possibilities for a next resource $multichoice=1; foreach my $id (@possibilities) { $multichoicehash{'src_'.$id}=$hash{'src_'.$id}; $multichoicehash{'title_'.$id}=$hash{'title_'.$id}; $multichoicehash{'type_'.$id}=$hash{'type_'.$id}; (my $first, my $second) = $id =~ /(\d+).(\d+)/; my $symbSrc = Apache::lonnet::declutter($hash{'src_'.$id}); $multichoicehash{'symb_'.$id} = Apache::lonnet::declutter($hash{'map_id_'.$first}.'___'. $second.'___'.$symbSrc); my ($choicemap,$choiceres)=split(/\./,$id); my $map=&Apache::lonnet::declutter($hash{'src_'.$choicemap}); my $url=$multichoicehash{'src_'.$id}; $cachehash{$map}{$url}=[$url,$choiceres]; } } } 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,'notasymb']; foreach my $thismap (keys %cachehash) { my $mapnum=$cachehash{$thismap}->{'mapnum'}; delete($cachehash{$thismap}->{'mapnum'}); &Apache::lonnet::symblist($thismap, %{$cachehash{$thismap}}); } # ============================================== Do not return before this line if ($redirecturl) { # ----------------------------------------------------- There is a URL to go to if ($direction eq 'forward') { &Apache::lonnet::linklog($currenturl,$redirecturl); } if ($direction eq 'back') { &Apache::lonnet::linklog($redirecturl,$currenturl); } # ------------------------------------------------- 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'; $redirectsymb=''; } } &Apache::lonnet::appenv('user.criticalcheck.time'=>time); } &Apache::loncommon::content_type($r,'text/html'); my $url=&Apache::lonnet::absolute_url().$redirecturl; $url = &add_get_param($url, { 'symb' => $redirectsymb}); $r->header_out(Location => $url); return REDIRECT; } else { # --------------------------------------------------------- There was a problem &Apache::loncommon::content_type($r,'text/html'); $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) { my $start_page= &Apache::loncommon::start_page('Multiple Resources'); $r->print(<$lt{'pick'}:
$lt{'titleheader'} | $lt{'type'} |
---|---|
'. $multichoicehash{'title_'.$id}. ' | '.$multichoicehash{'type_'.$id}. ' |
$lt{'explain'}
ENDNONE } $r->print(<