loncom/xml/lonxml.pm - diff

Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.116 and 1.160

version 1.116, 2001/08/16 11:25:03	version 1.160, 2002/03/21 22:10:31
Line 1	Line 1
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# XML Parser Module	# XML Parser Module
#	#
	# $Id$
	#
	# 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/
	#
	# Copyright for TtHfunc and TtMfunc by Ian Hutchinson.
	# TtHfunc and TtMfunc (the "Code") may be compiled and linked into
	# binary executable programs or libraries distributed by the
	# Michigan State University (the "Licensee"), but any binaries so
	# distributed are hereby licensed only for use in the context
	# of a program or computational system for which the Licensee is the
	# primary author or distributor, and which performs substantial
	# additional tasks beyond the translation of (La)TeX into HTML.
	# The C source of the Code may not be distributed by the Licensee
	# to any other parties under any circumstances.
	#
# last modified 06/26/00 by Alexander Sakharuk	# last modified 06/26/00 by Alexander Sakharuk
# 11/6 Gerd Kortemeyer	# 11/6 Gerd Kortemeyer
# 6/1/1 Gerd Kortemeyer	# 6/1/1 Gerd Kortemeyer
Line 13	Line 48
# 6/12,6/13 H. K. Ng	# 6/12,6/13 H. K. Ng
# 6/16 Gerd Kortemeyer	# 6/16 Gerd Kortemeyer
# 7/27 H. K. Ng	# 7/27 H. K. Ng
# 8/7,8/9,8/10,8/11,8/15,8/16 Gerd Kortemeyer	# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
	# Guy Albertelli
	# 9/26 Gerd Kortemeyer
	# Dec Guy Albertelli
	# YEAR=2002
	# 1/1 Gerd Kortemeyer
	# 1/2 Matthew Hall
	# 1/3 Gerd Kortemeyer
	#

package Apache::lonxml;	package Apache::lonxml;
use vars	use vars
Line 21 qw(@pwd @outputstack $redirection $impor	Line 64 qw(@pwd @outputstack $redirection $impor
use strict;	use strict;
use HTML::TokeParser;	use HTML::TokeParser;
use HTML::TreeBuilder;	use HTML::TreeBuilder;
	use HTML::Entities;
use Safe;	use Safe;
use Safe::Hole;	use Safe::Hole;
use Math::Cephes qw(:trigs :hypers :bessels erf erfc);	use Math::Cephes qw(:trigs :hypers :bessels erf erfc);
Line 28 use Math::Random qw(:all);	Line 72 use Math::Random qw(:all);
use Opcode;	use Opcode;

sub register {	sub register {
my $space;	my ($space,@taglist) = @_;
my @taglist;	foreach my $temptag (@taglist) {
my $temptag;	push(@{ $Apache::lonxml::alltags{$temptag} },$space);
($space,@taglist) = @_;	}
foreach $temptag (@taglist) {	}
$Apache::lonxml::alltags{$temptag}=$space;
	sub deregister {
	my ($space,@taglist) = @_;
	foreach my $temptag (@taglist) {
	my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
	if ($tempspace eq $space) {
	pop(@{ $Apache::lonxml::alltags{$temptag} });
	}
}	}
	#&printalltags();
}	}

use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
Line 46 use Apache::scripttag;	Line 98 use Apache::scripttag;
use Apache::edit;	use Apache::edit;
use Apache::lonnet;	use Apache::lonnet;
use Apache::File;	use Apache::File;
	use Apache::loncommon;

#================================================== Main subroutine: xmlparse	#================================================== Main subroutine: xmlparse
#debugging control, to turn on debugging modify the correct handler	#debugging control, to turn on debugging modify the correct handler
Line 152 sub xmlend {	Line 205 sub xmlend {
return $discussion.'</html>';	return $discussion.'</html>';
}	}

	sub tokeninputfield {
	my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
	$defhost=~tr/a-z/A-Z/;
	return (<<ENDINPUTFIELD)
	<script>
	function updatetoken() {
	var comp=new Array;
	var barcode=unescape(document.tokeninput.barcode.value);
	comp=barcode.split('*');
	if (typeof(comp[0])!="undefined") {
	document.tokeninput.codeone.value=comp[0];
	}
	if (typeof(comp[1])!="undefined") {
	document.tokeninput.codetwo.value=comp[1];
	}
	if (typeof(comp[2])!="undefined") {
	comp[2]=comp[2].toUpperCase();
	document.tokeninput.codethree.value=comp[2];
	}
	document.tokeninput.barcode.value='';
	}
	</script>
	<form method="post" name="tokeninput">
	<table border="2" bgcolor="#FFFFBB">
	<tr><th>DocID Checkin</th></tr>
	<tr><td>
	<table>
	<tr>
	<td>Scan in Barcode</td>
	<td><input type="text" size="22" name="barcode"
	onChange="updatetoken()"/></td>
	</tr>
	<tr><td><i>or</i> Type in DocID</td>
	<td>
	<input type="text" size="5" name="codeone" />
	<b><font size="+2">*</font></b>
	<input type="text" size="5" name="codetwo" />
	<b><font size="+2">*</font></b>
	<input type="text" size="10" name="codethree" value="$defhost"
	onChange="this.value=this.value.toUpperCase()" />
	</td></tr>
	</table>
	</td></tr>
	<tr><td><input type="submit" value="Check in DocID" /></td></tr>
	</table>
	</form>
	ENDINPUTFIELD
	}

sub maketoken {	sub maketoken {
my ($target,$symb,$tuname,$tudom,$tcrsid)=@_;	my ($symb,$tuname,$tudom,$tcrsid)=@_;
unless ($symb) {	unless ($symb) {
$symb=&Apache::lonnet::symbread();	$symb=&Apache::lonnet::symbread();
}	}
Line 163 sub maketoken {	Line 265 sub maketoken {
$tcrsid=$ENV{'request.course.id'};	$tcrsid=$ENV{'request.course.id'};
}	}

my $token=&Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);	return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
	}

	sub printtokenheader {
	my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
unless ($token) { return ''; }	unless ($token) { return ''; }

	my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
	unless ($tsymb) {
	$tsymb=$symb;
	}
	unless ($tuname) {
	$tuname=$name;
	$tudom=$domain;
	$tcrsid=$courseid;
	}

my %reply=&Apache::lonnet::get('environment',	my %reply=&Apache::lonnet::get('environment',
['firstname','middlename','lastname','generation'],	['firstname','middlename','lastname','generation'],
$tudom,$tuname);	$tudom,$tuname);
Line 176 sub maketoken {	Line 291 sub maketoken {
$reply{'generation'};	$reply{'generation'};

if ($target eq 'web') {	if ($target eq 'web') {
	my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
return	return
'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.	'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.
'Checked out for '.$plainname.	'Checked out for '.$plainname.
'<br />User: '.$tuname.' at '.$tudom.	'<br />User: '.$tuname.' at '.$tudom.
'<br />CourseID: '.$tcrsid.')'.	'<br />ID: '.$idhash{$tuname}.
	'<br />CourseID: '.$tcrsid.
	'<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.
'<br />DocID: '.$token.	'<br />DocID: '.$token.
'<br />Time: '.localtime().'<hr />';	'<br />Time: '.localtime().'<hr />';
} else {	} else {
return $token;	return $token;
}	}
}	}

Line 199 sub fontsettings() {	Line 317 sub fontsettings() {

sub registerurl {	sub registerurl {
my $forcereg=shift;	my $forcereg=shift;
if ($Apache::lonxml::registered) { return ''; }	my $target = shift;
	my $result = '';
	if (($ENV{'request.publicaccess'}) \|\|
	($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html')) {
	return
	'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
	}
	if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;	$Apache::lonxml::registered=1;
	my $nothing='';
	if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {	if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {
my $hwkadd='';	my $hwkadd='';
if ($ENV{'REQUEST_URI'}=~/\.(problem\|exam\|quiz\|assess\|survey\|form)$/) {	if ($ENV{'REQUEST_URI'}=~/\.(problem\|exam\|quiz\|assess\|survey\|form)$/) {
Line 226 ENDGRDS	Line 353 ENDGRDS
ENDPARM	ENDPARM
}	}
}	}
return (<<ENDREGTHIS);	$result = (<<ENDREGTHIS);

<script language="JavaScript">	<script language="JavaScript">
// BEGIN LON-CAPA Internal	// BEGIN LON-CAPA Internal

function LONCAPAreg() {	function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
menu.clearTimeout(menu.menucltim);	menu.clearTimeout(menu.menucltim);
menu.currentURL=window.location.pathname;	menu.currentURL=window.location.pathname;
menu.currentStale=0;	menu.currentStale=0;
Line 259 ENDPARM	Line 386 ENDPARM
}	}

function LONCAPAstale() {	function LONCAPAstale() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
menu.currentStale=1;	menu.currentStale=1;
menu.switchbutton	menu.switchbutton
(3,1,'reload.gif','return','location','go(currentURL)');	(3,1,'reload.gif','return','location','go(currentURL)');
menu.clearbut(7,1);	menu.clearbut(7,1);
menu.clearbut(7,2);	menu.clearbut(7,2);
menu.clearbut(7,3);	menu.clearbut(7,3);
Line 278 ENDPARM	Line 405 ENDPARM
ENDREGTHIS	ENDREGTHIS

} else {	} else {
return (<<ENDDONOTREGTHIS);	$result = (<<ENDDONOTREGTHIS);

<script language="JavaScript">	<script language="JavaScript">
// BEGIN LON-CAPA Internal	// BEGIN LON-CAPA Internal

function LONCAPAreg() {	function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
menu.currentStale=1;	menu.currentStale=1;
menu.clearbut(2,1);	menu.clearbut(2,1);
menu.clearbut(2,3);	menu.clearbut(2,3);
Line 305 ENDREGTHIS	Line 432 ENDREGTHIS
// END LON-CAPA Internal	// END LON-CAPA Internal
</script>	</script>
ENDDONOTREGTHIS	ENDDONOTREGTHIS

}	}
	if ($target eq 'edit') {
	# Javascript routines for construction space:
	# openbrowser and opensearcher will start the file browser
	# (lonindexer) and searcher (lonsearchcat) respectively.
	# Inputs are the name of the html form being used
	# and the name of the element the selected URL should
	# be placed in.
	$result .=<<"ENDBROWSERSCRIPT";
	<script>
	var editbrowser;
	function openbrowser(formname,elementname) {
	var url = '/res/?';
	if (editbrowser == null) {
	url += 'launch=1&';
	}
	url += 'catalogmode=interactive&';
	url += 'mode=edit&';
	url += 'form=' + formname + '&';
	url += 'element=' + elementname + '';
	var title = 'Browser';
	var options = 'scrollbars=1,resizable=1,menubar=0';
	options += ',width=700,height=600';
	editbrowser = open(url,title,options,'1');
	editbrowser.focus();
	}
	var editsearcher;
	function opensearcher(formname,elementname) {
	var url = '/adm/searchcat?';
	if (editsearcher == null) {
	url += 'launch=1&';
	}
	url += 'catalogmode=interactive&';
	url += 'mode=edit&';
	url += 'form=' + formname + '&';
	url += 'element=' + elementname + '';
	var title = 'Search';
	var options = 'scrollbars=1,resizable=1,menubar=0';
	options += ',width=700,height=600';
	editsearcher = open(url,title,options,'1');
	editsearcher.focus();
	}
	</script>
	ENDBROWSERSCRIPT
	}
	return $result;
}	}

sub loadevents() {	sub loadevents() {
Line 320 sub unloadevents() {	Line 491 sub unloadevents() {
sub printalltags {	sub printalltags {
my $temp;	my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {	foreach $temp (sort keys %Apache::lonxml::alltags) {
&Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");	&Apache::lonxml::debug("$temp -- ".
	join(',',@{ $Apache::lonxml::alltags{$temp} }));
}	}
}	}

Line 341 sub xmlparse {	Line 513 sub xmlparse {

($target, my @tenta) = split('&&',$target);	($target, my @tenta) = split('&&',$target);

my @stack = ();	my @stack = ();
my @parstack = ();	my @parstack = ();
&initdepth;	&initdepth;

my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,	my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
$safeeval,\%style_for_target);	$safeeval,\%style_for_target);
	if ($ENV{'request.uri'}) {
	&writeallows($ENV{'request.uri'});
	}
return $finaloutput;	return $finaloutput;
}	}

Line 356 sub htmlclean {	Line 530 sub htmlclean {

my $tree = HTML::TreeBuilder->new;	my $tree = HTML::TreeBuilder->new;
$tree->ignore_unknown(0);	$tree->ignore_unknown(0);

$tree->parse($raw);	$tree->parse($raw);

my $output= $tree->as_HTML(undef,' ');	my $output= $tree->as_HTML(undef,' ');

$output=~s/\<(br\|hr\|img\|meta\|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;	$output=~s/\<(br\|hr\|img\|meta\|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;	$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;
unless ($full) {	unless ($full) {
Line 374 sub htmlclean {	Line 548 sub htmlclean {

sub inner_xmlparse {	sub inner_xmlparse {
my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;	my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
&Apache::lonxml::debug('Reentrant parser starting, again?');
my $finaloutput = '';	my $finaloutput = '';
my $result;	my $result;
my $token;	my $token;
Line 389 sub inner_xmlparse {	Line 562 sub inner_xmlparse {
$result=$token->[2];	$result=$token->[2];
}	}
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
# add tag to stack	# add tag to stack
push (@$stack,$token->[1]);	push (@$stack,$token->[1]);
# add parameters list to another stack	# add parameters list to another stack
push (@$parstack,&parstring($token));	push (@$parstack,&parstring($token));
&increasedepth($token);	&increasedepth($token);
if (exists $$style_for_target{$token->[1]}) {	if (exists $$style_for_target{$token->[1]}) {
if ($Apache::lonxml::redirection) {	if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=	$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{$token->[1]},$target,$safeeval,	&recurse($$style_for_target{$token->[1]},$target,$safeeval,
$style_for_target,@$parstack);	$style_for_target,@$parstack);
} else {	} else {
Line 406 sub inner_xmlparse {	Line 579 sub inner_xmlparse {
} else {	} else {
$result = &callsub("start_$token->[1]", $target, $token, $stack,	$result = &callsub("start_$token->[1]", $target, $token, $stack,
$parstack, $pars, $safeeval, $style_for_target);	$parstack, $pars, $safeeval, $style_for_target);
}	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {	while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
&Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']");	my $lasttag=$$stack[-1];
&end_tag($stack,$parstack,$token);	if ($token->[1] =~ /^$lasttag$/i) {
	&Apache::lonxml::warning('Using tag </'.$token->[1].'> as end tag to <'.$$stack[-1].'>');
	last;
	} else {
	&Apache::lonxml::warning('Found tag </'.$token->[1].'> when looking for </'.$$stack[-1].'> in file');
	&end_tag($stack,$parstack,$token);
	}
}	}

if (exists $$style_for_target{'/'."$token->[1]"}) {	if (exists($$style_for_target{'/'."$token->[1]"})) {
if ($Apache::lonxml::redirection) {	if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=	$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{'/'."$token->[1]"},	&recurse($$style_for_target{'/'."$token->[1]"},
Line 424 sub inner_xmlparse {	Line 603 sub inner_xmlparse {
$target,$safeeval,$style_for_target,	$target,$safeeval,$style_for_target,
@$parstack);	@$parstack);
}	}

} else {	} else {
$result = &callsub("end_$token->[1]", $target, $token, $stack,	$result = &callsub("end_$token->[1]", $target, $token, $stack,
$parstack, $pars,$safeeval, $style_for_target);	$parstack, $pars,$safeeval, $style_for_target);
Line 475 sub recurse {	Line 653 sub recurse {
my $partstring = '';	my $partstring = '';
my $output='';	my $output='';
my $decls='';	my $decls='';
	&Apache::lonxml::debug("Recursing");
while ( $#pat > -1 ) {	while ( $#pat > -1 ) {
while ($tokenpat = $pat[$#pat]->get_token) {	while ($tokenpat = $pat[$#pat]->get_token) {
if (($tokenpat->[0] eq 'T') \|\| ($tokenpat->[0] eq 'C') \|\| ($tokenpat->[0] eq 'D') ) {	if (($tokenpat->[0] eq 'T') \|\| ($tokenpat->[0] eq 'C') \|\| ($tokenpat->[0] eq 'D') ) {
Line 490 sub recurse {	Line 669 sub recurse {
$safeeval, $style_for_target);	$safeeval, $style_for_target);
} elsif ($tokenpat->[0] eq 'E') {	} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]	while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > -1)) {	&& ($#innerstack > -1)) {
&Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");	my $lasttag=$innerstack[-1];
&end_tag(\@innerstack,\@innerparstack,$tokenpat);	if ($tokenpat->[1] =~ /^$lasttag$/i) {
	&Apache::lonxml::warning('Using tag </'.$tokenpat->[1].'> as end tag to <'.$innerstack[-1].'>');
	last;
	} else {
	&Apache::lonxml::warning('Found tag </'.$tokenpat->[1].'> when looking for </'.$innerstack[-1].'> in file');
	&end_tag(\@innerstack,\@innerparstack,$tokenpat);
	}
}	}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,	$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,	\@innerstack, \@innerparstack, \@pat,
Line 526 sub recurse {	Line 711 sub recurse {
pop @pat;	pop @pat;
pop @Apache::lonxml::pwd;	pop @Apache::lonxml::pwd;
}	}
	&Apache::lonxml::debug("Exiting Recursing");
return $output;	return $output;
}	}

Line 537 sub callsub {	Line 723 sub callsub {
my $sub1;	my $sub1;
no strict 'refs';	no strict 'refs';
my $tag=$token->[1];	my $tag=$token->[1];
my $space=$Apache::lonxml::alltags{$tag};	my $space=$Apache::lonxml::alltags{$tag}[-1];
if (!$space) {	if (!$space) {
$tag=~tr/A-Z/a-z/;	$tag=~tr/A-Z/a-z/;
$sub=~tr/A-Z/a-z/;	$sub=~tr/A-Z/a-z/;
$space=$Apache::lonxml::alltags{$tag}	$space=$Apache::lonxml::alltags{$tag}[-1]
}	}

my $deleted=0;	my $deleted=0;
Line 553 sub callsub {	Line 739 sub callsub {
}	}
if (!$deleted) {	if (!$deleted) {
if ($space) {	if ($space) {
#&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
$sub1="$space\:\:$sub";	$sub1="$space\:\:$sub";
($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,	($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
$style);	$style);
} else {	} else {
#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");	#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {	if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {	if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];	$currentstring = $token->[4];
Line 596 sub setup_globals {	Line 782 sub setup_globals {
my ($target)=@_;	my ($target)=@_;
$Apache::lonxml::registered = 0;	$Apache::lonxml::registered = 0;
@Apache::lonxml::pwd=();	@Apache::lonxml::pwd=();
	@Apache::lonxml::extlinks=();
if ($target eq 'meta') {	if ($target eq 'meta') {
$Apache::lonxml::redirection = 0;	$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;	$Apache::lonxml::metamode = 1;
$Apache::lonxml::evaluate = 1;	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 0;	$Apache::lonxml::import = 0;
	} elsif ($target eq 'answer') {
	$Apache::lonxml::redirection = 0;
	$Apache::lonxml::metamode = 1;
	$Apache::lonxml::evaluate = 1;
	$Apache::lonxml::import = 1;
} elsif ($target eq 'grade') {	} elsif ($target eq 'grade') {
&startredirection;	&startredirection;
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
Line 677 sub init_safespace {	Line 869 sub init_safespace {
#need to inspect this class of ops	#need to inspect this class of ops
# $safeeval->deny(":base_orig");	# $safeeval->deny(":base_orig");
$safeinit .= ';$external::target="'.$target.'";';	$safeinit .= ';$external::target="'.$target.'";';
$safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';	my $rndseed;
	my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
	$rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
	$safeinit .= ';$external::randomseed='.$rndseed.';';
&Apache::run::run($safeinit,$safeeval);	&Apache::run::run($safeinit,$safeeval);
}	}

Line 728 sub decreasedepth {	Line 923 sub decreasedepth {
$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;	$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
}	}
if ( $Apache::lonxml::depth < -1) {	if ( $Apache::lonxml::depth < -1) {
&Apache::lonxml::warning("Unbalanced tags in resource");	&Apache::lonxml::warning("Missing tags, unable to properly run file.");
$Apache::lonxml::depth='-1';	$Apache::lonxml::depth='-1';
}	}
my $curdepth=join('_',@Apache::lonxml::depthcounter);	my $curdepth=join('_',@Apache::lonxml::depthcounter);
Line 752 sub get_all_text {	Line 947 sub get_all_text {
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ($token->[1] eq $tag) { $depth++; }	if ($token->[1] =~ /^$tag$/i) { $depth++; }
$result.=$token->[4];	$result.=$token->[4];
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ( $token->[1] eq $tag) { $depth--; }	if ( $token->[1] =~ /^$tag$/i) { $depth--; }
#skip sending back the last end tag	#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; } else {	if ($depth > -1) { $result.=$token->[2]; } else {
$pars->unget_token($token);	$pars->unget_token($token);
Line 770 sub get_all_text {	Line 965 sub get_all_text {
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ( $token->[1] eq $tag) {	if ( $token->[1] =~ /^$tag$/i) {
$pars->unget_token($token); last;	$pars->unget_token($token); last;
} else {	} else {
$result.=$token->[4];	$result.=$token->[4];
Line 800 sub newparser {	Line 995 sub newparser {
sub parstring {	sub parstring {
my ($token) = @_;	my ($token) = @_;
my $temp='';	my $temp='';
map {	foreach (@{$token->[3]}) {
unless ($_=~/\W/) {	unless ($_=~/\W/) {
my $val=$token->[2]->{$_};	my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\])/\\$1/g;	$val =~ s/([\%\@\\\"])/\\$1/g;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"	$temp .= "my \$$_=\"$val\";"
}	}
} @{$token->[3]};	}
return $temp;	return $temp;
}	}

sub writeallows {	sub writeallows {
	unless ($#extlinks>=0) { return; }
my $thisurl='/res/'.&Apache::lonnet::declutter(shift);	my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
if ($ENV{'httpref.'.$thisurl}) {	if ($ENV{'httpref.'.$thisurl}) {
$thisurl=$ENV{'httpref.'.$thisurl};	$thisurl=$ENV{'httpref.'.$thisurl};
Line 819 sub writeallows {	Line 1015 sub writeallows {
my $thisdir=$thisurl;	my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;	$thisdir=~s/\/[^\/]+$//;
my %httpref=();	my %httpref=();
map {	foreach (@extlinks) {
$httpref{'httpref.'.	$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;	&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
	}
	@extlinks=();
&Apache::lonnet::appenv(%httpref);	&Apache::lonnet::appenv(%httpref);
}	}

Line 830 sub writeallows {	Line 1028 sub writeallows {
#	#
sub afterburn {	sub afterburn {
my $result=shift;	my $result=shift;
map {	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
my ($name, $value) = split(/=/,$_);	['highlight','anchor','link']);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if (($name eq 'highlight')\|\|($name eq 'anchor')\|\|($name eq 'link')) {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
}
} (split(/&/,$ENV{'QUERY_STRING'}));
if ($ENV{'form.highlight'}) {	if ($ENV{'form.highlight'}) {
map {	foreach (split(/\,/,$ENV{'form.highlight'})) {
my $anchorname=$_;	my $anchorname=$_;
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;	$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
} split(/\,/,$ENV{'form.highlight'});	}
}	}
if ($ENV{'form.link'}) {	if ($ENV{'form.link'}) {
map {	foreach (split(/\,/,$ENV{'form.link'})) {
my ($anchorname,$linkurl)=split(/\>/,$_);	my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;	$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
} split(/\,/,$ENV{'form.link'});	}
}	}
if ($ENV{'form.anchor'}) {	if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};	my $anchorname=$ENV{'form.anchor'};
Line 875 sub storefile {	Line 1065 sub storefile {
if (my $fh=Apache::File->new('>'.$file)) {	if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;	print $fh $contents;
$fh->close();	$fh->close();
	} else {
	&warning("Unable to save file $file");
}	}
}	}

sub inserteditinfo {	sub createnewhtml {
my ($result,$filecontents)=@_;	my $filecontents=(<<SIMPLECONTENT);
unless ($filecontents) {
$filecontents=(<<SIMPLECONTENT);
<html>	<html>
<head>	<head>
<title>	<title>
Line 895 sub inserteditinfo {	Line 1085 sub inserteditinfo {
</body>	</body>
</html>	</html>
SIMPLECONTENT	SIMPLECONTENT
}	return $filecontents;
my $editheader='<a href="#editsection">Edit below</a><hr />';	}


	sub inserteditinfo {
	my ($result,$filecontents)=@_;
	$filecontents = &HTML::Entities::encode($filecontents);
	# my $editheader='<a href="#editsection">Edit below</a><hr />';
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post">	<form method="post">
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>	<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
<br />	<br />
	<input type="hidden" name="showmode" value="Edit" />
<input type="submit" name="attemptclean"	<input type="submit" name="attemptclean"
value="Save and then attempt to clean HTML" />	value="Save and then attempt to clean HTML" />
<input type="submit" name="savethisfile" value="Save this" />	<input type="submit" name="savethisfile" value="Save this" />
	<input type="submit" name="showmode" value="View" />
</form>	</form>
ENDFOOTER	ENDFOOTER
$result=~s/(\<body[^\>]*\>)/$1$editheader/is;	# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;	$result=~s/(\<\/body\>)/$editfooter/is;
return $result;	return $result;
}	}

	sub get_target {
	my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
	if ( $ENV{'request.state'} eq 'published') {
	if ( defined($ENV{'form.grade_target'})
	&& ($viewgrades == 'F' )) {
	return ($ENV{'form.grade_target'});
	} elsif (defined($ENV{'form.grade_target'})) {
	if (($ENV{'form.grade_target'} eq 'web') \|\|
	($ENV{'form.grade_target'} eq 'tex') ) {
	return $ENV{'form.grade_target'}
	} else {
	return 'web';
	}
	} else {
	return 'web';
	}
	} elsif ($ENV{'request.state'} eq 'construct') {
	if ( defined($ENV{'form.grade_target'})) {
	return ($ENV{'form.grade_target'});
	} else {
	return 'web';
	}
	} else {
	return 'web';
	}
	}

sub handler {	sub handler {
my $request=shift;	my $request=shift;

my $target='web';	my $target=&get_target();

$Apache::lonxml::debug=0;	$Apache::lonxml::debug=0;

Line 925 sub handler {	Line 1150 sub handler {
} else {	} else {
$request->content_type('text/html');	$request->content_type('text/html');
}	}
	&Apache::loncommon::no_cache($request);
$request->send_http_header;	$request->send_http_header;

return OK if $request->header_only;	return OK if $request->header_only;


Line 941 sub handler {	Line 1166 sub handler {
}	}
}	}
my %mystyle;	my %mystyle;
my $result = '';	my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);	my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents == -1) {	if ($filecontents == -1) {
$result=(<<ENDNOTFOUND);	$result=(<<ENDNOTFOUND);
Line 955 sub handler {	Line 1180 sub handler {
</html>	</html>
ENDNOTFOUND	ENDNOTFOUND
$filecontents='';	$filecontents='';
	if ($ENV{'request.state'} ne 'published') {
	$filecontents=&createnewhtml();
	$ENV{'form.showmode'}='Edit'; #force edit mode
	}
} else {	} else {
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
if ($ENV{'form.attemptclean'}) {	if ($ENV{'form.attemptclean'}) {
$filecontents=&htmlclean($filecontents,1);	$filecontents=&htmlclean($filecontents,1);
}
}	}
$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);	}
	if ($ENV{'form.showmode'} ne 'Edit') {
	$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
	}
}	}

#	#
# Edit action? Insert editing commands	# Edit action? Insert editing commands
#	#
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
	if ($ENV{'form.showmode'} eq 'Edit') {
	$result='<html><body bgcolor="#FFFFFF"></body></html>';
$result=&inserteditinfo($result,$filecontents);	$result=&inserteditinfo($result,$filecontents);
	}
}	}

	writeallows($request->uri);

$request->print($result);	$request->print($result);

writeallows($request->uri);
return OK;	return OK;
}	}

sub debug {	sub debug {
if ($Apache::lonxml::debug eq 1) {	if ($Apache::lonxml::debug eq 1) {
print("DEBUG:".$_[0]."<br />\n");	$\|=1;
	print("DEBUG:".join('<br />',@_)."<br />\n");
}	}
}	}

sub error {	sub error {
if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {	if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {
print "<b>ERROR:</b>".$_[0]."<br />\n";	print "<b>ERROR:</b>".join('<br />',@_)."<br />\n";
} else {	} else {
print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";	print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
#notify author	#notify author
&Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);	&Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
#notify course	#notify course
if ( $ENV{'request.course.id'} ) {	if ( $ENV{'request.course.id'} ) {
my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};	my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
	my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
foreach my $user (split /\,/, $users) {	foreach my $user (split /\,/, $users) {
($user,my $domain) = split /:/, $user;	($user,my $domain) = split /:/, $user;
&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);	&Apache::lonmsg::user_normal_msg($user,$domain,
	"Error [$declutter]",join('<br />',@_));
}	}
}	}

#FIXME probably shouldn't have me get everything forever.	#FIXME probably shouldn't have me get everything forever.
&Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);	&Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);	#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
}	}
}	}

sub warning {	sub warning {
if ($ENV{'request.state'} eq 'construct') {	if ($ENV{'request.state'} eq 'construct') {
print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";	print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
}	}
}	}

Line 1016 sub get_param {	Line 1254 sub get_param {
if ( ! $context ) { $context = -1; }	if ( ! $context ) { $context = -1; }
my $args ='';	my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }	if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'	if ( ! $args ) { return undef; }
	if ( $args =~ /my \$$param=\"/ ) {
	return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
	} else {
	return undef;
	}
	}

	sub get_param_var {
	my ($param,$parstack,$safeeval,$context) = @_;
	if ( ! $context ) { $context = -1; }
	my $args ='';
	if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
	if ( $args !~ /my \$$param=\"/ ) { return undef; }
	my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
	if ($value =~ /^[\$\@\%]/) {
	return &Apache::run::run("return $value",$safeeval,1);
	} else {
	return $value;
	}
}	}

sub register_insert {	sub register_insert {
Line 1029 sub register_insert {	Line 1286 sub register_insert {
if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }	if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }
if ( $line =~ /TABLE/ ) { last; }	if ( $line =~ /TABLE/ ) { last; }
my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);	my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
$insertlist{"$tagnum.tag"} = $tag;	if ($tag) {
$insertlist{"$tagnum.description"} = $descrip;	$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.color"} = $color;	$insertlist{"$tagnum.description"} = $descrip;
$insertlist{"$tagnum.function"} = $function;	$insertlist{"$tagnum.color"} = $color;
$insertlist{"$tagnum.show"}= $show;	$insertlist{"$tagnum.function"} = $function;
$insertlist{"$tag.num"}=$tagnum;	if (!defined($show)) { $show='yes'; }
$tagnum++;	$insertlist{"$tagnum.show"}= $show;
	$insertlist{"$tag.num"}=$tagnum;
	$tagnum++;
	}
}	}
$i++; #skipping TABLE line	$i++; #skipping TABLE line
$tagnum = 0;	$tagnum = 0;
Line 1043 sub register_insert {	Line 1303 sub register_insert {
my $line = $data[$i];	my $line = $data[$i];
my ($mnemonic,@which) = split(/ +/,$line);	my ($mnemonic,@which) = split(/ +/,$line);
my $tag = $insertlist{"$tagnum.tag"};	my $tag = $insertlist{"$tagnum.tag"};
for (my $j=0;$j <$#which;$j++) {	for (my $j=0;$j <=$#which;$j++) {
if ( $which[$j] eq 'Y' ) {	if ( $which[$j] eq 'Y' ) {
if ($insertlist{"$j.show"} ne 'no') {	if ($insertlist{"$j.show"} ne 'no') {
push(@{ $insertlist{"$tag.which"} },$j);	push(@{ $insertlist{"$tag.which"} },$j);
Line 1056 sub register_insert {	Line 1316 sub register_insert {

sub description {	sub description {
my ($token)=@_;	my ($token)=@_;
return $insertlist{$insertlist{"$token->[1].num"}.'.description'};	my $tagnum;
	my $tag=$token->[1];
	foreach my $namespace (reverse @Apache::lonxml::namespace) {
	my $testtag=$namespace.'::'.$tag;
	$tagnum=$insertlist{"$testtag.num"};
	if (defined($tagnum)) { last; }
	}
	if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
	return $insertlist{$tagnum.'.description'};
	}

	# ----------------------------------------------------------------- whichuser
	# returns a list of $symb, $courseid, $domain, $name that is correct for
	# calls to lonnet functions for this setup.
	# - looks for form.grade_ parameters
	sub whichuser {
	my ($symb,$courseid,$domain,$name);
	if (defined($ENV{'form.grade_symb'})) {
	my $tmp_courseid=$ENV{'form.grade_courseid'};
	my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);
	if ($allowed) {
	$symb=$ENV{'form.grade_symb'};
	$courseid=$ENV{'form.grade_courseid'};
	$domain=$ENV{'form.grade_domain'};
	$name=$ENV{'form.grade_username'};
	}
	} else {
	$symb=&Apache::lonnet::symbread();
	$courseid=$ENV{'request.course.id'};
	$domain=$ENV{'user.domain'};
	$name=$ENV{'user.name'};
	}
	return ($symb,$courseid,$domain,$name);
}	}

1;	1;
__END__	__END__

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

Removed from v.1.116
changed lines
	Added in v.1.160