version 1.131, 2001/09/28 18:20:06
|
version 1.140, 2001/11/29 21:38:17
|
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 49 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 219 sub maketoken {
|
Line 255 sub maketoken {
|
} |
} |
|
|
sub printtokenheader { |
sub printtokenheader { |
my ($target,$token,$symb,$tuname,$tudom,$tcrsid)=@_; |
my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; |
unless ($token) { return ''; } |
unless ($token) { return ''; } |
|
|
unless ($symb) { |
my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); |
$symb=&Apache::lonnet::symbread(); |
unless ($tsymb) { |
|
$tsymb=$symb; |
} |
} |
unless ($tuname) { |
unless ($tuname) { |
$tuname=$ENV{'user.name'}; |
$tuname=$name; |
$tudom=$ENV{'user.domain'}; |
$tudom=$domain; |
$tcrsid=$ENV{'request.course.id'}; |
$tcrsid=$courseid; |
} |
} |
|
|
my %reply=&Apache::lonnet::get('environment', |
my %reply=&Apache::lonnet::get('environment', |
Line 426 sub htmlclean {
|
Line 463 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 458 sub inner_xmlparse {
|
Line 495 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 475 sub inner_xmlparse {
|
Line 512 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']"); |
&Apache::lonxml::warning('Missing tag </'.$$stack['-1'].'> in file'); |
&end_tag($stack,$parstack,$token); |
&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 493 sub inner_xmlparse {
|
Line 530 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 544 sub recurse {
|
Line 580 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 561 sub recurse {
|
Line 598 sub recurse {
|
#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']"); |
&Apache::lonxml::warning('Missing tag </'.$innerstack['-1'].'> in style'); |
&end_tag(\@innerstack,\@innerparstack,$tokenpat); |
&end_tag(\@innerstack,\@innerparstack,$tokenpat); |
} |
} |
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, |
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, |
Line 595 sub recurse {
|
Line 632 sub recurse {
|
pop @pat; |
pop @pat; |
pop @Apache::lonxml::pwd; |
pop @Apache::lonxml::pwd; |
} |
} |
|
&Apache::lonxml::debug("Exiting Recursing"); |
return $output; |
return $output; |
} |
} |
|
|
Line 806 sub decreasedepth {
|
Line 844 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 1006 sub handler {
|
Line 1044 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 1105 sub get_param {
|
Line 1143 sub get_param {
|
} |
} |
} |
} |
|
|
|
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 { |
my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); |
my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); |
my $i; |
my $i; |
Line 1115 sub register_insert {
|
Line 1167 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 1142 sub register_insert {
|
Line 1197 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 |
# ----------------------------------------------------------------- whichuser |
Line 1150 sub description {
|
Line 1213 sub description {
|
# calls to lonnet functions for this setup. |
# calls to lonnet functions for this setup. |
# - looks for form.grade_ parameters |
# - looks for form.grade_ parameters |
sub whichuser { |
sub whichuser { |
my $symb=&Apache::lonnet::symbread(); |
my ($symb,$courseid,$domain,$name); |
my $courseid=$ENV{'request.course.id'}; |
|
my $domain=$ENV{'user.domain'}; |
|
my $name=$ENV{'user.name'}; |
|
if (defined($ENV{'form.grade_symb'})) { |
if (defined($ENV{'form.grade_symb'})) { |
my $tmp_courseid=$ENV{'form.grade_courseid'}; |
my $tmp_courseid=$ENV{'form.grade_courseid'}; |
my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid); |
my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid); |
Line 1163 sub whichuser {
|
Line 1223 sub whichuser {
|
$domain=$ENV{'form.grade_domain'}; |
$domain=$ENV{'form.grade_domain'}; |
$name=$ENV{'form.grade_username'}; |
$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); |
return ($symb,$courseid,$domain,$name); |
} |
} |