Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- renamed pakages to conform to apache

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