Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- safeinit string now passed

# 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,$safeinit,%style_for_target) = @_;
 my @pars = ();
 push (@pars,HTML::TokeParser->new(\$content_file_string));
 my $currentstring = '';
 my $finaloutput = ''; 
 my $newarg = '';
 my $result;
 my $safeeval = new Safe;
 $safeeval->permit("entereval");
 $safeeval->permit(":base_math");
 if ( $safeinit ne '') {&Apache::run::run($safeinit,$safeeval);}
#-------------------- Redefinition of the target in the case of compound target

 ($target, my @tenta) = split('&&',$target);

 my @stack = (); 
 my @parstack = ();
 &initdepth;
 my $token;
 while ( $#pars > -1 ) {
   while ($token = $pars[$#pars]->get_token) {
     if ($token->[0] eq 'T') {
       $result=$token->[1];
#       $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));
       &increasedepth();       
       if (exists $style_for_target{$token->[1]}) {
	 $finaloutput .= &recurse($style_for_target{$token->[1]},
				  $target,$safeeval,\%style_for_target,
				  @parstack);
       } else {
	 $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
			       \@pars, $safeeval, \%style_for_target);
       }              
     } elsif ($token->[0] eq 'E')  {
       #clear out any tags that didn't end
       while ($token->[1] ne $stack[$#stack] 
	      && ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth;}
       
       if (exists $style_for_target{'/'."$token->[1]"}) {
	 $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
				  $target,$safeeval,\%style_for_target,
				  @parstack);
       } else {
	 $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
			       \@pars,$safeeval, \%style_for_target);
       }
     }
     if ($result ne "" ) {
       if ( $#parstack > -1 ) { 
	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,
						$parstack[$#parstack]);
       } else {
	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
       }
       $result = '';
     }
     if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth;}
   }
   pop @pars;
 }
 return $finaloutput;
}

sub recurse {
  
  my @innerstack = (); 
  my @innerparstack = ();
  my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
  my @pat = ();
  push (@pat,HTML::TokeParser->new(\$newarg));
  my $tokenpat;
  my $partstring = '';
  my $output='';
  my $decls='';
  while ( $#pat > -1 ) {
    while  ($tokenpat = $pat[$#pat]->get_token) {
      if ($tokenpat->[0] eq 'T') {
	$partstring = $tokenpat->[1];
      } elsif ($tokenpat->[0] eq 'S') {
	push (@innerstack,$tokenpat->[1]);
	push (@innerparstack,&parstring($tokenpat));
	&increasedepth();
	$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 > -1)) {pop @innerstack;pop @innerparstack;
					&decreasedepth;}
	$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 "" ) {
	if ( $#parstack > -1 ) { 
	  if ( $#innerparstack > -1 ) { 
	    $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
	  } else {
	    $decls= $parstack[$#parstack];
	  }
	} else {
	  if ( $#innerparstack > -1 ) { 
	    $decls=$innerparstack[$#innerparstack];
	  } else {
	    $decls='';
	  }
	}
	$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
	$partstring = '';
      }
      if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
				 &decreasedepth;}
    }
    pop @pat;
  }
  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";
      $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
      $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 initdepth {
  @Apache::lonxml::depthcounter=();
  $Apache::lonxml::depth=-1;
  $Apache::lonxml::olddepth=-1;
}

sub increasedepth {
  if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
    $#Apache::lonxml::depthcounter--;
    $Apache::lonxml::olddepth=$Apache::lonxml::depth;
  }
  $Apache::lonxml::depth++;
  $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
  if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
    $Apache::lonxml::olddepth=$Apache::lonxml::depth;
  }
}

sub decreasedepth {
  $Apache::lonxml::depth--;
}

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