version 1.5, 2000/06/27 20:33:54
|
version 1.7, 2000/06/29 18:52:54
|
Line 8 package Apache::lonxml;
|
Line 8 package Apache::lonxml;
|
use strict; |
use strict; |
use HTML::TokeParser; |
use HTML::TokeParser; |
use Safe; |
use Safe; |
|
|
|
sub register { |
|
my $space; |
|
my @taglist; |
|
my $temptag; |
|
($space,@taglist) = @_; |
|
foreach $temptag (@taglist) { |
|
$Apache::lonxml::alltags{$temptag}=$space; |
|
} |
|
} |
|
|
use Apache::style; |
use Apache::style; |
use Apache::lontexconvert; |
use Apache::lontexconvert; |
|
use Apache::run; |
use Apache::londefdef; |
use Apache::londefdef; |
|
use Apache::scripttag; |
#================================================== Main subroutine: xmlparse |
#================================================== Main subroutine: xmlparse |
|
|
sub xmlparse { |
sub xmlparse { |
Line 21 sub xmlparse {
|
Line 34 sub xmlparse {
|
my $finaloutput = ''; |
my $finaloutput = ''; |
my $newarg = ''; |
my $newarg = ''; |
my $tempostring = ''; |
my $tempostring = ''; |
my $tempocont = ''; |
|
my $safeeval = new Safe; |
my $safeeval = new Safe; |
|
$safeeval->permit("entereval"); |
#-------------------- 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 39 sub xmlparse {
|
Line 51 sub xmlparse {
|
|
|
while ($token = $pars->get_token) { |
while ($token = $pars->get_token) { |
if ($token->[0] eq 'T') { |
if ($token->[0] eq 'T') { |
$finaloutput .= $token->[1]; |
$finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,''); |
$tempocont .= $token->[1]; |
|
} 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]); |
#----------------------------------------- add parameters list to another stack |
# add parameters list to another stack |
map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]}; |
map {$tempostring .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]}; |
push (@parstack,$tempostring); |
push (@parstack,$tempostring); |
$tempostring = ''; |
$tempostring = ''; |
|
|
if (exists $style_for_target{$token->[1]}) { |
if (exists $style_for_target{$token->[1]}) { |
|
#print "Style for $token->[1] is " .$style_for_target{$token->[1]}."\n"; |
#---------------------------------------------------- use style file definition |
# use style file definition |
|
|
$newarg = $style_for_target{$token->[1]}; |
$newarg = $style_for_target{$token->[1]}; |
|
|
if (index($newarg,'script') != -1 ) { |
my $pat = HTML::TokeParser->new(\$newarg); |
my $pat = HTML::TokeParser->new(\$newarg); |
my $tokenpat = ''; |
my $tokenpat; |
my $partstring = ''; |
my $partstring = ''; |
my $oustring = ''; |
my $oustring = ''; |
my $outputstring; |
my $outputstring; |
|
|
while ($tokenpat = $pat->get_token) { |
while ($tokenpat = $pat->get_token) { |
if ($tokenpat->[0] eq 'T') { |
if ($tokenpat->[0] eq 'T') { |
$partstring = $tokenpat->[1]; |
$oustring .= $tokenpat->[1]; |
} elsif ($tokenpat->[0] eq 'S') { |
} elsif ($tokenpat->[0] eq 'S') { |
my $sub="start_$tokenpat->[1]"; |
if ($tokenpat->[1] eq 'script') { |
$partstring = &callsub($sub, $target, $tokenpat, \@parstack) |
while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { |
} elsif ($tokenpat->[0] eq 'E') { |
if ($tokenpat->[0] eq 'S') { |
my $sub="end_$tokenpat->[1]"; |
$partstring .= $tokenpat->[4]; |
$partstring = &callsub($sub, $target, $tokenpat, \@parstack) |
} elsif ($tokenpat->[0] eq 'T') { |
|
$partstring .= $tokenpat->[1]; |
|
} elsif ($tokenpat->[0] eq 'E') { |
|
$partstring .= $tokenpat->[2]; |
|
} |
|
} |
|
|
|
map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; |
|
|
|
&run($partstring,$safeeval); |
|
|
|
$partstring = ''; |
|
} elsif ($tokenpat->[1] eq 'evaluate') { |
|
$outputstring = &evaluate($tokenpat->[2]{expression},$safeeval); |
|
$oustring .= $outputstring; |
|
} else { |
|
$oustring .= $tokenpat->[4]; |
|
} |
|
} elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') { |
|
$oustring .= $tokenpat->[1]; |
|
} |
|
} |
} |
$newarg = $oustring; |
# generate the my mechanism |
} else { |
# map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; |
map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; |
print "Temp: $parstack[$#parstack]\n"; |
|
$oustring .= &Apache::run::evaluate($partstring,$safeeval,$parstack[$#parstack]); |
} |
} |
$finaloutput .= $newarg; |
$finaloutput .= $oustring; |
} else { |
} else { |
# use default definition of tag |
|
my $sub="start_$token->[1]"; |
my $sub="start_$token->[1]"; |
{ |
#print "use default definition of tag $sub\n"; |
no strict 'refs'; |
my $result = &callsub($sub, $target, $token, \@parstack); |
if (defined (&$sub)) { |
$finaloutput .= &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]); |
$currentstring = &$sub($target,$token,\@parstack); |
|
$finaloutput .= $currentstring; |
|
$currentstring = ''; |
|
} else { |
|
$finaloutput .= $token->[4]; |
|
} |
|
use strict 'refs'; |
|
} |
|
} |
} |
} elsif ($token->[0] eq 'E') { |
} elsif ($token->[0] eq 'E') { |
# Put here check for correct final tag (to avoid existence of |
# Put here check for correct final tag (to avoid existence of |
# starting tag only) |
# starting tag only) |
|
|
pop @stack; |
pop @stack; |
unless (exists $style_for_target{$token->[1]}) { |
unless (exists $style_for_target{$token->[1]}) { |
my $sub="end_$token->[1]"; |
my $sub="end_$token->[1]"; |
{ |
$finaloutput .= callsub($sub, $target, $token, \@parstack); |
no strict 'refs'; |
|
if (defined(&$sub)) { |
|
$currentstring = &$sub($target,$token,\@parstack); |
|
$finaloutput .= $currentstring; |
|
$currentstring = ''; |
|
} else { |
|
$finaloutput .= $token->[4]; |
|
} |
|
use strict 'refs'; |
|
} |
|
} |
} |
#---- end tag from the style file |
#---- end tag from the style file |
if (exists $style_for_target{'/'."$token->[1]"}) { |
if (exists $style_for_target{'/'."$token->[1]"}) { |
Line 148 sub xmlparse {
|
Line 120 sub xmlparse {
|
if ($tokenpat->[1] eq 'script') { |
if ($tokenpat->[1] eq 'script') { |
while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { |
while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { |
if ($tokenpat->[0] eq 'S') { |
if ($tokenpat->[0] eq 'S') { |
|
|
$partstring .= $tokenpat->[4]; |
$partstring .= $tokenpat->[4]; |
} elsif ($tokenpat->[0] eq 'T') { |
} elsif ($tokenpat->[0] eq 'T') { |
$partstring .= $tokenpat->[1]; |
$partstring .= $tokenpat->[1]; |
Line 162 sub xmlparse {
|
Line 135 sub xmlparse {
|
map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); |
map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); |
$tempor_hash{$onete} = $twote} @tempor_list; |
$tempor_hash{$onete} = $twote} @tempor_list; |
map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; |
map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; |
|
print "want to use run\n"; |
&run($partstring,$safeeval); |
&Apache::run::run($partstring,$safeeval); |
|
|
$partstring = ''; |
$partstring = ''; |
} elsif ($tokenpat->[1] eq 'evaluate') { |
} elsif ($tokenpat->[1] eq 'evaluate') { |
$outputstring = &evaluate($tokenpat->[2]{expression},$safeeval); |
$outputstring = &Apache::run::evaluate($tokenpat->[2]{expression},$safeeval); |
$oustring .= $outputstring; |
$oustring .= $outputstring; |
} else { |
} else { |
$oustring .= $tokenpat->[4]; |
$oustring .= $tokenpat->[4]; |
Line 190 sub xmlparse {
|
Line 163 sub xmlparse {
|
return $finaloutput; |
return $finaloutput; |
} |
} |
|
|
|
sub callsub { |
|
my ($sub,$target,$token,@parstack)=@_; |
|
my $currentstring=''; |
|
{ |
|
no strict 'refs'; |
|
if (my $space=$Apache::lonxml::alltags{$token->[1]}) { |
|
#print "Calling sub $sub in $space \n"; |
|
$sub="$space\:\:$sub"; |
|
$currentstring = &$sub($target,$token,\@parstack); |
|
} else { |
|
#print "NOT Calling sub $sub\n"; |
|
if (defined($token->[4])) { |
|
$currentstring = $token->[4]; |
|
} else { |
|
$currentstring = $token->[2]; |
|
} |
|
} |
|
use strict 'refs'; |
|
} |
|
return $currentstring; |
|
} |
|
|
1; |
1; |
__END__ |
__END__ |