Annotation of loncom/xml/style.pm, revision 1.8
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.7 sakharuk 64: push @values,$current_value;
1.8 ! albertel 65: # &Apache::lonxml::debug("a:$current_value $#values \n");
1.7 sakharuk 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) {
1.8 ! albertel 78: &Apache::lonxml::debug("$current_key => $current_value\n");
1.7 sakharuk 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>