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