Annotation of loncom/xml/style.pm, revision 1.7

1.1       sakharuk    1: # The LearningOnline Network with CAPA
1.7     ! sakharuk    2: # Style Parser Module (new version)
        !             3: #
        !             4: # written 01/08/01 by Alexander Sakharuk
1.1       sakharuk    5: #
                      6: 
1.7     ! sakharuk    7: package Apache::style;
1.1       sakharuk    8: 
                      9: use strict;
                     10: use HTML::TokeParser;
                     11: 
                     12: sub styleparser {
                     13: 
1.7     ! sakharuk   14:     my ($target,$content_style_string) = @_;
        !            15:     my $current_key = '';
        !            16:     my $current_value = '';
        !            17:     my @keys = ();
        !            18:     my @values = ();
        !            19:     my @style_array = ();
        !            20:     my $stoken;
        !            21: 
        !            22:     my $b_pos;
        !            23:     my $e_pos;
        !            24:     my $entry;
        !            25: 
        !            26:     $b_pos = index($content_style_string,'<definetag',0);
        !            27:     while ($b_pos != -1) {
        !            28: 	$e_pos = index($content_style_string,'</definetag',$b_pos);
        !            29: 	$entry = substr($content_style_string,$b_pos,$e_pos-$b_pos+12);       
        !            30: 	$_ = $entry;
        !            31: 	m/<definetag\s+name\s*=\s*\"([^\"]*)\"/;
        !            32: 	$current_key = $1;
        !            33: 	push @keys,$current_key;
        !            34: #	print "$current_key\n";
        !            35: 	my $b_position =  index($entry,'<'.$target.'>',0);
        !            36: 	my $e_position =  index($entry,'</'.$target.'>',$b_position);
        !            37: 	my $target_length = length($target) + 2;
        !            38: 	if ($b_position > -1) {
        !            39: 	    my $entry_target = substr($entry,$b_position+$target_length,$e_position-$b_position-$target_length);
        !            40: 	    my $pstyle = HTML::TokeParser->new(\$entry_target);
        !            41: 	    while ($stoken = $pstyle->get_token) {
        !            42: 		if ($stoken->[0] eq 'T') {
        !            43: 		    $current_value .= $stoken->[1];
        !            44: 		} elsif ($stoken->[0] eq 'S') {
        !            45: 		    my $number = &testkey($stoken->[0],$stoken->[1],@keys);
        !            46: 		    if ($number != -1) {
        !            47: 			$current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values);
        !            48: 		    } else {
        !            49: 			$current_value .= $stoken->[4];
        !            50: 		    } 
        !            51: 	        } else {
        !            52: 		    my $number = &testkey($stoken->[0],$stoken->[1],@keys);
        !            53: 		    if ($number != -1) {
        !            54: 			$current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values);
1.4       sakharuk   55: 		    } else {
1.7     ! sakharuk   56: 			$current_value .= $stoken->[2];
        !            57: 		    } 
        !            58: 	        }
        !            59: 
        !            60: 
        !            61: 
        !            62: 	    } 
1.4       sakharuk   63: 	}
1.7     ! sakharuk   64: 	push @values,$current_value;
        !            65: #	print "a:$current_value $#values \n";
        !            66: 	$current_key = '';
        !            67: 	$current_value ='';
        !            68: 	$b_pos = index($content_style_string,'<definetag',$b_pos+1);
        !            69:     }
        !            70: 
        !            71:     for (my $i=0; $i<=$#keys; $i++) {
        !            72: 	push @style_array,$keys[$i],$values[$i]; 
        !            73:     }
        !            74:     my %style_for_target = @style_array;
1.1       sakharuk   75: 
1.4       sakharuk   76: # check printing
1.7     ! sakharuk   77:   while (($current_key,$current_value) = each %style_for_target) {
        !            78:       print "$current_key => $current_value\n";
        !            79:   }
1.4       sakharuk   80: # return result
1.1       sakharuk   81:   return %style_for_target; 
1.7     ! sakharuk   82: 
1.4       sakharuk   83: }
                     84: 
1.7     ! sakharuk   85: sub testkey {
1.4       sakharuk   86: 
1.7     ! sakharuk   87:     my ($zeroth,$first,@keys) = @_; 
        !            88:     my $number = -1;
        !            89:     if ($zeroth eq 'S') {
        !            90: 	for (my $i=$#keys; $i>=0; $i=$i-1) {
        !            91: 	    if ($first eq lc($keys[$i]))  { 
        !            92: 		$number = $i;
        !            93: 		last;
1.4       sakharuk   94: 	    }
1.7     ! sakharuk   95: 	}
        !            96:     } elsif ($zeroth eq 'E') {
        !            97: 	for (my $i=$#keys; $i>=0; $i=$i-1) {
        !            98: 	    if ('/'.$first eq lc($keys[$i]))  { 
        !            99: 		$number = $i;
        !           100: 	 	last;
1.4       sakharuk  101: 	    }
1.7     ! sakharuk  102: 	}
        !           103:     }
        !           104: 	return $number;
        !           105: }
        !           106: 
        !           107: sub testvalue {
        !           108: 
        !           109:     my ($number,$zeroth,$second,@values) = @_;   
        !           110:     my $current_content = $values[$number];
        !           111:     if ($zeroth eq 'S') {
        !           112:     my %tempo_hash = %$second;
        !           113:     while ((my $current_k,my $current_v) = each %tempo_hash) {
        !           114:         $current_content =~ s/\$$current_k/$current_v/g;
        !           115:     }
        !           116:     } elsif ($zeroth eq 'E') {
        !           117:         $current_content = $values[$number];
        !           118:     }
        !           119:     return $current_content;
1.1       sakharuk  120: }
                    121: 
                    122: 1;
1.7     ! sakharuk  123: 
1.1       sakharuk  124: __END__

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