Annotation of loncom/xml/style.pm, revision 1.5
1.1 sakharuk 1: # The LearningOnline Network with CAPA
2: # Style Parser Module
3: #
1.4 sakharuk 4: # last modified 06/29/00 by Alexander Sakharuk
1.1 sakharuk 5:
1.2 albertel 6: package Apache::style;
1.1 sakharuk 7:
8: use strict;
9: use HTML::TokeParser;
10:
11: sub styleparser {
12:
13: my ($target,$content_style_string) = @_;
1.4 sakharuk 14: my @target_list = ('target','web','tex','edit','modified','rat','answer','metadis');
1.1 sakharuk 15: my @value_style = ();
16: my $current_key = '';
17: my $current_value = '';
18: my $stoken;
19: my $flag;
20: my $iele;
1.4 sakharuk 21: my $flag_target;
1.1 sakharuk 22:
23: my $pstyle = HTML::TokeParser->new(\$content_style_string);
24:
25: while ($stoken = $pstyle->get_token) {
1.4 sakharuk 26: # start for tag definition
1.1 sakharuk 27: if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') {
1.4 sakharuk 28: # new key in hash
29: $current_key = $stoken->[2]{name};
30: $flag = 0;
31: # metadata output
32: if ($target eq 'meta') {
33: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag') {
34: if ($stoken->[0] eq 'S' and $stoken->[1] eq 'meta') {
35: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'meta') {
36: $current_value .= $stoken->[1];
37: }
38: }
1.1 sakharuk 39: }
1.4 sakharuk 40: } else {
41: # render output
42: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'render') {
43: if ($stoken->[1] eq 'definetag') {
44: $flag = 1;
45: last;
46: }
1.1 sakharuk 47: }
1.4 sakharuk 48: if ($flag == 0) {
49: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag'
50: and $stoken->[1] ne 'render') {
51: # if token not equal to target $flag_target=0
52: $flag_target = 0;
53: for (my $i=0; $i<$#target_list; $i++) {
54: if ($stoken->[1] eq $target_list[$i]) {
55: $flag_target = 1;
56: }
57: }
58: if ($flag_target == 0) {
59: # target not found
60: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
61: $current_value .= $tempo_out;
62: } else {
63: # target found
64: if ($stoken->[0] eq 'S' and $stoken->[1] eq 'target') {
65: # target defined via <target> tag
66: if (defined $stoken->[2]{dest}) {
67: if (index($stoken->[2]{dest},$target) == -1) {
68: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
69: }
70: } elsif (index($stoken->[2]{dest},$target) != -1) {
71: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
72: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
73: $current_value .= $tempo_out;
74: }
75: }
76: } else {
77: if (index($stoken->[2]{excl},$target) != -1) {
78: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
79: }
80: } elsif (index($stoken->[2]{excl},$target) == -1) {
81: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
82: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
83: $current_value .= $tempo_out;
84: }
85: }
86:
87:
88: }
89: } elsif ($stoken->[1] ne $target) {
90: #target defined via short-form tag
91: my $tempo_token = $stoken->[1];
92: while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) {
93: }
94: } else {
95: my $tempo_token = $stoken->[1];
96: while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) {
97: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
98: $current_value .= $tempo_out;
99: }
100: }
101: }
102: }
1.1 sakharuk 103:
104: }
1.4 sakharuk 105: }
1.1 sakharuk 106: }
107: $current_value =~ s/(\s)+/$1/g;
1.5 ! sakharuk 108: if ($current_value ne '' ) {
1.1 sakharuk 109: push (@value_style,lc $current_key,$current_value);
1.4 sakharuk 110: }
111: $current_key = '';
112: $current_value = '';
1.1 sakharuk 113: }
114: my %style_for_target = @value_style;
1.4 sakharuk 115: # check printing
1.5 ! sakharuk 116: # while (($current_key,$current_value) = each %style_for_target) {
! 117: # print "$current_key => $current_value\n";
! 118: # }
1.4 sakharuk 119: # return result
1.1 sakharuk 120: return %style_for_target;
1.4 sakharuk 121: }
122:
123: sub test {
124:
125: my ($zeroth,$first,$second,$fourth,@value_style) = @_;
126: my $current_value = '';
127: my $num;
128: my $flag;
129:
130: if ($zeroth eq 'T') {
131: $current_value .= $first;
132: } elsif ($zeroth eq 'S') {
133: $flag = 0;
134: for (my $i=$#value_style-1;$i>=0;$i=$i-2) {
135: if ($first eq $value_style[$i]) {
136: $flag = 1;
137: $num = $i + 1;
138: last;
139: }
140: }
141: if ($flag == 0) {
142: $current_value .= $fourth;
143: } else {
144: $current_value .= $value_style[$num];
145: }
146: } elsif ($zeroth eq 'E') {
147: $flag = 0;
148: for (my $i=$#value_style-1;$i>=0;$i=$i-2) {
149: if ($first eq $value_style[$i]) {
150: $flag = 1;
151: $num = $i + 1;
152: last;
153: }
154: }
155: if ($flag == 0) {
156: $current_value .= $second;
157: } else {
158: $current_value .= $value_style[$num];
159: }
160: }
161: return $current_value;
1.1 sakharuk 162: }
163:
164: 1;
165: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to style.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml