--- loncom/xml/lonxml.pm 2000/11/06 16:22:59 1.33
+++ loncom/xml/lonxml.pm 2000/12/04 22:10:23 1.41
@@ -10,6 +10,7 @@ qw(@pwd $outputstack $redirection $textr
use strict;
use HTML::TokeParser;
use Safe;
+use Safe::Hole;
use Opcode;
sub register {
@@ -38,9 +39,9 @@ $on_offimport = 0;
sub xmlparse {
my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
- if ($target eq 'meta')
- {$Apache::lonxml::textredirection = 0;
- $Apache::lonxml::on_offimport = 1;
+ if ($target eq 'meta') {
+ $Apache::lonxml::textredirection = 0;
+ $Apache::lonxml::on_offimport = 1;
}
my @pars = ();
@Apache::lonxml::pwd=();
@@ -53,9 +54,11 @@ sub xmlparse {
my $result;
my $safeeval = new Safe;
+ my $safehole = new Safe::Hole;
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
$safeeval->deny(":base_io");
+ $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
#need to inspect this class of ops
# $safeeval->deny(":base_orig");
$safeinit .= ';$external::target='.$target.';';
@@ -72,33 +75,33 @@ 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,'');
+ if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}
+ # $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
} elsif ($token->[0] eq 'S') {
-# if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}
+ # 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);
- } else {
- $Apache::lonxml::outputstack .= &recurse($style_for_target{$token->[1]},
- $target,$safeeval,\%style_for_target,
- @parstack);
- }
-
+
+ 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);
+ }
+
} else {
$result = &callsub("start_$token->[1]", $target, $token,\@parstack,
- \@pars, $safeeval, \%style_for_target);
+ \@pars, $safeeval, \%style_for_target);
}
} elsif ($token->[0] eq 'E') {
-# if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
+ #if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
#clear out any tags that didn't end
while ($token->[1] ne $stack[$#stack]
&& ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);}
@@ -239,22 +242,24 @@ sub initdepth {
sub increasedepth {
my ($token) = @_;
- if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
- $#Apache::lonxml::depthcounter--;
- $Apache::lonxml::olddepth=$Apache::lonxml::depth;
- }
$Apache::lonxml::depth++;
-# print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]
\n";
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
$Apache::lonxml::olddepth=$Apache::lonxml::depth;
}
+# my $curdepth=join('_',@Apache::lonxml::depthcounter);
+# print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]
\n";
}
sub decreasedepth {
my ($token) = @_;
$Apache::lonxml::depth--;
-# print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]
\n";
+ if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
+ $#Apache::lonxml::depthcounter--;
+ $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
+ }
+# my $curdepth=join('_',@Apache::lonxml::depthcounter);
+# print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth
\n";
}
sub get_all_text {
@@ -274,7 +279,9 @@ sub get_all_text {
} elsif ($token->[0] eq 'E') {
if ( $token->[1] eq $tag) { $depth--; }
#skip sending back the last end tag
- if ($depth > -1) { $result.=$token->[2]; }
+ if ($depth > -1) { $result.=$token->[2]; } else {
+ $pars->unget_token($token);
+ }
}
}
return $result
@@ -296,13 +303,24 @@ sub parstring {
my ($token) = @_;
my $temp='';
map {
- if ($_=~/\w+/) {
+ unless ($_=~/\W/) {
$temp .= "my \$$_=\"$token->[2]->{$_}\";"
}
} @{$token->[3]};
return $temp;
}
+sub writeallows {
+ my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
+ my $thisdir=$thisurl;
+ $thisdir=~s/\/[^\/]+$//;
+ my %httpref=();
+ map {
+ $httpref{'httpref.'.
+ &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;
+ &Apache::lonnet::appenv(%httpref);
+}
+
sub handler {
my $request=shift;
@@ -338,6 +356,7 @@ sub handler {
$request->print('