[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.7

version 1.4, 2000/06/27 19:35:32 version 1.7, 2000/06/29 18:52:54
Line 8  package Apache::lonxml; Line 8  package Apache::lonxml;
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::TokeParser;
 use Safe;  use Safe;
   
   sub register {
     my $space;
     my @taglist;
     my $temptag;
     ($space,@taglist) = @_;
     foreach $temptag (@taglist) {
       $Apache::lonxml::alltags{$temptag}=$space;
     }
   }
   
 use Apache::style;  use Apache::style;
 use Apache::lontexconvert;  use Apache::lontexconvert;
   use Apache::run;
 use Apache::londefdef;  use Apache::londefdef;
   use Apache::scripttag;
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
   
 sub xmlparse {  sub xmlparse {
Line 21  sub xmlparse { Line 34  sub xmlparse {
  my $finaloutput = '';    my $finaloutput = ''; 
  my $newarg = '';   my $newarg = '';
  my $tempostring = '';   my $tempostring = '';
  my $tempocont = '';  
  my $safeeval = new Safe;   my $safeeval = new Safe;
    $safeeval->permit("entereval");
 #-------------------- Redefinition of the target in the case of compound target  #-------------------- Redefinition of the target in the case of compound target
   
  ($target, my @tenta) = split('&&',$target);   ($target, my @tenta) = split('&&',$target);
Line 36  sub xmlparse { Line 48  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 .= &Apache::run::evaluate($token->[1],$safeeval,'');
     $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 .= "my \$$_=\"$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]}) {          #print "Style for $token->[1] is " .$style_for_target{$token->[1]}."\n";
          # use style file definition
 #---------------------------------------------------- use style file definition  
          $newarg = $style_for_target{$token->[1]};
     $newarg = $style_for_target{$token->[1]};         
          my $pat = HTML::TokeParser->new(\$newarg);
     if (index($newarg,'script') != -1 ) {         my $tokenpat = '';
       my $pat = HTML::TokeParser->new(\$newarg);         my $partstring = '';
       my $tokenpat;         my $oustring = '';
       my $partstring = '';         my $outputstring;
       my $oustring = '';         
       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];     $partstring = $tokenpat->[1];
  } elsif ($tokenpat->[0] eq 'S') {   } elsif ($tokenpat->[0] eq 'S') {
            if ($tokenpat->[1] eq 'script') {     my $sub="start_$tokenpat->[1]";
              while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {     $partstring = &callsub($sub, $target, $tokenpat, \@parstack)
                    if ($tokenpat->[0] eq 'S')  {   } elsif ($tokenpat->[0] eq 'E') {
      $partstring .=  $tokenpat->[4];     my $sub="end_$tokenpat->[1]";
    } elsif ($tokenpat->[0] eq 'T') {     $partstring = &callsub($sub, $target, $tokenpat, \@parstack)
                      $partstring .=  $tokenpat->[1];  
    } elsif ($tokenpat->[0] eq 'E') {  
                      $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') {  
            $oustring .= $tokenpat->[1];      
  }  
        }  
        $newarg =  $oustring;  
     } else {  
        map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};  
     }  
        $finaloutput .= $newarg;  
    } else {  
 #------------------------------------------------ use default definition of tag  
       my $sub="start_$token->[1]";  
         {  
  no strict 'refs';  
          if (defined (&$sub)) {  
            $currentstring = &$sub($target,$token,\@parstack);  
            $finaloutput .= $currentstring;  
            $currentstring = '';  
  } else {  
    $finaloutput .= $token->[4];  
  }   }
          use strict 'refs';              # generate the my mechanism
  }   # map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
    }                 print "Temp: $parstack[$#parstack]\n";
   } elsif ($token->[0] eq 'E')  {   $oustring .= &Apache::run::evaluate($partstring,$safeeval,$parstack[$#parstack]);
 # Put here check for correct final tag (to avoid existence of starting tag only)         }
                  $finaloutput .= $oustring;
        } else {
          my $sub="start_$token->[1]";
          #print "use default definition of tag $sub\n";
          my $result = &callsub($sub, $target, $token, \@parstack);
          $finaloutput .= &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
        }              
      } elsif ($token->[0] eq 'E')  {
        # 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]";
        {         $finaloutput .= callsub($sub, $target, $token, \@parstack);
  no strict 'refs';  
           if (defined (&$sub)) {  
  $currentstring = &$sub($target,$token,\@parstack);  
                 $finaloutput .= $currentstring;  
                 $currentstring = '';  
   } else {  
                 $finaloutput .= $token->[4];  
   }  
  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 112  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];     
      } elsif ($tokenpat->[0] eq 'T') {     $partstring .=  $tokenpat->[4];
                        $partstring .=  $tokenpat->[1];   } elsif ($tokenpat->[0] eq 'T') {
      } elsif ($tokenpat->[0] eq 'E') {     $partstring .=  $tokenpat->[1];
                        $partstring .=  $tokenpat->[2];   } elsif ($tokenpat->[0] eq 'E') {
                      }     $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; 
                                         print "want to use run\n";
                &run($partstring,$safeeval);                 &Apache::run::run($partstring,$safeeval);
          
                $partstring = '';                 $partstring = '';
      } elsif ($tokenpat->[1] eq 'evaluate') {       } elsif ($tokenpat->[1] eq 'evaluate') {
         $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);         $outputstring = &Apache::run::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;
 }  }
   
   sub callsub {
     my ($sub,$target,$token,@parstack)=@_;
     my $currentstring='';
     {
       no strict 'refs';
       if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
         #print "Calling sub $sub in $space \n";
         $sub="$space\:\:$sub";
         $currentstring = &$sub($target,$token,\@parstack);
       } else {
         #print "NOT Calling sub $sub\n";
         if (defined($token->[4])) {
    $currentstring = $token->[4];
         } else {
    $currentstring = $token->[2];
         }
       }
       use strict 'refs';
     }
     return $currentstring;
   }
   
 1;  1;
 __END__  __END__
Removed from v.1.4  
changed lines
  Added in v.1.7

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