version 1.17, 2000/08/08 19:34:29
|
version 1.19, 2000/08/16 18:32:58
|
Line 29 use Apache::scripttag;
|
Line 29 use Apache::scripttag;
|
|
|
sub xmlparse { |
sub xmlparse { |
|
|
my ($target,$content_file_string,%style_for_target) = @_; |
my ($target,$content_file_string,$safeinit,%style_for_target) = @_; |
my @pars = (); |
my @pars = (); |
push (@pars,HTML::TokeParser->new(\$content_file_string)); |
push (@pars,HTML::TokeParser->new(\$content_file_string)); |
my $currentstring = ''; |
my $currentstring = ''; |
Line 39 sub xmlparse {
|
Line 39 sub xmlparse {
|
my $safeeval = new Safe; |
my $safeeval = new Safe; |
$safeeval->permit("entereval"); |
$safeeval->permit("entereval"); |
$safeeval->permit(":base_math"); |
$safeeval->permit(":base_math"); |
|
$safeeval->deny(":base_io"); |
|
#need to inspect this class of ops |
|
# $safeeval->deny(":base_orig"); |
|
if ( $safeinit ne '') {&Apache::run::run($safeinit,$safeeval);} |
#-------------------- Redefinition of the target in the case of compound target |
#-------------------- Redefinition of the target in the case of compound target |
|
|
($target, my @tenta) = split('&&',$target); |
($target, my @tenta) = split('&&',$target); |
Line 57 sub xmlparse {
|
Line 61 sub xmlparse {
|
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(); |
&increasedepth($token); |
if (exists $style_for_target{$token->[1]}) { |
if (exists $style_for_target{$token->[1]}) { |
$finaloutput .= &recurse($style_for_target{$token->[1]}, |
$finaloutput .= &recurse($style_for_target{$token->[1]}, |
$target,$safeeval,\%style_for_target, |
$target,$safeeval,\%style_for_target, |
Line 69 sub xmlparse {
|
Line 73 sub xmlparse {
|
} 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[$#stack] |
while ($token->[1] ne $stack[$#stack] |
&& ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth;} |
&& ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);} |
|
|
if (exists $style_for_target{'/'."$token->[1]"}) { |
if (exists $style_for_target{'/'."$token->[1]"}) { |
$finaloutput .= &recurse($style_for_target{'/'."$token->[1]"}, |
$finaloutput .= &recurse($style_for_target{'/'."$token->[1]"}, |
Line 89 sub xmlparse {
|
Line 93 sub xmlparse {
|
} |
} |
$result = ''; |
$result = ''; |
} |
} |
if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth;} |
if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);} |
} |
} |
pop @pars; |
pop @pars; |
} |
} |
Line 114 sub recurse {
|
Line 118 sub recurse {
|
} elsif ($tokenpat->[0] eq 'S') { |
} elsif ($tokenpat->[0] eq 'S') { |
push (@innerstack,$tokenpat->[1]); |
push (@innerstack,$tokenpat->[1]); |
push (@innerparstack,&parstring($tokenpat)); |
push (@innerparstack,&parstring($tokenpat)); |
&increasedepth(); |
&increasedepth($tokenpat); |
$partstring = &callsub("start_$tokenpat->[1]", |
$partstring = &callsub("start_$tokenpat->[1]", |
$target, $tokenpat, \@innerparstack, |
$target, $tokenpat, \@innerparstack, |
\@pat, $safeeval, $style_for_target); |
\@pat, $safeeval, $style_for_target); |
Line 122 sub recurse {
|
Line 126 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)) {pop @innerstack;pop @innerparstack; |
&& ($#innerstack > -1)) {pop @innerstack;pop @innerparstack; |
&decreasedepth;} |
&decreasedepth($tokenpat);} |
$partstring = &callsub("end_$tokenpat->[1]", |
$partstring = &callsub("end_$tokenpat->[1]", |
$target, $tokenpat, \@innerparstack, |
$target, $tokenpat, \@innerparstack, |
\@pat, $safeeval, $style_for_target); |
\@pat, $safeeval, $style_for_target); |
Line 147 sub recurse {
|
Line 151 sub recurse {
|
$partstring = ''; |
$partstring = ''; |
} |
} |
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; |
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; |
&decreasedepth;} |
&decreasedepth($tokenpat);} |
} |
} |
pop @pat; |
pop @pat; |
} |
} |
Line 185 sub initdepth {
|
Line 189 sub initdepth {
|
} |
} |
|
|
sub increasedepth { |
sub increasedepth { |
|
my ($token) = @_; |
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { |
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { |
$#Apache::lonxml::depthcounter--; |
$#Apache::lonxml::depthcounter--; |
$Apache::lonxml::olddepth=$Apache::lonxml::depth; |
$Apache::lonxml::olddepth=$Apache::lonxml::depth; |
} |
} |
$Apache::lonxml::depth++; |
$Apache::lonxml::depth++; |
|
# print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n"; |
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; |
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; |
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { |
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { |
$Apache::lonxml::olddepth=$Apache::lonxml::depth; |
$Apache::lonxml::olddepth=$Apache::lonxml::depth; |
Line 197 sub increasedepth {
|
Line 203 sub increasedepth {
|
} |
} |
|
|
sub decreasedepth { |
sub decreasedepth { |
|
my ($token) = @_; |
$Apache::lonxml::depth--; |
$Apache::lonxml::depth--; |
|
# print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n"; |
} |
} |
|
|
|
sub get_all_text { |
|
|
|
my($tag,$pars)= @_; |
|
my $depth=0; |
|
my $token; |
|
my $result=''; |
|
while (($depth >=0) && ($token = $pars->get_token)) { |
|
if ($token->[0] eq 'T') { |
|
$result.=$token->[1]; |
|
} elsif ($token->[0] eq 'S') { |
|
if ($token->[1] eq $tag) { $depth++; } |
|
$result.=$token->[4]; |
|
} elsif ($token->[0] eq 'E') { |
|
if ($token->[1] eq $tag) { $depth--; } |
|
#skip sending back the last end tag |
|
if ($depth > -1) { $result.=$token->[2]; } |
|
} |
|
} |
|
return $result |
|
} |
|
|
|
|
sub parstring { |
sub parstring { |
my ($token) = @_; |
my ($token) = @_; |
my $temp=''; |
my $temp=''; |