--- loncom/xml/lonxml.pm 2001/02/13 00:13:47 1.50
+++ 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));
@@ -236,13 +227,13 @@ sub callsub {
my $sub1;
no strict 'refs';
if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
- #&Apache::lonxml::debug("Calling sub $sub in $space
\n");
+ #&Apache::lonxml::debug("Calling sub $sub in $space
\n");
$sub1="$space\:\:$sub";
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
$currentstring = &$sub1($target,$token,$parstack,$parser,
$safeeval,$style);
} else {
- #&Apache::lonxml::debug("NOT Calling sub $sub in $space
\n");
+ #&Apache::lonxml::debug("NOT Calling sub $sub in $space
\n");
if (defined($token->[4])) {
$currentstring = $token->[4];
} else {
@@ -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;
@@ -269,7 +274,7 @@ sub increasedepth {
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
-#print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
+#print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
}
sub decreasedepth {
@@ -285,7 +290,7 @@ sub decreasedepth {
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
-#print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
+#print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}
sub get_all_text {
@@ -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 {
@@ -333,7 +339,8 @@ sub parstring {
map {
unless ($_=~/\W/) {
my $val=$token->[2]->{$_};
- if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
+ $val =~ s/([\%\@\\])/\\$1/g;
+ #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"
}
} @{$token->[3]};
@@ -400,17 +407,35 @@ sub handler {
$Apache::lonxml::debug=0;
sub debug {
if ($Apache::lonxml::debug eq 1) {
- print "DEBUG:".$_[0]."
\n";
+ print "DEBUG:".$_[0]."
\n";
}
}
sub error {
- print "ERROR:".$_[0]."
\n";
+ if ($Apache::lonxml::debug eq 1) {
+ print "ERROR:".$_[0]."
\n";
+ } else {
+ print "An Error occured while processing this resource. The instructor has been notified.
";
+ #notify author
+ &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
+ #notify course
+ if ( $ENV{'request.course.id'} ) {
+ my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
+ foreach my $user (split /\,/, $users) {
+ ($user,my $domain) = split /:/, $user;
+ &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
+ }
+ }
+
+ #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','103',"Error in $ENV{'request.filename'}",$_[0]);
+ }
}
sub warning {
if ($Apache::lonxml::debug eq 1) {
- print "WARNING:".$_[0]."
\n";
+ print "WARNING:".$_[0]."
\n";
}
}