Annotation of loncom/xml/style.pm, revision 1.4
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.4 ! sakharuk 108: if ($current_value ne ' ' and $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
! 116: while (($current_key,$current_value) = each %style_for_target) {
! 117: print "$current_key => $current_value\n";
! 118: }
! 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