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

sub register {
  my $space;
  my @taglist;
  my $temptag;
  ($space,@taglist) = @_;
  foreach $temptag (@taglist) {
    $Apache::lonxml::alltags{$temptag}=$space;
  }
}

use Apache::style;
use Apache::lontexconvert;
use Apache::run;
use Apache::londefdef;
use Apache::scripttag;
#==================================================   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 $safeeval = new Safe;
 $safeeval->permit("entereval");
#-------------------- 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 .= &Apache::run::evaluate($token->[1],$safeeval,'');
   } elsif ($token->[0] eq 'S') {
     # add tag to stack 	    
     push (@stack,$token->[1]);
     # add parameters list to another stack
     push (@parstack,&parstring($token));
     
     if (exists $style_for_target{$token->[1]}) {
       #basically recurse, but we never got more than one level down so just 
       #create the new context here
       my @innerstack = (); 
       my @innerparstack = ();
       # use style file definition
       $newarg = $style_for_target{$token->[1]};       
       my $pat = HTML::TokeParser->new(\$newarg);
       my $tokenpat = '';
       my $partstring = '';

       while  ($tokenpat = $pat->get_token) {
	 if ($tokenpat->[0] eq 'T') {
	   $partstring = $tokenpat->[1];
	 } elsif ($tokenpat->[0] eq 'S') {
	   push (@innerstack,$tokenpat->[1]);
	   push (@innerparstack,&parstring($tokenpat));
	   $partstring = &callsub("start_$tokenpat->[1]", 
				  $target, $tokenpat, \@innerparstack)
	 } elsif ($tokenpat->[0] eq 'E') {
	   #clear out any tags that didn't end
	   while ($tokenpat->[1] ne $innerstack[$#innerstack] 
		  && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
	   $partstring = &callsub("end_$tokenpat->[1]",
				  $target, $tokenpat, \@innerparstack)
	 }
	 #pass both the variable to the style tag, and the tag we 
	 #are processing inside the <definedtag>
	 $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
		$parstack[$#parstack].$innerparstack[$#innerparstack]);
	 if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
       }
     } else {
       my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);
       $finaloutput .= &Apache::run::evaluate($result,$safeeval,
					      $parstack[$#parstack]);
     }              
   } elsif ($token->[0] eq 'E')  {
     #clear out any tags that didn't end
     while ($token->[1] ne $stack[$#stack] 
	    && ($#stack > 0)) {pop @stack;pop @parstack;}

     if (exists $style_for_target{'/'."$token->[1]"}) {
       my @innerstack = (); 
       my @innerparstack = ();
       $newarg = $style_for_target{'/'."$token->[1]"};
       my $pat = HTML::TokeParser->new(\$newarg);
       my $tokenpat;
       my $partstring = '';
       
       while  ($tokenpat = $pat->get_token) {
	 if ($tokenpat->[0] eq 'T') {
	   $partstring .= $tokenpat->[1];
	 } elsif ($tokenpat->[0] eq 'S') {
	   push (@innerstack,$tokenpat->[1]);
	   push (@innerparstack,&parstring($tokenpat));
	   $partstring = &callsub("start_$tokenpat->[1]", 
				  $target, $tokenpat, \@innerparstack)
	 } elsif ($tokenpat->[0] eq 'E') {
	   #clear out any tags that didn't end
	   while ($tokenpat->[1] ne $innerstack[$#innerstack] 
		  && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
	   $partstring = &callsub("end_$tokenpat->[1]",
				  $target, $tokenpat, \@innerparstack)
	 }
	 #pass both the variable to the style tag, and the tag we 
	 #are processing inside the <definedtag>
	 $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
		$parstack[$#parstack].$innerparstack[$#innerparstack]);
	 if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
       }
     } else {
       my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);
       $finaloutput .= &Apache::run::evaluate($result,$safeeval,
					      $parstack[$#parstack]);
     }
     pop @stack; 
     pop @parstack;
   }
 }
 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;
}

sub parstring {
  my ($token) = @_;
  my $temp='';
  map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
  return $temp;
}
1;
__END__