Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

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

1.2     ! sakharuk    1: # The LearningOnline Network with CAPA
        !             2: # Style Parser Module 
        !             3: #
        !             4: # last modified 06/23/00 by Alexander Sakharuk
        !             5: 
        !             6: package Apache::lonstyleparser; 
1.1       sakharuk    7: 
                      8: use strict;
                      9: use HTML::TokeParser;
                     10: 
1.2     ! sakharuk   11: #============================================================= style subroutine 
1.1       sakharuk   12: 
                     13: sub styleparser {
                     14: 
1.2     ! sakharuk   15:   my ($target,$content_style_string) = @_;
1.1       sakharuk   16: 
1.2     ! sakharuk   17: #------------------------------------------- target redefinition (if necessary) 
1.1       sakharuk   18:     
1.2     ! sakharuk   19:   my @target_string = '';
        !            20:   my $element;
1.1       sakharuk   21:    
1.2     ! sakharuk   22:   ($element,@target_string) = split ('&&',$target);
1.1       sakharuk   23: 
1.2     ! sakharuk   24:   map {$content_style_string =~ s/\<(.*)$_\>/\<$1$element\>/g; } @target_string;
1.1       sakharuk   25:    
1.2     ! sakharuk   26:   $target = $element;
1.1       sakharuk   27:    
1.2     ! sakharuk   28: #-------------------------------------------- create a table for defined target
        !            29: #----------------------------------------- from the information from Style File
1.1       sakharuk   30: 
1.2     ! sakharuk   31:   my @value_style = ();
        !            32:   my $current_key = '';
        !            33:   my $current_value = '';
        !            34:   my $stoken;
        !            35:   my $flag;                  
        !            36:   my $iele;
        !            37: 
        !            38:   my $pstyle = HTML::TokeParser->new(\$content_style_string);
        !            39: 
        !            40:   while ($stoken = $pstyle->get_token) {
        !            41: #----------------------------------------------------- start for tag definition
        !            42:    if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') {
        !            43: #-------------------------------------------------------------- new key in hash
        !            44:     $current_key = $stoken->[2]{name};
        !            45:     $flag = 0;
        !            46: #-------------------------------------------------------------- metadata output
        !            47:     if ($target eq 'meta') {
        !            48:      while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag') { 
        !            49:        if ($stoken->[0] eq 'S' and $stoken->[1] eq 'meta') {
        !            50:         while ($stoken = $pstyle->get_token and $stoken->[1] ne 'meta') {
        !            51: 	    $current_value .= $stoken->[1];
        !            52:         }
        !            53:        }
        !            54:      }
        !            55:     } else {
        !            56: #--------------------------------------------------------------- outtext output
        !            57:      while ($stoken = $pstyle->get_token and $stoken->[1] ne 'outtext') {
        !            58: 	   if ($stoken->[1] eq 'definetag') {
        !            59: 	     $flag = 1;
        !            60:              last;
        !            61: 	   }
        !            62:       }
        !            63:      if ($flag == 0) { 
        !            64:        while ($stoken = $pstyle->get_token and $stoken->[0] ne 'S') {
        !            65: 	    $current_value .= $stoken->[1];
        !            66:        }
        !            67:       while ($stoken->[1] ne 'definetag') {
        !            68:        if ($stoken->[0] eq 'S' and $stoken->[1] eq $target) {
        !            69: 	while ($stoken = $pstyle->get_token) {
        !            70: 	 if ($stoken->[1] ne $target) {
        !            71: 	   if ($stoken->[0] eq 'S') {
        !            72: 	       my $flagelem = 0;
        !            73:                for (my $i=$#value_style-1;$i>0;$i=$i-2) {
        !            74: 		   if ($stoken->[1] eq $value_style[$i]) {
        !            75: 		       $flagelem = 1;
        !            76:                        $iele = $i+1;
        !            77:                        last;
        !            78: 		   }
        !            79: 	       }
        !            80: 	       if ($flagelem == 0) {
        !            81: 	         $current_value .= $stoken->[4];
        !            82:      	       } else {
        !            83: 		   $current_value .= $value_style[$iele];
        !            84: 	       }
        !            85: 	   } 
        !            86:            if ($stoken->[0] eq 'E') {
        !            87: 	       my $flagelem = 0;
        !            88:                for (my $i=$#value_style-1;$i>0;$i=$i-2) {
        !            89: 		   if ('/'.$stoken->[1] eq $value_style[$i]) {
        !            90: 		       $flagelem = 1;
        !            91:                        $iele = $i+1;
        !            92:                        last;
        !            93: 		   }
        !            94: 	       }
        !            95: 	       if ($flagelem == 0) {
        !            96:                  $current_value .= $stoken->[2];
        !            97:      	       } else {
        !            98: 		   $current_value .= $value_style[$iele];
        !            99: 	       }
        !           100: 	   } 
        !           101:            if ($stoken->[0] eq 'T') {
        !           102:              $current_value .= $stoken->[1]; 
        !           103: 	   }                 
        !           104: 	 }  else {      
        !           105: 		last;
        !           106: 	 }
        !           107:         }
        !           108:        } elsif ($stoken->[0] eq 'S' and $stoken->[1] ne $target) {
        !           109: 	  my $tempotempo = $stoken->[1];
        !           110: 	   while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempotempo) {
        !           111: 	   }
        !           112:        }
        !           113: 
        !           114:        while ($stoken = $pstyle->get_token) {
        !           115:         if ($stoken->[0] eq 'T') {
        !           116:           $current_value .= $stoken->[1];
        !           117: 	} 
        !           118:         if ($stoken->[0] eq 'E') {
        !           119: 	  last;
        !           120: 	} 
        !           121:         if ($stoken->[0] eq 'S') {
        !           122: 	  last;
        !           123: 	}
        !           124:        }	     
1.1       sakharuk  125:     
1.2     ! sakharuk  126:       }
        !           127:      }
        !           128:     }
1.1       sakharuk  129:     
1.2     ! sakharuk  130:    }    
        !           131:    $current_value =~ s/(\s)+/$1/g;
        !           132:      if ($current_value ne ' ' and $current_value ne '' ) {  
        !           133:        push (@value_style,lc $current_key,$current_value);
        !           134:      }
        !           135:      $current_key = '';
        !           136:      $current_value = '';         
        !           137: 
        !           138:   }  
        !           139:   my %style_for_target = @value_style;   
        !           140: #--------------------------------------------------------------- check printing
        !           141: #  while (($current_key,$current_value) = each %style_for_target) {
1.1       sakharuk  142: #       print "$current_key => $current_value\n";
1.2     ! sakharuk  143: #  }
        !           144: #---------------------------------------------------------------- return result
        !           145:   return %style_for_target; 
1.1       sakharuk  146: }
                    147: 
                    148: 1;
                    149: __END__