Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- evaluate now works as expected
- lonxml hands evaluates properly in start tags

    1: # The LearningOnline Network with CAPA
    2: # XML Parser Module 
    3: #
    4: # last modified 06/26/00 by Alexander Sakharuk
    5: 
    6: package Apache::lonxml; 
    7: 
    8: use strict;
    9: use HTML::TokeParser;
   10: use Safe;
   11: use Apache::style;
   12: use Apache::lontexconvert;
   13: use Apache::londefdef;
   14: use Apache::run;
   15: #==================================================   Main subroutine: xmlparse  
   16: 
   17: sub xmlparse {
   18: 
   19:  my ($target,$content_file_string,%style_for_target) = @_;
   20:  my $pars = HTML::TokeParser->new(\$content_file_string);
   21:  my $currentstring = '';
   22:  my $finaloutput = ''; 
   23:  my $newarg = '';
   24:  my $tempostring = '';
   25:  my $tempocont = '';
   26:  my $safeeval = new Safe;
   27:  $safeeval->permit("entereval");
   28: #-------------------- Redefinition of the target in the case of compound target
   29: 
   30:  ($target, my @tenta) = split('&&',$target);
   31: 
   32: #------------------------- Stack definition (in stack we have all current tags)
   33: 
   34:  my @stack = (); 
   35:  my @parstack = ();
   36: 
   37: #------------------------------------- Parse input string (content_file_string)
   38:  
   39:  my $token;
   40:  
   41:  while ($token = $pars->get_token) {
   42:    if ($token->[0] eq 'T') {
   43:      $finaloutput .= $token->[1];
   44:      $tempocont .= $token->[1];
   45:    } elsif ($token->[0] eq 'S') {
   46: #------------------------------------------------------------- add tag to stack 	    
   47:      push (@stack,$token->[1]);
   48: #----------------------------------------- add parameters list to another stack
   49:      map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};
   50:      push (@parstack,$tempostring);
   51:      $tempostring = '';
   52:      
   53:      if (exists $style_for_target{$token->[1]}) {
   54: #       print "Style for $token->[1] is " .$style_for_target{$token->[1]}."\n";
   55: #---------------------------------------------------- use style file definition
   56: 
   57:        $newarg = $style_for_target{$token->[1]};
   58:        
   59:        if (index($newarg,'script') != -1 ) {
   60: 	 my $pat = HTML::TokeParser->new(\$newarg);
   61: 	 my $tokenpat = '';
   62: 	 my $partstring = '';
   63: 	 my $oustring = '';
   64: 	 my $outputstring;
   65: 	 
   66: 	 while  ($tokenpat = $pat->get_token) {
   67: 	   if ($tokenpat->[0] eq 'T') {
   68: #	     print "evaluating $tokenpat->[4]\n";
   69: 	     $oustring .= &Apache::run::evaluate($tokenpat->[1],$safeeval);
   70: 	   } elsif ($tokenpat->[0] eq 'S') {
   71: 	     if ($tokenpat->[1] eq 'script') {
   72: 	       while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
   73: 		 if ($tokenpat->[0] eq 'S')  {
   74: 		   $partstring .=  $tokenpat->[4];
   75: 		 } elsif ($tokenpat->[0] eq 'T') {
   76: 		   $partstring .=  $tokenpat->[1];
   77: 		 } elsif ($tokenpat->[0] eq 'E') {
   78: 		   $partstring .=  $tokenpat->[2];
   79: 		 }
   80: 	       }
   81: 	       
   82: 	       map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
   83: #	       print "want to use run\n";	       
   84: 	       &Apache::run::run($partstring,$safeeval);
   85: 	       
   86: 	       $partstring = '';
   87: 	     } else {
   88: #	       print "evaluating $tokenpat->[4]\n";
   89: 	       $oustring .= &Apache::run::evaluate($tokenpat->[4],$safeeval);
   90: 	     }
   91: 	   } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
   92: #	     print "hereish\n";
   93: 	     $oustring .= $tokenpat->[1];    
   94: 	   }
   95: 	 }
   96: 	 $newarg =  $oustring;
   97:        } else {
   98: 	 map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
   99:        }
  100:        $finaloutput .= $newarg;
  101:      } else {
  102:        # use default definition of tag
  103:        my $sub="start_$token->[1]";
  104:        {
  105: 	 no strict 'refs';
  106: 	 if (defined (&$sub)) {
  107: 	   $currentstring = &$sub($target,$token,\@parstack);
  108: 	   $finaloutput .= $currentstring;
  109: 	   $currentstring = '';
  110: 	 } else {
  111: 	   $finaloutput .= $token->[4];
  112: 	 }
  113: 	 use strict 'refs';    
  114:        }
  115:      }              
  116:    } elsif ($token->[0] eq 'E')  {
  117:      # Put here check for correct final tag (to avoid existence of 
  118:      # starting tag only)
  119:         
  120:      pop @stack; 
  121:      unless (exists $style_for_target{$token->[1]}) {
  122:        my $sub="end_$token->[1]";
  123:        {
  124: 	 no strict 'refs';
  125: 	 if (defined(&$sub)) {
  126: 	   $currentstring = &$sub($target,$token,\@parstack);
  127: 	   $finaloutput .= $currentstring;
  128: 	   $currentstring = '';
  129: 	 } else {
  130: 	   $finaloutput .= $token->[4];
  131: 	 }
  132: 	 use strict 'refs';
  133:        }
  134:      }
  135:      #---- end tag from the style file
  136:      if (exists $style_for_target{'/'."$token->[1]"}) {
  137:        $newarg = $style_for_target{'/'."$token->[1]"};
  138:        if (index($newarg,'script') != -1 ) {
  139:          my $pat = HTML::TokeParser->new(\$newarg);
  140:          my $tokenpat;
  141:          my $partstring = '';
  142:          my $oustring = '';
  143:          my $outputstring;
  144: 	 
  145:          while  ($tokenpat = $pat->get_token) {
  146: 	   if ($tokenpat->[0] eq 'T') {
  147: 	     $oustring .= $tokenpat->[1];
  148: 	   } elsif ($tokenpat->[0] eq 'S') {
  149:              if ($tokenpat->[1] eq 'script') {
  150:                while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
  151: 		 if ($tokenpat->[0] eq 'S')  {
  152: 		   $partstring .=  $tokenpat->[4];
  153: 		 } elsif ($tokenpat->[0] eq 'T') {
  154: 		   $partstring .=  $tokenpat->[1];
  155: 		 } elsif ($tokenpat->[0] eq 'E') {
  156: 		   $partstring .=  $tokenpat->[2];
  157: 		 }
  158: 	       }
  159: 	       
  160:                my @tempor_list = split(',',$parstack[$#parstack]);
  161:                my @te_kl = ();
  162:                my %tempor_hash = ();
  163:                map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); 
  164:                     $tempor_hash{$onete} = $twote} @tempor_list;
  165:                map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; 
  166: 	       print "want to use run\n";
  167:                &Apache::run::run($partstring,$safeeval);
  168: 	       
  169:                $partstring = '';
  170: 	     } elsif ($tokenpat->[1] eq 'evaluate') {		
  171: 	       $outputstring = &Apache::run::evaluate($tokenpat->[2]{expression},$safeeval);
  172: 	       $oustring .=  $outputstring;
  173: 	     } else {
  174: 	       $oustring .= $tokenpat->[4]; 
  175: 	     }
  176: 	   } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
  177:              $oustring .= $tokenpat->[1];    
  178: 	   }
  179:          }
  180: 	 $newarg =  $oustring;
  181:        } else {
  182:          my @very_temp = split(',',$parstack[$#parstack]);
  183:          map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;
  184:        }
  185:        
  186:        $finaloutput .= $newarg; 
  187:      }
  188:      pop @parstack;
  189:    }
  190:  }
  191:  return $finaloutput;
  192: }
  193: 
  194: 1;
  195: __END__