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.114 and 1.139

version 1.114, 2001/08/15 15:49:14	version 1.139, 2001/11/29 19:03:58
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 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


package Apache::lonxml;	package Apache::lonxml;
use vars	use vars
Line 46 use Apache::scripttag;	Line 84 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 191 sub xmlend {
return $discussion.'</html>';	return $discussion.'</html>';
}	}

sub checkout {	sub tokeninputfield {
my ($target,$symb,$tuname,$tudom,$tcrsid)=@_;	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 {
	my ($symb,$tuname,$tudom,$tcrsid)=@_;
unless ($symb) {	unless ($symb) {
$symb=&Apache::lonnet::symbread();	$symb=&Apache::lonnet::symbread();
}	}
Line 162 sub checkout {	Line 250 sub checkout {
$tudom=$ENV{'user.domain'};	$tudom=$ENV{'user.domain'};
$tcrsid=$ENV{'request.course.id'};	$tcrsid=$ENV{'request.course.id'};
}	}
my $now=time;
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};	return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
my $infostr=&Apache::lonnet::escape(	}
$tuname.'&'.
$tudom.'&'.	sub printtokenheader {
$tcrsid.'&'.	my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
$symb.'&'.	unless ($token) { return ''; }
$now.'&'.$ENV{'REMOTE_ADDR'});
my $token=Apache::lonnet::reply('tmpput:'.$infostr,$lonhost);	my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
if ($token=~/^error\:/) { return ''; }	unless ($tsymb) {
$token=~s/^(\d+)\_.\_(\d+)$/$1\$2\*$lonhost/;	$tsymb=$symb;
$token=~tr/a-z/A-Z/;	}
	unless ($tuname) {
my %infohash=('token' => $token,	$tuname=$name;
'checktime' => $now,	$tudom=$domain;
'remote' => $ENV{'REMOTE_ADDR'});	$tcrsid=$courseid;

unless (
&Apache::lonnet::cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
return '';
}

if (&Apache::lonnet::log($tudom,$tuname,
&Apache::lonnet::homeserver($tuname,$tudom),
&Apache::lonnet::escape('Checkout '.$infostr.' - '.
$token)) ne 'ok') {
return '';
}	}

my %reply=&Apache::lonnet::get('environment',	my %reply=&Apache::lonnet::get('environment',
Line 200 sub checkout {	Line 277 sub checkout {
$reply{'generation'};	$reply{'generation'};

if ($target eq 'web') {	if ($target eq 'web') {
return 'Checked out for '.$plainname.	return
	'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.
	'Checked out for '.$plainname.
'<br />User: '.$tuname.' at '.$tudom.	'<br />User: '.$tuname.' at '.$tudom.
'<br />CourseID: '.$tcrsid.')'.	'<br />CourseID: '.$tcrsid.
'<br />DocID: '.$token.	'<br />DocID: '.$token.
'<br />Time: '.localtime($now).	'<br />Time: '.localtime().'<hr />';
'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" /><hr />';
} else {	} else {
return $token;	return $token;
}	}
}	}

Line 222 sub fontsettings() {	Line 300 sub fontsettings() {

sub registerurl {	sub registerurl {
my $forcereg=shift;	my $forcereg=shift;
if ($Apache::lonxml::registered) { return ''; }	if ($ENV{'request.publicaccess'}) {
	return
	'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
	}
	if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;	$Apache::lonxml::registered=1;
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {	if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {
my $hwkadd='';	my $hwkadd='';
Line 285 ENDPARM	Line 367 ENDPARM
menu=window.open("","LONCAPAmenu");	menu=window.open("","LONCAPAmenu");
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 370 sub xmlparse {	Line 452 sub xmlparse {

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 397 sub htmlclean {	Line 481 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 619 sub setup_globals {	Line 702 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 700 sub init_safespace {	Line 789 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 835 sub parstring {	Line 927 sub parstring {
}	}

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 844 sub writeallows {	Line 937 sub writeallows {
my %httpref=();	my %httpref=();
map {	map {
$httpref{'httpref.'.	$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;	&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
	} @extlinks;
	@extlinks=();
&Apache::lonnet::appenv(%httpref);	&Apache::lonnet::appenv(%httpref);
}	}

Line 948 sub handler {	Line 1043 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 993 ENDNOTFOUND	Line 1088 ENDNOTFOUND
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
$result=&inserteditinfo($result,$filecontents);	$result=&inserteditinfo($result,$filecontents);
}	}

	writeallows($request->uri);

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

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

Line 1039 sub get_param {	Line 1135 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 =~ /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 1052 sub register_insert {	Line 1166 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 1079 sub register_insert {	Line 1196 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.114
changed lines
	Added in v.1.139