# The LearningOnline Network with CAPA
#
# Page flip handler
#
# (Page Handler
#
# (TeX Content Handler
#
# 05/29/00,05/30 Gerd Kortemeyer)
# 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,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 Gerd Kortemeyer
package Apache::lonpageflip;
use strict;
use Apache::Constants qw(:common :http REDIRECT);
use Apache::lonnet();
use HTML::TokeParser;
use GDBM_File;
# ========================================================== Module Global Hash
my %hash;
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 $current;
}
sub move {
my ($rid,$mapurl,$direction)=@_;
my $next='';
my $mincond=1;
my $posnext='';
if ($direction eq 'forward') {
# --------------------------------------------------------------------- Forward
if ($hash{'type_'.$rid} eq 'finish') {
$rid=$hash{'ids_/res/'.$mapurl};
}
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}) {
if (
$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'sequence') {
$mapurl=$hash{'src_'.$next};
$next=$hash{'map_start_'.$hash{'src_'.$next}};
}
}
} elsif ($direction eq 'back') {
# ------------------------------------------------------------------- Backwards
if ($hash{'type_'.$rid} eq 'start') {
$rid=$hash{'ids_/res/'.$mapurl};
}
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}) {
if (
$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$next}}} eq 'sequence') {
$mapurl=$hash{'src_'.$next};
$next=$hash{'map_finish_'.$hash{'src_'.$next}};
}
}
}
return ($next,$mapurl);
}
# ================================================================ Main Handler
sub handler {
my $r=shift;
# ------------------------------------------- Set document type for header only
if ($r->header_only) {
$r->content_type('text/html');
$r->send_http_header;
return OK;
}
my %cachehash=();
my $multichoice=0;
my %multichoicehash=();
my $redirecturl='';
my $next='';
my @possibilities=();
if (($ENV{'form.postdata'})&&($ENV{'request.course.fn'})) {
$ENV{'form.postdata'}=~/(\w+)\:(.*)/;
my $direction=$1;
my $currenturl=$2;
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) {
$newloc='/res/'.(split(/\_\_\_/,$last))[1];
} 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/^[^\/]+//;
unless ($currenturl=~/\/res\//) {
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='/res/'.(split(/\_\_\_/,$last))[1];
} else {
$r->content_type('text/html');
$r->header_out(Location =>
'http://'.$ENV{'HTTP_HOST'}.'/adm/noidea.html');
return REDIRECT;
}
}
# ------------------------------------------- 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;
# ============================================================ Tie the big hash
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
&GDBM_READER,0640)) {
my $rid=$hash{'map_pc_/res/'.$mapurl}.'.'.$mapnum;
# ------------------------------------------------- Move forward, backward, etc
($next,$mapurl)=&move($rid,$mapurl,$direction);
# -------------------------------------- Do we have one and only one empty URL?
my $safecount=0;
while (($next) && ($next!~/\,/) && (!$hash{'src_'.$next})
&& ($safecount<25)) {
($next,$mapurl)=&move($next,$mapurl,$direction);
$safecount++;
}
# ----------------------------------------------------- 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;
}
# ----------------- The program must come past this point to untie the big hash
untie(%hash);
# --------------------------------------------------------- Store position info
$cachehash{'last_direction'}=$direction;
$cachehash{'last_known'}=&Apache::lonnet::declutter($currenturl);
&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
$r->content_type('text/html');
$r->send_http_header;
if ($#possibilities>0) {
$r->print(<<ENDSTART);
<head><title>Choose Next Location</title></head>
<body bgcolor="#FFFFFF">
<h1>LON-CAPA</h1>
There are several possibilities of where to go next.
<p>
Please click on the the resource you intend to access:
<p>
<table border=2>
<tr><th>Title</th><th>Type</th></tr>
ENDSTART
map {
$r->print(
'<tr><td><a href="'.
$multichoicehash{'src_'.$_}.'">'.
$multichoicehash{'title_'.$_}.
'</a></td><td>'.$multichoicehash{'type_'.$_}.
'</td></tr>');
} @possibilities;
$r->print('</table></body></html>');
return OK;
} else {
$r->print(<<ENDNONE);
<head><title>Choose Next Location</title></head>
<body bgcolor="#FFFFFF">
<img src="/adm/lonKaputt/lonlogo_broken.gif" align=left>
<h1>Sorry!</h1>
<h2>Next resource could not be identified.</h2>
</body>
</html>
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;
}
} 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;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>