version 1.56, 2001/03/13 22:44:24
|
version 1.60, 2001/03/23 22:08:05
|
Line 8
|
Line 8
|
|
|
package Apache::lonxml; |
package Apache::lonxml; |
use vars |
use vars |
qw(@pwd @outputstack $redirection $textredirection $import @extlinks); |
qw(@pwd @outputstack $redirection $import @extlinks $metamode); |
use strict; |
use strict; |
use HTML::TokeParser; |
use HTML::TokeParser; |
use Safe; |
use Safe; |
Line 37 use Apache::lontexconvert;
|
Line 37 use Apache::lontexconvert;
|
use Apache::run; |
use Apache::run; |
use Apache::londefdef; |
use Apache::londefdef; |
use Apache::scripttag; |
use Apache::scripttag; |
|
use Apache::edit; |
#================================================== Main subroutine: xmlparse |
#================================================== Main subroutine: xmlparse |
@pwd=(); |
@pwd=(); |
@outputstack = (); |
@outputstack = (); |
$redirection = 0; |
$redirection = 0; |
$import = 1; |
$import = 1; |
@extlinks=(); |
@extlinks=(); |
|
$metamode = 0; |
|
|
sub xmlparse { |
sub xmlparse { |
|
|
my ($target,$content_file_string,$safeinit,%style_for_target) = @_; |
my ($target,$content_file_string,$safeinit,%style_for_target) = @_; |
if ($target eq 'meta') { |
if ($target eq 'meta') { |
&startredirection; |
# meta mode is a bit weird only some output is to be turned off |
|
#<output> tag turns metamode off (defined in londefdef.pm) |
|
$Apache::lonxml::redirection = 0; |
|
$Apache::lonxml::metamode = 1; |
$Apache::lonxml::import = 0; |
$Apache::lonxml::import = 0; |
} elsif ($target eq 'grade') { |
} elsif ($target eq 'grade') { |
&startredirection; |
&startredirection; |
|
$Apache::lonxml::metamode = 0; |
$Apache::lonxml::import = 1; |
$Apache::lonxml::import = 1; |
} else { |
} else { |
|
$Apache::lonxml::metamode = 0; |
$Apache::lonxml::redirection = 0; |
$Apache::lonxml::redirection = 0; |
$Apache::lonxml::import = 1; |
$Apache::lonxml::import = 1; |
} |
} |
Line 89 sub xmlparse {
|
Line 96 sub xmlparse {
|
my $token; |
my $token; |
while ( $#pars > -1 ) { |
while ( $#pars > -1 ) { |
while ($token = $pars[$#pars]->get_token) { |
while ($token = $pars[$#pars]->get_token) { |
if ($token->[0] eq 'T') { |
if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { |
$result=$token->[1]; |
if (!$metamode) { $result=$token->[1]; } |
|
} elsif ($token->[0] eq 'PI') { |
|
if (!$metamode) { $result=$token->[2]; } |
} elsif ($token->[0] eq 'S') { |
} elsif ($token->[0] eq 'S') { |
# add tag to stack |
# add tag to stack |
push (@stack,$token->[1]); |
push (@stack,$token->[1]); |
Line 98 sub xmlparse {
|
Line 107 sub xmlparse {
|
push (@parstack,&parstring($token)); |
push (@parstack,&parstring($token)); |
&increasedepth($token); |
&increasedepth($token); |
if (exists $style_for_target{$token->[1]}) { |
if (exists $style_for_target{$token->[1]}) { |
if ($Apache::lonxml::redirection) { |
if ($metamode) { |
|
$result = $style_for_target{$token->[1]}; |
|
} elsif ($Apache::lonxml::redirection) { |
$Apache::lonxml::outputstack['-1'] .= |
$Apache::lonxml::outputstack['-1'] .= |
&recurse($style_for_target{$token->[1]},$target,$safeeval, |
&recurse($style_for_target{$token->[1]},$target,$safeeval, |
\%style_for_target,@parstack); |
\%style_for_target,@parstack); |
Line 118 sub xmlparse {
|
Line 129 sub xmlparse {
|
} |
} |
|
|
if (exists $style_for_target{'/'."$token->[1]"}) { |
if (exists $style_for_target{'/'."$token->[1]"}) { |
if ($Apache::lonxml::redirection) { |
if ($metamode) { |
|
$result = $style_for_target{$token->[1]}; |
|
} elsif ($Apache::lonxml::redirection) { |
$Apache::lonxml::outputstack['-1'] .= |
$Apache::lonxml::outputstack['-1'] .= |
&recurse($style_for_target{'/'."$token->[1]"}, |
&recurse($style_for_target{'/'."$token->[1]"}, |
$target,$safeeval,\%style_for_target,@parstack); |
$target,$safeeval,\%style_for_target,@parstack); |
Line 127 sub xmlparse {
|
Line 140 sub xmlparse {
|
$target,$safeeval,\%style_for_target, |
$target,$safeeval,\%style_for_target, |
@parstack); |
@parstack); |
} |
} |
|
|
} else { |
} else { |
$result = &callsub("end_$token->[1]", $target, $token, \@parstack, |
$result = &callsub("end_$token->[1]", $target, $token, \@parstack, |
\@pars,$safeeval, \%style_for_target); |
\@pars,$safeeval, \%style_for_target); |
} |
} |
|
} else { |
|
&Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); |
} |
} |
#evaluate variable refs in result |
#evaluate variable refs in result |
if ($result ne "") { |
if ($result ne "") { |
Line 156 sub xmlparse {
|
Line 171 sub xmlparse {
|
pop @Apache::lonxml::pwd; |
pop @Apache::lonxml::pwd; |
} |
} |
|
|
|
# if ($target eq 'meta') { |
|
# $finaloutput.=&endredirection; |
|
# } |
return $finaloutput; |
return $finaloutput; |
} |
} |
|
|
Line 172 sub recurse {
|
Line 190 sub recurse {
|
my $decls=''; |
my $decls=''; |
while ( $#pat > -1 ) { |
while ( $#pat > -1 ) { |
while ($tokenpat = $pat[$#pat]->get_token) { |
while ($tokenpat = $pat[$#pat]->get_token) { |
if ($tokenpat->[0] eq 'T') { |
if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) { |
$partstring = $tokenpat->[1]; |
$partstring = $tokenpat->[1]; |
|
} elsif ($tokenpat->[0] eq 'PI') { |
|
$partstring = $tokenpat->[2]; |
} 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)); |
Line 191 sub recurse {
|
Line 211 sub recurse {
|
$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); |
|
} else { |
|
&Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:"); |
} |
} |
#pass both the variable to the style tag, and the tag we |
#pass both the variable to the style tag, and the tag we |
#are processing inside the <definedtag> |
#are processing inside the <definedtag> |
Line 224 sub callsub {
|
Line 246 sub callsub {
|
my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_; |
my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_; |
my $currentstring=''; |
my $currentstring=''; |
{ |
{ |
my $sub1; |
my $sub1; |
no strict 'refs'; |
no strict 'refs'; |
|
if ($target eq 'edit' && $token->[0] eq 'S') { |
|
$currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser, |
|
$safeeval,$style); |
|
} |
if (my $space=$Apache::lonxml::alltags{$token->[1]}) { |
if (my $space=$Apache::lonxml::alltags{$token->[1]}) { |
#&Apache::lonxml::debug("Calling sub $sub in $space<br />\n"); |
#&Apache::lonxml::debug("Calling sub $sub in $space<br />\n"); |
$sub1="$space\:\:$sub"; |
$sub1="$space\:\:$sub"; |
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); |
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); |
$currentstring = &$sub1($target,$token,$parstack,$parser, |
$currentstring .= &$sub1($target,$token,$parstack,$parser, |
$safeeval,$style); |
$safeeval,$style); |
} else { |
} else { |
#&Apache::lonxml::debug("NOT Calling sub $sub in $space<br />\n"); |
#&Apache::lonxml::debug("NOT Calling sub $sub in $space<br />\n"); |
if (defined($token->[4])) { |
if (defined($token->[4]) && !$metamode) { |
$currentstring = $token->[4]; |
$currentstring .= $token->[4]; |
} else { |
} else { |
$currentstring = $token->[2]; |
$currentstring .= $token->[2]; |
} |
} |
} |
} |
|
if ($target eq 'edit' && $token->[0] eq 'E') { |
|
$currentstring = &Apache::edit::tag_end($target,$token,$parstack,$parser, |
|
$safeeval,$style); |
|
} |
use strict 'refs'; |
use strict 'refs'; |
} |
} |
return $currentstring; |
return $currentstring; |
Line 299 sub get_all_text {
|
Line 329 sub get_all_text {
|
my $depth=0; |
my $depth=0; |
my $token; |
my $token; |
my $result=''; |
my $result=''; |
my $tag=substr($tag,1); #strip the / off the tag |
if ( $tag =~ m:^/: ) { |
#&Apache::lonxml::debug("have:$tag:"); |
my $tag=substr($tag,1); |
while (($depth >=0) && ($token = $pars->get_token)) { |
# &Apache::lonxml::debug("have:$tag:"); |
#&Apache::lonxml::debug("token:$token->[0]:$depth:$token->[1]"); |
while (($depth >=0) && ($token = $pars->get_token)) { |
if ($token->[0] eq 'T') { |
# &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]"); |
$result.=$token->[1]; |
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { |
} elsif ($token->[0] eq 'S') { |
$result.=$token->[1]; |
if ($token->[1] eq $tag) { $depth++; } |
} elsif ($token->[0] eq 'PI') { |
$result.=$token->[4]; |
$result.=$token->[2]; |
} elsif ($token->[0] eq 'E') { |
} elsif ($token->[0] eq 'S') { |
if ( $token->[1] eq $tag) { $depth--; } |
if ($token->[1] eq $tag) { $depth++; } |
#skip sending back the last end tag |
$result.=$token->[4]; |
if ($depth > -1) { $result.=$token->[2]; } else { |
} elsif ($token->[0] eq 'E') { |
$pars->unget_token($token); |
if ( $token->[1] eq $tag) { $depth--; } |
|
#skip sending back the last end tag |
|
if ($depth > -1) { $result.=$token->[2]; } else { |
|
$pars->unget_token($token); |
|
} |
|
} |
|
} |
|
} else { |
|
while ($token = $pars->get_token) { |
|
# &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); |
|
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { |
|
$result.=$token->[1]; |
|
} elsif ($token->[0] eq 'PI') { |
|
$result.=$token->[2]; |
|
} elsif ($token->[0] eq 'S') { |
|
if ( $token->[1] eq $tag) { |
|
$pars->unget_token($token); last; |
|
} else { |
|
$result.=$token->[4]; |
|
} |
|
} elsif ($token->[0] eq 'E') { |
|
$result.=$token->[2]; |
} |
} |
} |
} |
} |
} |