# The LearningOnline Network with CAPA # XML Parser Module # # last modified 06/26/00 by Alexander Sakharuk package Apache::lonxml; use strict; use HTML::TokeParser; use Safe; use Apache::style; use Apache::lontexconvert; use Apache::londefdef; #================================================== Main subroutine: xmlparse sub xmlparse { my ($target,$content_file_string,%style_for_target) = @_; my $pars = HTML::TokeParser->new(\$content_file_string); my $currentstring = ''; my $finaloutput = ''; my $newarg = ''; my $tempostring = ''; my $tempocont = ''; my $safeeval = new Safe; #-------------------- Redefinition of the target in the case of compound target ($target, my @tenta) = split('&&',$target); #------------------------- Stack definition (in stack we have all current tags) my @stack = (); my @parstack = (); #------------------------------------- Parse input string (content_file_string) my $token; while ($token = $pars->get_token) { if ($token->[0] eq 'T') { $finaloutput .= $token->[1]; $tempocont .= $token->[1]; } elsif ($token->[0] eq 'S') { #------------------------------------------------------------- add tag to stack push (@stack,$token->[1]); #----------------------------------------- add parameters list to another stack map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]}; push (@parstack,$tempostring); $tempostring = ''; if (exists $style_for_target{$token->[1]}) { #---------------------------------------------------- use style file definition $newarg = $style_for_target{$token->[1]}; if (index($newarg,'script') != -1 ) { my $pat = HTML::TokeParser->new(\$newarg); my $tokenpat; my $partstring = ''; my $oustring = ''; my $outputstring; while ($tokenpat = $pat->get_token) { if ($tokenpat->[0] eq 'T') { $oustring .= $tokenpat->[1]; } elsif ($tokenpat->[0] eq 'S') { if ($tokenpat->[1] eq 'script') { while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { if ($tokenpat->[0] eq 'S') { $partstring .= $tokenpat->[4]; } 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; } else { map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; } $finaloutput .= $newarg; } else { #------------------------------------------------ use default definition of tag my $sub="start_$token->[1]"; { no strict 'refs'; if (defined (&$sub)) { $currentstring = &$sub($target,$token,\@parstack); $finaloutput .= $currentstring; $currentstring = ''; } else { $finaloutput .= $token->[4]; } use strict 'refs'; } } } elsif ($token->[0] eq 'E') { # Put here check for correct final tag (to avoid existence of starting tag only) pop @stack; unless (exists $style_for_target{$token->[1]}) { my $sub="end_$token->[1]"; { 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 if (exists $style_for_target{'/'."$token->[1]"}) { $newarg = $style_for_target{'/'."$token->[1]"}; if (index($newarg,'script') != -1 ) { my $pat = HTML::TokeParser->new(\$newarg); my $tokenpat; my $partstring = ''; my $oustring = ''; my $outputstring; while ($tokenpat = $pat->get_token) { if ($tokenpat->[0] eq 'T') { $oustring .= $tokenpat->[1]; } elsif ($tokenpat->[0] eq 'S') { if ($tokenpat->[1] eq 'script') { while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { if ($tokenpat->[0] eq 'S') { $partstring .= $tokenpat->[4]; } elsif ($tokenpat->[0] eq 'T') { $partstring .= $tokenpat->[1]; } elsif ($tokenpat->[0] eq 'E') { $partstring .= $tokenpat->[2]; } } my @tempor_list = split(',',$parstack[$#parstack]); my @te_kl = (); my %tempor_hash = (); map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); $tempor_hash{$onete} = $twote} @tempor_list; map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; &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; } else { my @very_temp = split(',',@parstack[$#parstack]); map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp; } $finaloutput .= $newarg; } pop @parstack; } } return $finaloutput; } 1; __END__