--- loncom/xml/lonxml.pm 2001/02/19 20:40:55 1.54
+++ loncom/xml/lonxml.pm 2001/03/13 22:44:24 1.56
@@ -4,10 +4,11 @@
# last modified 06/26/00 by Alexander Sakharuk
# 11/6 Gerd Kortemeyer
# 6/1/1 Gerd Kortemeyer
+# 2/21,3/13 Guy
package Apache::lonxml;
use vars
-qw(@pwd $outputstack $redirection $textredirection $on_offimport @extlinks);
+qw(@pwd @outputstack $redirection $textredirection $import @extlinks);
use strict;
use HTML::TokeParser;
use Safe;
@@ -38,24 +39,23 @@ use Apache::londefdef;
use Apache::scripttag;
#================================================== Main subroutine: xmlparse
@pwd=();
-$outputstack = '';
-$redirection = 1;
-$textredirection = 1;
-$on_offimport = 0;
+@outputstack = ();
+$redirection = 0;
+$import = 1;
@extlinks=();
sub xmlparse {
my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
if ($target eq 'meta') {
- $Apache::lonxml::textredirection = 0;
- $Apache::lonxml::on_offimport = 1;
+ &startredirection;
+ $Apache::lonxml::import = 0;
} elsif ($target eq 'grade') {
- $Apache::lonxml::textredirection = 0;
- $Apache::lonxml::on_offimport = 0;
+ &startredirection;
+ $Apache::lonxml::import = 1;
} else {
- $Apache::lonxml::textredirection = 1;
- $Apache::lonxml::on_offimport = 0;
+ $Apache::lonxml::redirection = 0;
+ $Apache::lonxml::import = 1;
}
#&printalltags();
my @pars = ();
@@ -90,76 +90,67 @@ sub xmlparse {
while ( $#pars > -1 ) {
while ($token = $pars[$#pars]->get_token) {
if ($token->[0] eq 'T') {
- if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}
- # $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
+ $result=$token->[1];
} elsif ($token->[0] eq 'S') {
- # if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}
# add tag to stack
push (@stack,$token->[1]);
# add parameters list to another stack
push (@parstack,&parstring($token));
&increasedepth($token);
if (exists $style_for_target{$token->[1]}) {
-
- if ($Apache::lonxml::redirection == 1) {
- $finaloutput .= &recurse($style_for_target{$token->[1]},
- $target,$safeeval,\%style_for_target,
- @parstack);
+ if ($Apache::lonxml::redirection) {
+ $Apache::lonxml::outputstack['-1'] .=
+ &recurse($style_for_target{$token->[1]},$target,$safeeval,
+ \%style_for_target,@parstack);
} else {
- $Apache::lonxml::outputstack .= &recurse($style_for_target{$token->[1]},
- $target,$safeeval,\%style_for_target,
- @parstack);
+ $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
+ $safeeval,\%style_for_target,@parstack);
}
-
} else {
$result = &callsub("start_$token->[1]", $target, $token,\@parstack,
\@pars, $safeeval, \%style_for_target);
}
} elsif ($token->[0] eq 'E') {
- #if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
#clear out any tags that didn't end
- while ($token->[1] ne $stack[$#stack]
- && ($#stack > -1)) {
- &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
+ while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
+ &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
pop @stack;pop @parstack;&decreasedepth($token);
}
if (exists $style_for_target{'/'."$token->[1]"}) {
-
- if ($Apache::lonxml::redirection == 1) {
- $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
- $target,$safeeval,\%style_for_target,
- @parstack);
- } else {
- $Apache::lonxml::outputstack .= &recurse($style_for_target{'/'."$token->[1]"},
- $target,$safeeval,\%style_for_target,
- @parstack);
- }
-
+ if ($Apache::lonxml::redirection) {
+ $Apache::lonxml::outputstack['-1'] .=
+ &recurse($style_for_target{'/'."$token->[1]"},
+ $target,$safeeval,\%style_for_target,@parstack);
+ } else {
+ $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
+ $target,$safeeval,\%style_for_target,
+ @parstack);
+ }
+
} else {
$result = &callsub("end_$token->[1]", $target, $token, \@parstack,
- \@pars,$safeeval, \%style_for_target);
+ \@pars,$safeeval, \%style_for_target);
}
}
+ #evaluate variable refs in result
if ($result ne "") {
if ( $#parstack > -1 ) {
-
- if ($Apache::lonxml::redirection == 1) {
- $finaloutput .= &Apache::run::evaluate($result,$safeeval,
- $parstack[$#parstack]);
- } else {
- $Apache::lonxml::outputstack .= &Apache::run::evaluate($result,$safeeval,
- $parstack[$#parstack]);
- }
-
+ if ($Apache::lonxml::redirection) {
+ $Apache::lonxml::outputstack['-1'] .=
+ &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
+ } else {
+ $finaloutput .= &Apache::run::evaluate($result,$safeeval,
+ $parstack[$#parstack]);
+ }
} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
}
$result = '';
- } else {
- $finaloutput .= $result;
+ }
+ if ($token->[0] eq 'E') {
+ pop @stack;pop @parstack;&decreasedepth($token);
}
- if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
}
pop @pars;
pop @Apache::lonxml::pwd;
@@ -182,7 +173,7 @@ sub recurse {
while ( $#pat > -1 ) {
while ($tokenpat = $pat[$#pat]->get_token) {
if ($tokenpat->[0] eq 'T') {
- if ($Apache::lonxml::textredirection == 1) {$partstring = $tokenpat->[1];}
+ $partstring = $tokenpat->[1];
} elsif ($tokenpat->[0] eq 'S') {
push (@innerstack,$tokenpat->[1]);
push (@innerparstack,&parstring($tokenpat));
@@ -254,6 +245,20 @@ sub callsub {
return $currentstring;
}
+sub startredirection {
+ $Apache::lonxml::redirection++;
+ push (@Apache::lonxml::outputstack, '');
+}
+
+sub endredirection {
+ if (!$Apache::lonxml::redirection) {
+ &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuggin information:".join ":",caller);
+ return '';
+ }
+ $Apache::lonxml::redirection--;
+ pop @Apache::lonxml::outputstack;
+}
+
sub initdepth {
@Apache::lonxml::depthcounter=();
$Apache::lonxml::depth=-1;
@@ -318,6 +323,7 @@ sub get_all_text {
sub newparser {
my ($parser,$contentref,$dir) = @_;
push (@$parser,HTML::TokeParser->new($contentref));
+ $$parser['-1']->xml_mode('1');
if ( $dir eq '' ) {
push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
} else {
@@ -407,7 +413,7 @@ sub debug {
sub error {
if ($Apache::lonxml::debug eq 1) {
- print "ERROR:".$_[0]."
\n";
+ print "ERROR:".$_[0]."
\n";
} else {
print "An Error occured while processing this resource. The instructor has been notified.
";
#notify author
@@ -429,7 +435,7 @@ sub error {
sub warning {
if ($Apache::lonxml::debug eq 1) {
- print "WARNING:".$_[0]."
\n";
+ print "WARNING:".$_[0]."
\n";
}
}