Annotation of loncom/xml/style.pm, revision 1.6
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') {
1.6 ! sakharuk 36: if ($stoken->[0] eq 'T') {
! 37: $current_value .= $stoken->[1];
! 38: } elsif ($stoken->[0] eq 'S') {
! 39: $current_value .= $stoken->[4];
! 40: } else {
! 41: $current_value .= $stoken->[2];
! 42: }
1.4 sakharuk 43: }
44: }
1.1 sakharuk 45: }
1.4 sakharuk 46: } else {
47: # render output
48: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'render') {
49: if ($stoken->[1] eq 'definetag') {
50: $flag = 1;
51: last;
52: }
1.1 sakharuk 53: }
1.4 sakharuk 54: if ($flag == 0) {
55: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag'
56: and $stoken->[1] ne 'render') {
57: # if token not equal to target $flag_target=0
58: $flag_target = 0;
59: for (my $i=0; $i<$#target_list; $i++) {
60: if ($stoken->[1] eq $target_list[$i]) {
61: $flag_target = 1;
62: }
63: }
64: if ($flag_target == 0) {
65: # target not found
66: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
67: $current_value .= $tempo_out;
68: } else {
69: # target found
70: if ($stoken->[0] eq 'S' and $stoken->[1] eq 'target') {
71: # target defined via <target> tag
72: if (defined $stoken->[2]{dest}) {
73: if (index($stoken->[2]{dest},$target) == -1) {
74: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
75: }
76: } elsif (index($stoken->[2]{dest},$target) != -1) {
77: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
78: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
79: $current_value .= $tempo_out;
80: }
81: }
82: } else {
83: if (index($stoken->[2]{excl},$target) != -1) {
84: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
85: }
86: } elsif (index($stoken->[2]{excl},$target) == -1) {
87: while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') {
88: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
89: $current_value .= $tempo_out;
90: }
91: }
92:
93:
94: }
95: } elsif ($stoken->[1] ne $target) {
96: #target defined via short-form tag
97: my $tempo_token = $stoken->[1];
98: while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) {
99: }
100: } else {
101: my $tempo_token = $stoken->[1];
102: while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) {
103: my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style);
104: $current_value .= $tempo_out;
105: }
106: }
107: }
108: }
1.1 sakharuk 109:
110: }
1.4 sakharuk 111: }
1.1 sakharuk 112: }
113: $current_value =~ s/(\s)+/$1/g;
1.5 sakharuk 114: if ($current_value ne '' ) {
1.1 sakharuk 115: push (@value_style,lc $current_key,$current_value);
1.4 sakharuk 116: }
117: $current_key = '';
118: $current_value = '';
1.1 sakharuk 119: }
120: my %style_for_target = @value_style;
1.4 sakharuk 121: # check printing
1.5 sakharuk 122: # while (($current_key,$current_value) = each %style_for_target) {
123: # print "$current_key => $current_value\n";
124: # }
1.4 sakharuk 125: # return result
1.1 sakharuk 126: return %style_for_target;
1.4 sakharuk 127: }
128:
129: sub test {
130:
131: my ($zeroth,$first,$second,$fourth,@value_style) = @_;
132: my $current_value = '';
133: my $num;
134: my $flag;
135:
136: if ($zeroth eq 'T') {
137: $current_value .= $first;
138: } elsif ($zeroth eq 'S') {
139: $flag = 0;
140: for (my $i=$#value_style-1;$i>=0;$i=$i-2) {
141: if ($first eq $value_style[$i]) {
142: $flag = 1;
143: $num = $i + 1;
144: last;
145: }
146: }
147: if ($flag == 0) {
148: $current_value .= $fourth;
149: } else {
150: $current_value .= $value_style[$num];
151: }
152: } elsif ($zeroth eq 'E') {
153: $flag = 0;
154: for (my $i=$#value_style-1;$i>=0;$i=$i-2) {
155: if ($first eq $value_style[$i]) {
156: $flag = 1;
157: $num = $i + 1;
158: last;
159: }
160: }
161: if ($flag == 0) {
162: $current_value .= $second;
163: } else {
164: $current_value .= $value_style[$num];
165: }
166: }
167: return $current_value;
1.1 sakharuk 168: }
169:
170: 1;
171: __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