Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- shortened parser by splitting out "recursion" sections

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

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");
 $safeeval->permit(":base_math");
#-------------------- 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]}) {
       $finaloutput .= &recurse($style_for_target{$token->[1]},
				$target,$safeeval,\%style_for_target,
				@parstack);
     } else {
       my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
			     $pars, $safeeval, \%style_for_target);
       if ($result ne "" ) {
	 $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]"}) {
       $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
			       $target,$safeeval,\%style_for_target,
				@parstack);
     } else {
       my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
			     $pars,$safeeval, \%style_for_target);
       if ($result ne "") {
	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,
						$parstack[$#parstack]);
       }
     }
     pop @stack; 
     pop @parstack;
   }
 }
 return $finaloutput;
}

sub recurse {
  
  my @innerstack = (); 
  my @innerparstack = ();
  my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
  my $pat = HTML::TokeParser->new(\$newarg);
  my $tokenpat;
  my $partstring = '';
  my $output='';
  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,
			     $pat, $safeeval, $style_for_target);
    } 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,
			     $pat, $safeeval, $style_for_target);
    }
    #pass both the variable to the style tag, and the tag we 
    #are processing inside the <definedtag>
    if ( $partstring ne "" ) {
      $output .= &Apache::run::evaluate($partstring,$safeeval,
                  $parstack[$#parstack].$innerparstack[$#innerparstack]);
    }
    if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
  }
  return $output;
}

sub callsub {
  my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
  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,$parser,$safeeval,$style);
    } 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__