Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- retabination
- perl -w complained about @array[]

# 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__