--- loncom/xml/style.pm 2001/11/29 19:03:58 1.13 +++ loncom/xml/style.pm 2008/11/24 18:55:01 1.22 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Style Parser Module (new version) # -# $Id: style.pm,v 1.13 2001/11/29 19:03:58 www Exp $ +# $Id: style.pm,v 1.22 2008/11/24 18:55:01 jms Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,83 +46,83 @@ use HTML::TokeParser; sub styleparser { - my ($target,$content_style_string) = @_; - my $current_key = ''; - my $current_value = ''; + my ($target,$content_style_string)=@_; my @keys = (); my @values = (); - my @style_array = (); - my $stoken; - - my $b_pos; - my $e_pos; - my $entry; - - $b_pos = index($content_style_string,'',0); - my $e_position = index($entry,'',$b_position); - my $target_length = length($target) + 2; - if ($b_position > -1) { - my $entry_target = substr($entry,$b_position+$target_length,$e_position-$b_position-$target_length); - my $pstyle = HTML::TokeParser->new(\$entry_target); - while ($stoken = $pstyle->get_token) { - if ($stoken->[0] eq 'T') { - $current_value .= $stoken->[1]; - } elsif ($stoken->[0] eq 'S') { - my $number = &testkey($stoken->[0],$stoken->[1],@keys); - if ($number != -1) { - $current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values); - } else { - $current_value .= $stoken->[4]; - } - } else { - my $number = &testkey($stoken->[0],$stoken->[1],@keys); - if ($number != -1) { - $current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values); - } else { - $current_value .= $stoken->[2]; - } - } - - - - } + my $current_value; + my $allow=0; + my $pstyle = HTML::TokeParser->new(\$content_style_string); + $pstyle->xml_mode('1'); + while (my $stoken = $pstyle->get_token) { + if (($stoken->[0] eq 'S') && ($stoken->[1] eq 'definetag')) { + push @keys,$stoken->[2]->{'name'}; + $current_value=''; + $allow=0; + } elsif (($stoken->[0] eq 'E') && ($stoken->[1] eq 'definetag')) { + $current_value =~ s/(\s)+/$1/g; + $current_value =~ s/\n//g; + push(@values,$current_value); + } elsif (($target eq 'meta') && ($stoken->[0] eq 'S') && ($stoken->[1] eq 'meta')) { + $allow=1; + } elsif (($target eq 'meta') && ($stoken->[0] eq 'E') && ($stoken->[1] eq 'meta')) { + $allow=0; + } elsif (($target ne 'meta') && ($stoken->[0] eq 'S') && ($stoken->[1] eq 'render')) { + $allow=1; + } elsif (($target ne 'meta') && ($stoken->[0] eq 'E') && ($stoken->[1] eq 'render')) { + $allow=0; + } elsif (($target ne 'meta') && ($target ne 'web') && ($stoken->[0] eq 'S') && ($stoken->[1] eq 'web')) { + $allow=0; + } elsif (($target ne 'meta') && ($target ne 'web') && ($stoken->[0] eq 'E') && ($stoken->[1] eq 'web')) { + $allow=1; + } elsif (($target ne 'meta') && ($target ne 'tex') && ($stoken->[0] eq 'S') && ($stoken->[1] eq 'tex')) { + $allow=0; + } elsif (($target ne 'meta') && ($target ne 'tex') && ($stoken->[0] eq 'E') && ($stoken->[1] eq 'tex')) { + $allow=1; + } elsif (($stoken->[0] eq 'S') && ($stoken->[1] eq 'target') && (not $stoken->[2]->{'name'}=~/(^\s*$target\s*,|,\s*$target\s*,|,\s*$target\s*$|^\s*$target\s*$)/)) { + $allow=0; + } elsif (($stoken->[0] eq 'E') && ($stoken->[1] eq 'target')) { + $allow=1; + } elsif (($target ne 'meta') && ($stoken->[0] eq 'S') && ($stoken->[1] eq $target)) { + $allow=1; + } elsif (($target ne 'meta') && ($stoken->[0] eq 'E') && ($stoken->[1] eq $target)) { + } elsif (($stoken->[0] eq 'S') && ($stoken->[1] eq 'target') && ($stoken->[2]->{'name'}=~/(^\s*$target\s*,|,\s*$target\s*,|,\s*$target\s*$|^\s*$target\s*$)/)) { + $allow=1; + } elsif ($allow) { + if ($stoken->[0] eq 'T') { + $current_value .= $stoken->[1]; + } elsif ($stoken->[0] eq 'S') { + my $number=-1; + if ($stoken->[1] ne $keys[-1]) { + $number = &testkey($stoken->[0],$stoken->[1],@keys); + } + if ($number != -1) { + $current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values); + } else { + $current_value .= $stoken->[4]; + } + } elsif ($stoken->[0] eq 'E') { + my $number=-1; + if (('/'.$stoken->[1]) ne $keys[-1]) { + $number = &testkey($stoken->[0],$stoken->[1],@keys); + } + if ($number != -1) { + $current_value .= &testvalue($number,$stoken->[0],$stoken->[2],@values); + } else { + $current_value .= $stoken->[2]; + } + } } - $current_value =~ s/\n//g; -########### -# $current_value =~ s/^\s*//g; -# $current_value =~ s/\s*$//g; -# $current_value =~ s/\( (\w)/($1/g; -########### - push @values,$current_value; -# &Apache::lonxml::debug("a:$current_value $#values \n"); - $current_key = ''; - $current_value =''; - $b_pos = index($content_style_string,' $style_for_target{$current_key}\n"); -# } -# return result - return %style_for_target; - + return %style_for_target; } + sub testkey { my ($zeroth,$first,@keys) = @_; @@ -150,12 +150,12 @@ sub testvalue { my ($number,$zeroth,$second,@values) = @_; my $current_content = $values[$number]; if ($zeroth eq 'S') { - my %tempo_hash = %$second; - while ((my $current_k,my $current_v) = each %tempo_hash) { - $current_content =~ s/\$$current_k/$current_v/g; - } + my %tempo_hash = %$second; + while ((my $current_k,my $current_v) = each %tempo_hash) { + $current_content =~ s/\$$current_k/$current_v/g; + } } elsif ($zeroth eq 'E') { - $current_content = $values[$number]; + $current_content = $values[$number]; } return $current_content; } @@ -163,3 +163,32 @@ sub testvalue { 1; __END__ + +=pod + +=head1 NAME + +Apache::style.pm + +=head1 SYNOPSIS + +Style parsing module + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + + +=head1 SUBROUTINES + +=over + +=item styleparser() + +=item testkey() + +=item testvalue() + +=back + +=cut +