--- loncom/xml/lonxml.pm 2001/08/30 21:19:45 1.128
+++ loncom/xml/lonxml.pm 2001/12/21 22:44:06 1.142
@@ -1,6 +1,41 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
+# $Id: lonxml.pm,v 1.142 2001/12/21 22:44:06 albertel 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/
+#
+# 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
# 11/6 Gerd Kortemeyer
# 6/1/1 Gerd Kortemeyer
@@ -14,6 +49,9 @@
# 6/16 Gerd Kortemeyer
# 7/27 H. K. Ng
# 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;
use vars
@@ -28,13 +66,21 @@ use Math::Random qw(:all);
use Opcode;
sub register {
- my $space;
- my @taglist;
- my $temptag;
- ($space,@taglist) = @_;
- foreach $temptag (@taglist) {
- $Apache::lonxml::alltags{$temptag}=$space;
+ my ($space,@taglist) = @_;
+ foreach my $temptag (@taglist) {
+ push(@{ $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);
@@ -46,6 +92,7 @@ use Apache::scripttag;
use Apache::edit;
use Apache::lonnet;
use Apache::File;
+use Apache::loncommon;
#================================================== Main subroutine: xmlparse
#debugging control, to turn on debugging modify the correct handler
@@ -216,16 +263,17 @@ sub maketoken {
}
sub printtokenheader {
- my ($target,$token,$symb,$tuname,$tudom,$tcrsid)=@_;
+ my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
unless ($token) { return ''; }
- unless ($symb) {
- $symb=&Apache::lonnet::symbread();
+ my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+ unless ($tsymb) {
+ $tsymb=$symb;
}
unless ($tuname) {
- $tuname=$ENV{'user.name'};
- $tudom=$ENV{'user.domain'};
- $tcrsid=$ENV{'request.course.id'};
+ $tuname=$name;
+ $tudom=$domain;
+ $tcrsid=$courseid;
}
my %reply=&Apache::lonnet::get('environment',
@@ -260,6 +308,10 @@ sub fontsettings() {
sub registerurl {
my $forcereg=shift;
+ if ($ENV{'request.publicaccess'}) {
+ return
+ '<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
+ }
if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
@@ -381,7 +433,8 @@ sub unloadevents() {
sub printalltags {
my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {
- &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
+ &Apache::lonxml::debug("$temp -- ".
+ join(',',@{ $Apache::lonxml::alltags{$temp} }));
}
}
@@ -419,11 +472,11 @@ sub htmlclean {
my $tree = HTML::TreeBuilder->new;
$tree->ignore_unknown(0);
-
+
$tree->parse($raw);
my $output= $tree->as_HTML(undef,' ');
-
+
$output=~s/\<(br|hr|img|meta|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
unless ($full) {
@@ -451,14 +504,14 @@ sub inner_xmlparse {
$result=$token->[2];
}
} elsif ($token->[0] eq 'S') {
- # add tag to stack
+ # add tag to stack
push (@$stack,$token->[1]);
# add parameters list to another stack
push (@$parstack,&parstring($token));
- &increasedepth($token);
+ &increasedepth($token);
if (exists $$style_for_target{$token->[1]}) {
if ($Apache::lonxml::redirection) {
- $Apache::lonxml::outputstack['-1'] .=
+ $Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{$token->[1]},$target,$safeeval,
$style_for_target,@$parstack);
} else {
@@ -468,15 +521,15 @@ sub inner_xmlparse {
} else {
$result = &callsub("start_$token->[1]", $target, $token, $stack,
$parstack, $pars, $safeeval, $style_for_target);
- }
+ }
} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end
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);
}
-
- if (exists $$style_for_target{'/'."$token->[1]"}) {
+
+ if (exists($$style_for_target{'/'."$token->[1]"})) {
if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{'/'."$token->[1]"},
@@ -486,7 +539,6 @@ sub inner_xmlparse {
$target,$safeeval,$style_for_target,
@$parstack);
}
-
} else {
$result = &callsub("end_$token->[1]", $target, $token, $stack,
$parstack, $pars,$safeeval, $style_for_target);
@@ -537,6 +589,7 @@ sub recurse {
my $partstring = '';
my $output='';
my $decls='';
+ &Apache::lonxml::debug("Recursing");
while ( $#pat > -1 ) {
while ($tokenpat = $pat[$#pat]->get_token) {
if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
@@ -554,7 +607,7 @@ sub recurse {
#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#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);
}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
@@ -588,6 +641,7 @@ sub recurse {
pop @pat;
pop @Apache::lonxml::pwd;
}
+ &Apache::lonxml::debug("Exiting Recursing");
return $output;
}
@@ -599,11 +653,11 @@ sub callsub {
my $sub1;
no strict 'refs';
my $tag=$token->[1];
- my $space=$Apache::lonxml::alltags{$tag};
+ my $space=$Apache::lonxml::alltags{$tag}[-1];
if (!$space) {
- $tag=~tr/A-Z/a-z/;
+ $tag=~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;
@@ -664,6 +718,11 @@ sub setup_globals {
$Apache::lonxml::metamode = 1;
$Apache::lonxml::evaluate = 1;
$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') {
&startredirection;
$Apache::lonxml::metamode = 0;
@@ -794,7 +853,7 @@ sub decreasedepth {
$Apache::lonxml::olddepth=$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';
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
@@ -866,14 +925,14 @@ sub newparser {
sub parstring {
my ($token) = @_;
my $temp='';
- map {
+ foreach (@{$token->[3]}) {
unless ($_=~/\W/) {
my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\])/\\$1/g;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"
}
- } @{$token->[3]};
+ }
return $temp;
}
@@ -886,10 +945,10 @@ sub writeallows {
my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;
my %httpref=();
- map {
+ foreach (@extlinks) {
$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
- } @extlinks;
+ }
@extlinks=();
&Apache::lonnet::appenv(%httpref);
}
@@ -899,7 +958,7 @@ sub writeallows {
#
sub afterburn {
my $result=shift;
- map {
+ foreach (split(/&/,$ENV{'QUERY_STRING'})) {
my ($name, $value) = split(/=/,$_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
@@ -908,22 +967,22 @@ sub afterburn {
$ENV{'form.'.$name}=$value;
}
}
- } (split(/&/,$ENV{'QUERY_STRING'}));
+ }
if ($ENV{'form.highlight'}) {
- map {
+ foreach (split(/\,/,$ENV{'form.highlight'})) {
my $anchorname=$_;
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
- } split(/\,/,$ENV{'form.highlight'});
+ }
}
if ($ENV{'form.link'}) {
- map {
+ foreach (split(/\,/,$ENV{'form.link'})) {
my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
- } split(/\,/,$ENV{'form.link'});
+ }
}
if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};
@@ -994,9 +1053,9 @@ sub handler {
} else {
$request->content_type('text/html');
}
-
+ &Apache::loncommon::no_cache($request);
$request->send_http_header;
-
+
return OK if $request->header_only;
@@ -1086,7 +1145,25 @@ sub get_param {
if ( ! $context ) { $context = -1; }
my $args ='';
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 {
@@ -1099,13 +1176,16 @@ sub register_insert {
if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
if ( $line =~ /TABLE/ ) { last; }
my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
- $insertlist{"$tagnum.tag"} = $tag;
- $insertlist{"$tagnum.description"} = $descrip;
- $insertlist{"$tagnum.color"} = $color;
- $insertlist{"$tagnum.function"} = $function;
- $insertlist{"$tagnum.show"}= $show;
- $insertlist{"$tag.num"}=$tagnum;
- $tagnum++;
+ if ($tag) {
+ $insertlist{"$tagnum.tag"} = $tag;
+ $insertlist{"$tagnum.description"} = $descrip;
+ $insertlist{"$tagnum.color"} = $color;
+ $insertlist{"$tagnum.function"} = $function;
+ if (!defined($show)) { $show='yes'; }
+ $insertlist{"$tagnum.show"}= $show;
+ $insertlist{"$tag.num"}=$tagnum;
+ $tagnum++;
+ }
}
$i++; #skipping TABLE line
$tagnum = 0;
@@ -1126,7 +1206,15 @@ sub register_insert {
sub description {
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
@@ -1134,10 +1222,7 @@ sub description {
# calls to lonnet functions for this setup.
# - looks for form.grade_ parameters
sub whichuser {
- my $symb=&Apache::lonnet::symbread();
- my $courseid=$ENV{'request.course.id'};
- my $domain=$ENV{'user.domain'};
- my $name=$ENV{'user.name'};
+ 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);
@@ -1147,6 +1232,11 @@ sub whichuser {
$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);
}