Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

Annotation of loncom/xml/lonxml.pm, revision 1.4

1.2       sakharuk    1: # The LearningOnline Network with CAPA
1.3       sakharuk    2: # XML Parser Module 
1.2       sakharuk    3: #
1.3       sakharuk    4: # last modified 06/26/00 by Alexander Sakharuk
1.2       sakharuk    5: 
1.4     ! albertel    6: package Apache::lonxml; 
1.1       sakharuk    7: 
                      8: use strict;
                      9: use HTML::TokeParser;
1.3       sakharuk   10: use Safe;
1.4     ! albertel   11: use Apache::style;
1.3       sakharuk   12: use Apache::lontexconvert;
1.4     ! albertel   13: use Apache::londefdef;
1.3       sakharuk   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: 	}
1.2       sakharuk   94:        }
1.3       sakharuk   95:        $newarg =  $oustring;
1.2       sakharuk   96:     } else {
1.3       sakharuk   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';
1.2       sakharuk  131:        }
1.3       sakharuk  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:                      }
1.2       sakharuk  156: 	       }
1.3       sakharuk  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;
1.2       sakharuk  182:        }
                    183: 
1.3       sakharuk  184:        $finaloutput .= $newarg; 
1.2       sakharuk  185:      }
1.3       sakharuk  186:      pop @parstack;
                    187:   }
                    188:  }
                    189:  return $finaloutput;
1.1       sakharuk  190: }
                    191: 
                    192: 1;
                    193: __END__