Annotation of loncom/xml/style.pm, revision 1.12
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;
1.8 albertel 34: # &Apache::lonxml::debug("$current_key\n");
1.7 sakharuk 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.9 sakharuk 64: $current_value =~ s/\n//g;
1.12 ! sakharuk 65: ###########
! 66: # $current_value =~ s/^\s*//g;
! 67: # $current_value =~ s/\s*$//g;
! 68: # $current_value =~ s/\( (\w)/($1/g;
! 69: ###########
1.7 sakharuk 70: push @values,$current_value;
1.8 albertel 71: # &Apache::lonxml::debug("a:$current_value $#values \n");
1.7 sakharuk 72: $current_key = '';
73: $current_value ='';
74: $b_pos = index($content_style_string,'<definetag',$b_pos+1);
75: }
76:
77: for (my $i=0; $i<=$#keys; $i++) {
1.11 sakharuk 78: push @style_array,$keys[$i],$values[$i];
1.7 sakharuk 79: }
1.9 sakharuk 80: my %style_for_target = @style_array;
1.1 sakharuk 81:
1.4 sakharuk 82: # check printing
1.11 sakharuk 83: # foreach $current_key (sort keys %style_for_target) {
84: # &Apache::lonxml::debug("$current_key => $style_for_target{$current_key}\n");
85: # }
1.4 sakharuk 86: # return result
1.1 sakharuk 87: return %style_for_target;
1.7 sakharuk 88:
1.4 sakharuk 89: }
90:
1.7 sakharuk 91: sub testkey {
1.4 sakharuk 92:
1.7 sakharuk 93: my ($zeroth,$first,@keys) = @_;
94: my $number = -1;
95: if ($zeroth eq 'S') {
96: for (my $i=$#keys; $i>=0; $i=$i-1) {
97: if ($first eq lc($keys[$i])) {
98: $number = $i;
99: last;
1.4 sakharuk 100: }
1.7 sakharuk 101: }
102: } elsif ($zeroth eq 'E') {
103: for (my $i=$#keys; $i>=0; $i=$i-1) {
104: if ('/'.$first eq lc($keys[$i])) {
105: $number = $i;
106: last;
1.4 sakharuk 107: }
1.7 sakharuk 108: }
109: }
110: return $number;
111: }
112:
113: sub testvalue {
114:
115: my ($number,$zeroth,$second,@values) = @_;
116: my $current_content = $values[$number];
117: if ($zeroth eq 'S') {
118: my %tempo_hash = %$second;
119: while ((my $current_k,my $current_v) = each %tempo_hash) {
120: $current_content =~ s/\$$current_k/$current_v/g;
121: }
122: } elsif ($zeroth eq 'E') {
123: $current_content = $values[$number];
124: }
125: return $current_content;
1.1 sakharuk 126: }
127:
128: 1;
1.7 sakharuk 129:
1.1 sakharuk 130: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>