[BACK]Return to lonxml.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.4 and 1.5

version 1.4, 2000/06/27 19:35:32 version 1.5, 2000/06/27 20:33:54
Line 36  sub xmlparse { Line 36  sub xmlparse {
 #------------------------------------- Parse input string (content_file_string)  #------------------------------------- Parse input string (content_file_string)
     
  my $token;   my $token;
    
  while ($token = $pars->get_token) {   while ($token = $pars->get_token) {
   if ($token->[0] eq 'T') {     if ($token->[0] eq 'T') {
     $finaloutput .= $token->[1];       $finaloutput .= $token->[1];
     $tempocont .= $token->[1];       $tempocont .= $token->[1];
   } elsif ($token->[0] eq 'S') {     } elsif ($token->[0] eq 'S') {
 #------------------------------------------------------------- add tag to stack      #------------------------------------------------------------- add tag to stack    
   push (@stack,$token->[1]);       push (@stack,$token->[1]);
 #----------------------------------------- add parameters list to another stack  #----------------------------------------- add parameters list to another stack
   map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};       map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};
   push (@parstack,$tempostring);       push (@parstack,$tempostring);
   $tempostring = '';       $tempostring = '';
        
    if (exists $style_for_target{$token->[1]}) {        if (exists $style_for_target{$token->[1]}) { 
          
 #---------------------------------------------------- use style file definition  #---------------------------------------------------- use style file definition
   
     $newarg = $style_for_target{$token->[1]};         $newarg = $style_for_target{$token->[1]};
          
     if (index($newarg,'script') != -1 ) {         if (index($newarg,'script') != -1 ) {
       my $pat = HTML::TokeParser->new(\$newarg);   my $pat = HTML::TokeParser->new(\$newarg);
       my $tokenpat;   my $tokenpat;
       my $partstring = '';   my $partstring = '';
       my $oustring = '';   my $oustring = '';
       my $outputstring;   my $outputstring;
     
        while  ($tokenpat = $pat->get_token) {   while  ($tokenpat = $pat->get_token) {
  if ($tokenpat->[0] eq 'T') {     if ($tokenpat->[0] eq 'T') {
   $oustring .= $tokenpat->[1];       $oustring .= $tokenpat->[1];
  } elsif ($tokenpat->[0] eq 'S') {     } elsif ($tokenpat->[0] eq 'S') {
            if ($tokenpat->[1] eq 'script') {       if ($tokenpat->[1] eq 'script') {
              while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {         while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
                    if ($tokenpat->[0] eq 'S')  {   if ($tokenpat->[0] eq 'S')  {
      $partstring .=  $tokenpat->[4];     $partstring .=  $tokenpat->[4];
    } elsif ($tokenpat->[0] eq 'T') {   } elsif ($tokenpat->[0] eq 'T') {
                      $partstring .=  $tokenpat->[1];     $partstring .=  $tokenpat->[1];
    } elsif ($tokenpat->[0] eq 'E') {   } elsif ($tokenpat->[0] eq 'E') {
                      $partstring .=  $tokenpat->[2];     $partstring .=  $tokenpat->[2];
                    }   }
          }
          
          map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
          
          &run($partstring,$safeeval);
          
          $partstring = '';
        } elsif ($tokenpat->[1] eq 'evaluate') {       
          $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);
          $oustring .=  $outputstring;
        } else {
          $oustring .= $tokenpat->[4]; 
      }       }
            } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
              map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};       $oustring .= $tokenpat->[1];    
                                  
              &run($partstring,$safeeval);  
   
              $partstring = '';  
    } elsif ($tokenpat->[1] eq 'evaluate') {         
       $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);  
               $oustring .=  $outputstring;  
    } else {  
               $oustring .= $tokenpat->[4];   
    }     }
  } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {   }
            $oustring .= $tokenpat->[1];       $newarg =  $oustring;
  }         } else {
    map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
        }         }
        $newarg =  $oustring;  
     } else {  
        map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};  
     }  
        $finaloutput .= $newarg;         $finaloutput .= $newarg;
    } else {       } else {
 #------------------------------------------------ use default definition of tag         # use default definition of tag
       my $sub="start_$token->[1]";         my $sub="start_$token->[1]";
         {         {
  no strict 'refs';   no strict 'refs';
          if (defined (&$sub)) {   if (defined (&$sub)) {
            $currentstring = &$sub($target,$token,\@parstack);     $currentstring = &$sub($target,$token,\@parstack);
            $finaloutput .= $currentstring;     $finaloutput .= $currentstring;
            $currentstring = '';     $currentstring = '';
  } else {   } else {
    $finaloutput .= $token->[4];     $finaloutput .= $token->[4];
  }   }
          use strict 'refs';       use strict 'refs';    
  }         }
    }                     }              
   } elsif ($token->[0] eq 'E')  {     } elsif ($token->[0] eq 'E')  {
 # Put here check for correct final tag (to avoid existence of starting tag only)       # Put here check for correct final tag (to avoid existence of 
        # starting tag only)
                   
      pop @stack;        pop @stack; 
      unless (exists $style_for_target{$token->[1]}) {       unless (exists $style_for_target{$token->[1]}) {
       my $sub="end_$token->[1]";         my $sub="end_$token->[1]";
        {         {
  no strict 'refs';   no strict 'refs';
           if (defined (&$sub)) {   if (defined(&$sub)) {
  $currentstring = &$sub($target,$token,\@parstack);     $currentstring = &$sub($target,$token,\@parstack);
                 $finaloutput .= $currentstring;     $finaloutput .= $currentstring;
                 $currentstring = '';     $currentstring = '';
   } else {   } else {
                 $finaloutput .= $token->[4];     $finaloutput .= $token->[4];
   }   }
  use strict 'refs';   use strict 'refs';
        }         }
      }       }
 #-------------------------------------------------- end tag from the style file       #---- end tag from the style file
      if (exists $style_for_target{'/'."$token->[1]"}) {       if (exists $style_for_target{'/'."$token->[1]"}) {
        $newarg = $style_for_target{'/'."$token->[1]"};         $newarg = $style_for_target{'/'."$token->[1]"};
        if (index($newarg,'script') != -1 ) {         if (index($newarg,'script') != -1 ) {
Line 139  sub xmlparse { Line 140  sub xmlparse {
          my $partstring = '';           my $partstring = '';
          my $oustring = '';           my $oustring = '';
          my $outputstring;           my $outputstring;
     
          while  ($tokenpat = $pat->get_token) {           while  ($tokenpat = $pat->get_token) {
   if ($tokenpat->[0] eq 'T') {     if ($tokenpat->[0] eq 'T') {
     $oustring .= $tokenpat->[1];       $oustring .= $tokenpat->[1];
        } elsif ($tokenpat->[0] eq 'S') {     } elsif ($tokenpat->[0] eq 'S') {
              if ($tokenpat->[1] eq 'script') {               if ($tokenpat->[1] eq 'script') {
                while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {                 while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
                      if ($tokenpat->[0] eq 'S')  {   if ($tokenpat->[0] eq 'S')  {
        $partstring .=  $tokenpat->[4];     $partstring .=  $tokenpat->[4];
      } elsif ($tokenpat->[0] eq 'T') {   } elsif ($tokenpat->[0] eq 'T') {
                        $partstring .=  $tokenpat->[1];     $partstring .=  $tokenpat->[1];
      } elsif ($tokenpat->[0] eq 'E') {   } elsif ($tokenpat->[0] eq 'E') {
                        $partstring .=  $tokenpat->[2];     $partstring .=  $tokenpat->[2];
                      }   }
        }         }
          
                my @tempor_list = split(',',$parstack[$#parstack]);                 my @tempor_list = split(',',$parstack[$#parstack]);
                my @te_kl = ();                 my @te_kl = ();
                my %tempor_hash = ();                 my %tempor_hash = ();
                map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete);                  map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); 
                     $tempor_hash{$onete} = $twote} @tempor_list;                      $tempor_hash{$onete} = $twote} @tempor_list;
                map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl;                  map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; 
                                         
                &run($partstring,$safeeval);                 &run($partstring,$safeeval);
          
                $partstring = '';                 $partstring = '';
      } elsif ($tokenpat->[1] eq 'evaluate') {       } elsif ($tokenpat->[1] eq 'evaluate') {
         $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);         $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);
                 $oustring .=  $outputstring;         $oustring .=  $outputstring;
      } else {       } else {
                 $oustring .= $tokenpat->[4];          $oustring .= $tokenpat->[4]; 
      }       }
   } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {     } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
              $oustring .= $tokenpat->[1];                   $oustring .= $tokenpat->[1];    
   }     }
          }           }
              $newarg =  $oustring;   $newarg =  $oustring;
        } else {         } else {
          my @very_temp = split(',',@parstack[$#parstack]);           my @very_temp = split(',',$parstack[$#parstack]);
          map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;           map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;
        }         }
          
        $finaloutput .= $newarg;          $finaloutput .= $newarg; 
      }       }
      pop @parstack;       pop @parstack;
   }     }
  }   }
  return $finaloutput;   return $finaloutput;
 }  }
Removed from v.1.4  
changed lines
  Added in v.1.5

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>