--- loncom/xml/lonxml.pm	2000/06/23 20:40:06	1.2
+++ loncom/xml/lonxml.pm	2000/06/26 21:35:20	1.3
@@ -1,148 +1,192 @@
 # The LearningOnline Network with CAPA
-# Style Parser Module 
+# XML Parser Module 
 #
-# last modified 06/23/00 by Alexander Sakharuk
+# last modified 06/26/00 by Alexander Sakharuk
 
-package Apache::lonstyleparser; 
+package Apache::lonxmlparser; 
 
 use strict;
 use HTML::TokeParser;
-
-#============================================================= style subroutine 
-
-sub styleparser {
-
-  my ($target,$content_style_string) = @_;
-
-#------------------------------------------- target redefinition (if necessary) 
-    
-  my @target_string = '';
-  my $element;
-   
-  ($element,@target_string) = split ('&&',$target);
-
-  map {$content_style_string =~ s/\<(.*)$_\>/\<$1$element\>/g; } @target_string;
-   
-  $target = $element;
-   
-#-------------------------------------------- create a table for defined target
-#----------------------------------------- from the information from Style File
-
-  my @value_style = ();
-  my $current_key = '';
-  my $current_value = '';
-  my $stoken;
-  my $flag;                  
-  my $iele;
-
-  my $pstyle = HTML::TokeParser->new(\$content_style_string);
-
-  while ($stoken = $pstyle->get_token) {
-#----------------------------------------------------- start for tag definition
-   if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') {
-#-------------------------------------------------------------- new key in hash
-    $current_key = $stoken->[2]{name};
-    $flag = 0;
-#-------------------------------------------------------------- metadata output
-    if ($target eq 'meta') {
-     while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag') { 
-       if ($stoken->[0] eq 'S' and $stoken->[1] eq 'meta') {
-        while ($stoken = $pstyle->get_token and $stoken->[1] ne 'meta') {
-	    $current_value .= $stoken->[1];
-        }
+use Safe;
+use Apache::lonstyleparser;
+use Apache::lontexconvert;
+use Apache::londefaulttags;
+#==================================================   Main subroutine: xmlparse  
+
+sub xmlparse {
+
+ my ($target,$content_file_string,%style_for_target) = @_;
+ my $pars = HTML::TokeParser->new(\$content_file_string);
+ my $currentstring = '';
+ my $finaloutput = ''; 
+ my $newarg = '';
+ my $tempostring = '';
+ my $tempocont = '';
+ my $safeeval = new Safe;
+
+#-------------------- Redefinition of the target in the case of compound target
+
+ ($target, my @tenta) = split('&&',$target);
+
+#------------------------- Stack definition (in stack we have all current tags)
+
+ my @stack = (); 
+ my @parstack = ();
+
+#------------------------------------- Parse input string (content_file_string)
+ 
+ my $token;
+
+ while ($token = $pars->get_token) {
+  if ($token->[0] eq 'T') {
+    $finaloutput .= $token->[1];
+    $tempocont .= $token->[1];
+  } elsif ($token->[0] eq 'S') {
+#------------------------------------------------------------- add tag to stack 	    
+  push (@stack,$token->[1]);
+#----------------------------------------- add parameters list to another stack
+  map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};
+  push (@parstack,$tempostring);
+  $tempostring = '';
+
+   if (exists $style_for_target{$token->[1]}) { 
+
+#---------------------------------------------------- use style file definition
+
+    $newarg = $style_for_target{$token->[1]};
+
+    if (index($newarg,'script') != -1 ) {
+      my $pat = HTML::TokeParser->new(\$newarg);
+      my $tokenpat;
+      my $partstring = '';
+      my $oustring = '';
+      my $outputstring;
+
+       while  ($tokenpat = $pat->get_token) {
+	if ($tokenpat->[0] eq 'T') {
+	  $oustring .= $tokenpat->[1];
+	} elsif ($tokenpat->[0] eq 'S') {
+           if ($tokenpat->[1] eq 'script') {
+             while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
+                   if ($tokenpat->[0] eq 'S')  {
+		     $partstring .=  $tokenpat->[4];
+		   } elsif ($tokenpat->[0] eq 'T') {
+                     $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 {
-#--------------------------------------------------------------- outtext output
-     while ($stoken = $pstyle->get_token and $stoken->[1] ne 'outtext') {
-	   if ($stoken->[1] eq 'definetag') {
-	     $flag = 1;
-             last;
-	   }
-      }
-     if ($flag == 0) { 
-       while ($stoken = $pstyle->get_token and $stoken->[0] ne 'S') {
-	    $current_value .= $stoken->[1];
+       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';    
+	}
+   }              
+  } elsif ($token->[0] eq 'E')  {
+# Put here check for correct final tag (to avoid existence of starting tag only)
+        
+     pop @stack; 
+     unless (exists $style_for_target{$token->[1]}) {
+      my $sub="end_$token->[1]";
+       {
+	no strict 'refs';
+          if (defined (&$sub)) {
+		$currentstring = &$sub($target,$token,\@parstack);
+                $finaloutput .= $currentstring;
+                $currentstring = '';
+	  } else {
+                $finaloutput .= $token->[4];
+	  }
+	use strict 'refs';
        }
-      while ($stoken->[1] ne 'definetag') {
-       if ($stoken->[0] eq 'S' and $stoken->[1] eq $target) {
-	while ($stoken = $pstyle->get_token) {
-	 if ($stoken->[1] ne $target) {
-	   if ($stoken->[0] eq 'S') {
-	       my $flagelem = 0;
-               for (my $i=$#value_style-1;$i>0;$i=$i-2) {
-		   if ($stoken->[1] eq $value_style[$i]) {
-		       $flagelem = 1;
-                       $iele = $i+1;
-                       last;
-		   }
-	       }
-	       if ($flagelem == 0) {
-	         $current_value .= $stoken->[4];
-     	       } else {
-		   $current_value .= $value_style[$iele];
-	       }
-	   } 
-           if ($stoken->[0] eq 'E') {
-	       my $flagelem = 0;
-               for (my $i=$#value_style-1;$i>0;$i=$i-2) {
-		   if ('/'.$stoken->[1] eq $value_style[$i]) {
-		       $flagelem = 1;
-                       $iele = $i+1;
-                       last;
-		   }
-	       }
-	       if ($flagelem == 0) {
-                 $current_value .= $stoken->[2];
-     	       } else {
-		   $current_value .= $value_style[$iele];
+     }
+#-------------------------------------------------- end tag from the style file
+     if (exists $style_for_target{'/'."$token->[1]"}) {
+       $newarg = $style_for_target{'/'."$token->[1]"};
+       if (index($newarg,'script') != -1 ) {
+         my $pat = HTML::TokeParser->new(\$newarg);
+         my $tokenpat;
+         my $partstring = '';
+         my $oustring = '';
+         my $outputstring;
+
+         while  ($tokenpat = $pat->get_token) {
+	  if ($tokenpat->[0] eq 'T') {
+	    $oustring .= $tokenpat->[1];
+      	  } elsif ($tokenpat->[0] eq 'S') {
+             if ($tokenpat->[1] eq 'script') {
+               while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
+                     if ($tokenpat->[0] eq 'S')  {
+		       $partstring .=  $tokenpat->[4];
+		     } elsif ($tokenpat->[0] eq 'T') {
+                       $partstring .=  $tokenpat->[1];
+		     } elsif ($tokenpat->[0] eq 'E') {
+                       $partstring .=  $tokenpat->[2];
+                     }
 	       }
-	   } 
-           if ($stoken->[0] eq 'T') {
-             $current_value .= $stoken->[1]; 
-	   }                 
-	 }  else {      
-		last;
-	 }
-        }
-       } elsif ($stoken->[0] eq 'S' and $stoken->[1] ne $target) {
-	  my $tempotempo = $stoken->[1];
-	   while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempotempo) {
-	   }
+	
+               my @tempor_list = split(',',$parstack[$#parstack]);
+               my @te_kl = ();
+               my %tempor_hash = ();
+               map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); 
+                    $tempor_hash{$onete} = $twote} @tempor_list;
+               map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; 
+                               
+               &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 {
+         my @very_temp = split(',',@parstack[$#parstack]);
+         map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;
        }
 
-       while ($stoken = $pstyle->get_token) {
-        if ($stoken->[0] eq 'T') {
-          $current_value .= $stoken->[1];
-	} 
-        if ($stoken->[0] eq 'E') {
-	  last;
-	} 
-        if ($stoken->[0] eq 'S') {
-	  last;
-	}
-       }	     
-    
-      }
+       $finaloutput .= $newarg; 
      }
-    }
-    
-   }    
-   $current_value =~ s/(\s)+/$1/g;
-     if ($current_value ne ' ' and $current_value ne '' ) {  
-       push (@value_style,lc $current_key,$current_value);
-     }
-     $current_key = '';
-     $current_value = '';         
-
-  }  
-  my %style_for_target = @value_style;   
-#--------------------------------------------------------------- check printing
-#  while (($current_key,$current_value) = each %style_for_target) {
-#       print "$current_key => $current_value\n";
-#  }
-#---------------------------------------------------------------- return result
-  return %style_for_target; 
+     pop @parstack;
+  }
+ }
+ return $finaloutput;
 }
 
 1;