Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

- renamed pakages to conform to apache

    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 starting tag only)
  117:         
  118:      pop @stack; 
  119:      unless (exists $style_for_target{$token->[1]}) {
  120:       my $sub="end_$token->[1]";
  121:        {
  122: 	no strict 'refs';
  123:           if (defined (&$sub)) {
  124: 		$currentstring = &$sub($target,$token,\@parstack);
  125:                 $finaloutput .= $currentstring;
  126:                 $currentstring = '';
  127: 	  } else {
  128:                 $finaloutput .= $token->[4];
  129: 	  }
  130: 	use strict 'refs';
  131:        }
  132:      }
  133: #-------------------------------------------------- end tag from the style file
  134:      if (exists $style_for_target{'/'."$token->[1]"}) {
  135:        $newarg = $style_for_target{'/'."$token->[1]"};
  136:        if (index($newarg,'script') != -1 ) {
  137:          my $pat = HTML::TokeParser->new(\$newarg);
  138:          my $tokenpat;
  139:          my $partstring = '';
  140:          my $oustring = '';
  141:          my $outputstring;
  142: 
  143:          while  ($tokenpat = $pat->get_token) {
  144: 	  if ($tokenpat->[0] eq 'T') {
  145: 	    $oustring .= $tokenpat->[1];
  146:       	  } elsif ($tokenpat->[0] eq 'S') {
  147:              if ($tokenpat->[1] eq 'script') {
  148:                while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
  149:                      if ($tokenpat->[0] eq 'S')  {
  150: 		       $partstring .=  $tokenpat->[4];
  151: 		     } elsif ($tokenpat->[0] eq 'T') {
  152:                        $partstring .=  $tokenpat->[1];
  153: 		     } elsif ($tokenpat->[0] eq 'E') {
  154:                        $partstring .=  $tokenpat->[2];
  155:                      }
  156: 	       }
  157: 	
  158:                my @tempor_list = split(',',$parstack[$#parstack]);
  159:                my @te_kl = ();
  160:                my %tempor_hash = ();
  161:                map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); 
  162:                     $tempor_hash{$onete} = $twote} @tempor_list;
  163:                map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; 
  164:                                
  165:                &run($partstring,$safeeval);
  166: 
  167:                $partstring = '';
  168: 	     } elsif ($tokenpat->[1] eq 'evaluate') {		
  169: 	        $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);
  170:                 $oustring .=  $outputstring;
  171: 	     } else {
  172:                 $oustring .= $tokenpat->[4]; 
  173: 	     }
  174: 	  } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
  175:              $oustring .= $tokenpat->[1];    
  176: 	  }
  177:          }
  178:              $newarg =  $oustring;
  179:        } else {
  180:          my @very_temp = split(',',@parstack[$#parstack]);
  181:          map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;
  182:        }
  183: 
  184:        $finaloutput .= $newarg; 
  185:      }
  186:      pop @parstack;
  187:   }
  188:  }
  189:  return $finaloutput;
  190: }
  191: 
  192: 1;
  193: __END__