Annotation of loncom/xml/style.pm, revision 1.7
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;
! 34: # print "$current_key\n";
! 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;
! 65: # print "a:$current_value $#values \n";
! 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) {
! 78: print "$current_key => $current_value\n";
! 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>