Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- retabination
- perl -w complained about @array[]

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