# The LearningOnline Network with CAPA
# Page Handler
#
# $Id: lonpage.pm,v 1.91.2.2 2009/10/26 09:59:12 foxr 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::lonpage;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonxml();
use Apache::lonlocal;
use Apache::lonmenu;
use HTML::TokeParser;
use GDBM_File;
use Apache::lonsequence;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
# -------------------------------------------------------------- Module Globals
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;
my $randomout=0;
unless ($env{'request.role.adv'}) {
$randomout = $hash{'randomout_'.$rid};
}
unless ($beenhere=~/\&$rid\&/) {
$beenhere.=$rid.'&';
unless ($randomout) {
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.$beenhere);
$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})) {
my $mincond=1;
my $next='';
foreach (split(/\,/,$hash{'to_'.$rid})) {
my $thiscond=
&Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});
if ($thiscond>=$mincond) {
if ($next) {
$next.=','.$_.':'.$thiscond;
} else {
$next=$_.':'.$thiscond;
}
if ($thiscond>$mincond) { $mincond=$thiscond; }
}
}
foreach (split(/\,/,$next)) {
my ($linkid,$condval)=split(/\:/,$_);
if ($condval>=$mincond) {
my $now=&tracetable($sofar,$hash{'goesto_'.$linkid},$beenhere);
if ($now>$further) { $further=$now; }
}
}
}
}
return $further;
}
# ================================================================ Main Handler
sub handler {
my $r=shift;
# ------------------------------------------- Set document type for header only
if ($r->header_only) {
if ($env{'browser.mathml'}) {
&Apache::loncommon::content_type($r,'text/xml');
} else {
&Apache::loncommon::content_type($r,'text/html');
}
$r->send_http_header;
return OK;
}
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['forceselect','launch']);
my $number_of_columns = 1;
my $requrl=$r->uri;
my $target = $env{'form.grade_target'};
# &Apache::lonnet::logthis("Got a target of $target");
if ($target eq 'meta') {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
# ----------------------------------------------------------------- Tie db file
if (($env{'request.course.fn'}) && (!$env{'form.forceselect'})) {
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,'&');
# ------------------------------------------------------------ Add to symb list
my $i;
my %symbhash=();
for ($i=0;$i<=$#rows;$i++) {
if ($rows[$i]) {
my @colcont=split(/\&/,$rows[$i]);
foreach my $rid (@colcont) {
my ($mapid,$resid)=split(/\./,$rid);
$symbhash{$hash{'src_'.$rid}}=
[$hash{'src_'.$rid},$resid];
}
}
}
&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));
foreach (@colcont) {
my $src=$hash{'src_'.$_};
my ($extension)=($src=~/\.(\w+)$/);
if ($hash{'encrypted_'.$_}) {
$src=&Apache::lonenc::encrypted($src);
}
$cellemb{$_}=
&Apache::loncommon::fileembstyle($extension);
if ($cellemb{$_} eq 'ssi') {
# --------------------------------------------------------- This is an SSI cell
my ($mapid,$resid)=split(/\./,$_);
my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$src);
my $prefix=$_.'_';
my %posthash=('request.prefix' => $prefix,
'LONCAPA_INTERNAL_no_discussion' => 'true',
'symb' => $symb);
if ($env{'form.grade_target'} eq 'tex') {
$posthash{'grade_target'}=$env{'form.grade_target'};
$posthash{'textwidth'}=$env{'form.textwidth'};
$posthash{'problem_split'}=$env{'form.problem_split'};
$posthash{'latex_type'}=$env{'form.latex_type'};
$posthash{'rndseed'}=$env{'form.rndseed'};
}
my $submitted=exists($env{'form.all_submit'});
if (!$submitted) {
foreach my $key (keys(%env)) {
if ($key=~/^form.\Q$prefix\Esubmit_/) {
$submitted=1;last;
}
}
}
if ($submitted) {
foreach my $key (keys(%env)) {
if ($key=~/^form.\Q$prefix\E/) {
my $name=$key;
$name=~s/^form.\Q$prefix\E//;
$posthash{$name}=$env{$key};
}
}
if (exists($env{'form.all_submit'})) {
$posthash{'all_submit'}='yes';
}
}
my $output=Apache::lonnet::ssi($src,%posthash);
$output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
if ($target eq 'tex') {
$output =~ s/^([^&]+)\\begin{document}//;
$output =~ s/\\end{document}//;
# $output = '\parbox{\minipagewidth}{ '.$output.' }';
#some additional cleanup necessary for LateX (due to limitations of table environment
$output =~ s/(\\vskip\s*\d+mm)\s*(\\\\)+/$1/g;
}
my $parser=HTML::TokeParser->new(\$output);
my $token;
my $thisdir=$src;
my $bodydef=0;
my $thisxml=0;
my @rlinks=();
if ($output=~/\?xml/) {
$isxml=1;
$thisxml=1;
$output=~
/((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\<body[^\>]*\>/si;
$xmlheader=$1;
}
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
if ($token->[1] eq 'a') {
if ($token->[2]->{'href'}) {
$rlinks[$#rlinks+1]=
$token->[2]->{'href'};
}
} elsif ($token->[1] eq 'img') {
$rlinks[$#rlinks+1]=
$token->[2]->{'src'};
} elsif ($token->[1] eq 'embed') {
$rlinks[$#rlinks+1]=
$token->[2]->{'src'};
} elsif ($token->[1] eq 'base') {
$thisdir=$token->[2]->{'href'};
} elsif ($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];
}
} elsif ($token->[1] eq 'meta') {
if ($token->[4] !~ m:/>$:) {
$allmeta.="\n".$token->[4].'</meta>';
} else {
$allmeta.="\n".$token->[4];
}
} elsif (($token->[1] eq 'script') &&
($bodydef==0)) {
$allscript.="\n\n"
.$parser->get_text('/script');
}
}
}
if ($output=~/\<body[^\>]*\>(.*)/si) {
$output=$1;
}
$output=~s/\<\/body\>.*//si;
if ($output=~/\<form/si) {
$nforms++;
$output=~s/\<form[^\>]*\>//gsi;
$output=~s/\<\/form[^\>]*\>//gsi;
$output=~
s/\<((?:input|select|button|textarea)[^\>]+)name\s*\=\s*[\'\"]*([^\'\"]+)[\'\"]*([^\>]*)\>/\<$1 name="$prefix$2" $3\>/gsi;
}
$thisdir=~s/\/[^\/]*$//;
foreach (@rlinks) {
unless (($_=~/^https?\:\/\//i) ||
($_=~/^\//) ||
($_=~/^javascript:/i) ||
($_=~/^mailto:/i) ||
($_=~/^\#/)) {
my $newlocation=
&Apache::lonnet::hreflocation($thisdir,$_);
$output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/;
}
}
# -------------------------------------------------- Deal with Applet codebases
$output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
$ssibody{$_}=$output;
# ---------------------------------------------------------------- End SSI cell
}
}
}
}
unless ($contents) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print(&Apache::loncommon::start_page(undef,undef,
{'force_register' => 1,}));
$r->print(&mt('This page is either empty or it only contains resources that are currently hidden').'. ');
$r->print('<br /><br />'.&mt('Please use the LON-CAPA navigation arrows to move to another item in the course').
&Apache::loncommon::end_page());
} else {
# ------------------------------------------------------------------ Build page
# ---------------------------------------------------------------- Send headers
unless ($target eq 'tex') {
if ($isxml) {
&Apache::loncommon::content_type($r,'text/xml');
} else {
&Apache::loncommon::content_type($r,'text/html');
}
$r->send_http_header;
# ------------------------------------------------------------------------ Head
if ($allscript) {
$allscript =
"\n".'<script type="text/javascript">'."\n".
$allscript.
"\n</script>\n";
}
# ------------------------------------------------------------------ Start body
$r->print(&Apache::loncommon::start_page(undef,$allscript,
{'force_register' => 1,
'bgcolor' => '#ffffff',}));
# ------------------------------------------------------------------ Start form
if ($nforms) {
$r->print('<form name="lonhomework" method="post" enctype="multipart/form-data" action="'.
&Apache::lonenc::check_encrypt($requrl)
.'">');
}
} elsif ($target eq 'tex') {
# I think this is not needed as the header
# will be put in for each of the page parts
# by the londefdef.pm now that we are opening up
# the parts of a page.
#$r->print('\documentclass{article}
# \newcommand{\keephidden}[1]{}
# \usepackage[dvips]{graphicx}
# \usepackage{epsfig}
# \usepackage{calc}
# \usepackage{longtable}
# \begin{document}');
}
# ----------------------------------------------------------------- Start table
if ($target eq 'tex') {
# # $r->print('\begin{longtable}INSERTTHEHEADOFLONGTABLE\endfirsthead\endhead ');
if ($number_of_columns le $lcm) {$number_of_columns=$lcm;};
} else {
$r->print('<table width="100%" cols="'.$lcm.'" border="0">');
}
# generate rows
for ($i=0;$i<=$#rows;$i++) {
if ($rows[$i]) {
unless ($target eq 'tex') {
$r->print("\n<tr>");
}
my @colcont=split(/\&/,$rows[$i]);
my $avespan=$lcm/($#colcont+1);
for ($j=0;$j<=$#colcont;$j++) {
my $rid=$colcont[$j];
my $metainfo =&get_buttons(\%hash,$rid).'<br />';
unless ($target eq 'tex') {
$r->print('<td colspan="'.$avespan.'"');
}
if ($cellemb{$rid} eq 'ssi') {
unless ($target eq 'tex') {
if ($ssibgcolor{$rid}) {
$r->print(' bgcolor="'.
$ssibgcolor{$rid}.'"');
}
$r->print('>'.$metainfo.'<font');
if ($ssitext{$rid}) {
$r->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('>');
}
$r->print($ssibody{$rid});
unless ($target eq 'tex') {
$r->print('</font>');
}
if ($env{'course.'.
$env{'request.course.id'}.
'.pageseparators'} eq 'yes') {
unless($target eq 'tex') {
$r->print('<hr />');
}
}
} elsif ($cellemb{$rid} eq 'img') {
$r->print('>'.$metainfo.'<img src="'.
$hash{'src_'.$rid}.'" />');
} elsif ($cellemb{$rid} eq 'emb') {
$r->print('>'.$metainfo.'<embed src="'.
$hash{'src_'.$rid}.'"></embed>');
} elsif (&Apache::lonnet::declutter($hash{'src_'.$rid}) !~/\.(sequence|page)$/) {
$r->print($metainfo.'<b>'.$hash{'title_'.$rid}.'</b><br />'.
&mt('It is recommended that you use an up-to-date virus scanner before handling this file.').'</p><p><table>'.
&Apache::londocs::entryline(0,&mt("Click to download or use your browser's Save Link function"),'/'.&Apache::lonnet::declutter($hash{'src_'.$rid})).'</table></p><br />');
}
unless ($target eq 'tex') {
$r->print('</td>');
} else {
# for (my $incol=1;$incol<=$avespan;$incol++) {
# $r->print(' & ');
# }
}
}
unless ($target eq 'tex') {
$r->print('</tr>');
} else {
# $r->print('REMOVETHEHEADOFLONGTABLE\\\\');
}
}
}
unless ($target eq 'tex') {
$r->print("\n</table>");
} else {
# $r->print('\end{longtable}\strut');
}
# ---------------------------------------------------------------- Submit, etc.
if ($nforms) {
$r->print(
'<input name="all_submit" value="Submit All" type="'.
(($nforms>1)?'submit':'hidden').'"></input></form>');
}
unless ($target eq 'tex') {
$r->print(&Apache::loncommon::end_page({'discussion'
=> 1,}));
} else {
$r->print('\end{document}'.$number_of_columns);
}
&Apache::lonnet::symblist($requrl,%symbhash);
my ($map,$id,$url)=&Apache::lonnet::decode_symb(&Apache::lonnet::symbread());
&Apache::lonnet::symblist($map,'last_known'=>[$url,$id]);
# -------------------------------------------------------------------- End page
}
# ------------------------------------------------------------- End render page
} else {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::lonsequence::viewmap($r,$requrl);
}
# ------------------------------------------------------------------ Untie hash
unless (untie(%hash)) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie coursemap $fn (browse).</font>");
}
# -------------------------------------------------------------------- All done
return OK;
# ----------------------------------------------- Errors, hash could no be tied
}
}
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::lonsequence::viewmap($r,$requrl);
return OK;
}
sub get_buttons {
my ($hash,$rid) = @_;
# which icons do we use?
my $extension='png';
if ($env{'environment.icons'} eq 'classic') { $extension='gif'; }
my $metainfo = '';
my $esrc=&Apache::lonnet::declutter($hash->{'src_'.$rid});
my ($mapid,$resid)=split(/\./,$rid);
my $symb=&Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},
$resid,
$hash->{'src_'.$rid});
if ($hash->{'encrypted_'.$rid}) {
$symb=&Apache::lonenc::encrypted($symb);
$esrc=&Apache::lonenc::encrypted($esrc);
}
if ($hash->{'src_'.$rid} !~ m-^/uploaded/-
&& !$env{'request.enc'}
&& ($env{'request.role.adv'}
|| !$hash->{'encrypted_'.$rid})) {
$metainfo .='<a name="'.&escape($symb).'" />'.
'<a href="'.$hash->{'src_'.$rid}.'.meta'.'" target="LONcatInfo">'.
'<img src="/adm/lonMisc/cat_button.'.$extension.'" class="LC_icon" />'.
'</a>';
}
$metainfo .= '<a href="/adm/evaluate?postdata='.
&escape($esrc).
'" target="LONcatInfo">'.
'<img src="/adm/lonMisc/eval_button.'.$extension.'" class="LC_icon" />'.
'</a>';
if (($hash->{'src_'.$rid}=~/\.(problem|exam|quiz|assess|survey|form)$/) &&
($hash->{'src_'.$rid} !~ m-^/uploaded/-)) {
if (&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) {
$metainfo.=
'<a href="/adm/grades?symb='.&escape($symb).
# '&command=submission" target="LONcatInfo">'.
'&command=submission">'.
'<img src="/adm/lonMisc/subm_button.'.$extension.'" class="LC_icon" />'.
'</a>'.
'<a href="/adm/grades?symb='.&escape($symb).
# '&command=gradingmenu" target="LONcatInfo">'.
'&command=gradingmenu">'.
'<img src="/adm/lonMisc/pgrd_button.'.$extension.'" class="LC_icon" />'.
'</a>';
}
if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
$metainfo.=
'<a href="/adm/parmset?symb='.&escape($symb).
# '" target="LONcatInfo">'.
'" >'.
'<img src="/adm/lonMisc/pprm_button.'.$extension.'" class="LC_icon" />'.
'</a>';
}
}
return $metainfo;
}
1;
__END__
=head1 NAME
Apache::lonpage - Page Handler
=head1 SYNOPSIS
Invoked by /etc/httpd/conf/srm.conf:
<LocationMatch "^/res/.*\.page$>
SetHandler perl-script
PerlHandler Apache::lonpage
</LocationMatch>
=head1 INTRODUCTION
This module renders a .page resource.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
=head1 HANDLER SUBROUTINE
This routine is called by Apache and mod_perl.
=over 4
=item *
set document type for header only
=item *
tie db file
=item *
render page
=item *
add to symb list
=item *
page parms
=item *
Get SSI output, post parameters
=item *
SSI cell rendering
=item *
Deal with Applet codebases
=item *
Build page
=item *
send headers
=item *
start body
=item *
start form
=item *
start table
=item *
submit element, etc, render page, untie hash
=back
=head1 OTHER SUBROUTINES
=over 4
=item *
euclid() : Euclid's method for determining the greatest common denominator.
=item *
tracetable() : Build page table.
=back
=cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpage.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / rat