--- loncom/xml/style.pm 2000/10/26 14:01:40 1.6 +++ loncom/xml/style.pm 2004/01/21 13:03:29 1.21 @@ -1,171 +1,165 @@ # The LearningOnline Network with CAPA -# Style Parser Module +# Style Parser Module (new version) +# +# $Id: style.pm,v 1.21 2004/01/21 13:03:29 sakharuk Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# Copyright for TtHfunc and TtMfunc by Ian Hutchinson. +# TtHfunc and TtMfunc (the "Code") may be compiled and linked into +# binary executable programs or libraries distributed by the +# Michigan State University (the "Licensee"), but any binaries so +# distributed are hereby licensed only for use in the context +# of a program or computational system for which the Licensee is the +# primary author or distributor, and which performs substantial +# additional tasks beyond the translation of (La)TeX into HTML. +# The C source of the Code may not be distributed by the Licensee +# to any other parties under any circumstances. +# +# written 01/08/01 by Alexander Sakharuk # -# last modified 06/29/00 by Alexander Sakharuk -package Apache::style; +package Apache::style; use strict; use HTML::TokeParser; sub styleparser { - my ($target,$content_style_string) = @_; - my @target_list = ('target','web','tex','edit','modified','rat','answer','metadis'); - my @value_style = (); - my $current_key = ''; - my $current_value = ''; - my $stoken; - my $flag; - my $iele; - my $flag_target; - - my $pstyle = HTML::TokeParser->new(\$content_style_string); - - while ($stoken = $pstyle->get_token) { -# start for tag definition - if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') { -# new key in hash - $current_key = $stoken->[2]{name}; - $flag = 0; -# metadata output - if ($target eq 'meta') { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag') { - if ($stoken->[0] eq 'S' and $stoken->[1] eq 'meta') { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'meta') { - if ($stoken->[0] eq 'T') { - $current_value .= $stoken->[1]; - } elsif ($stoken->[0] eq 'S') { - $current_value .= $stoken->[4]; - } else { - $current_value .= $stoken->[2]; - } - } + my ($target,$content_style_string)=@_; + my @keys = (); + my @values = (); + 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]; + } } - } - } else { -# render output - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'render') { - if ($stoken->[1] eq 'definetag') { - $flag = 1; - last; - } - } - if ($flag == 0) { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'definetag' - and $stoken->[1] ne 'render') { -# if token not equal to target $flag_target=0 - $flag_target = 0; - for (my $i=0; $i<$#target_list; $i++) { - if ($stoken->[1] eq $target_list[$i]) { - $flag_target = 1; - } - } - if ($flag_target == 0) { -# target not found - my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style); - $current_value .= $tempo_out; - } else { -# target found - if ($stoken->[0] eq 'S' and $stoken->[1] eq 'target') { -# target defined via tag - if (defined $stoken->[2]{dest}) { - if (index($stoken->[2]{dest},$target) == -1) { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') { - } - } elsif (index($stoken->[2]{dest},$target) != -1) { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') { - my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style); - $current_value .= $tempo_out; - } - } - } else { - if (index($stoken->[2]{excl},$target) != -1) { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') { - } - } elsif (index($stoken->[2]{excl},$target) == -1) { - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'target') { - my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style); - $current_value .= $tempo_out; - } - } - - - } - } elsif ($stoken->[1] ne $target) { -#target defined via short-form tag - my $tempo_token = $stoken->[1]; - while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) { - } - } else { - my $tempo_token = $stoken->[1]; - while ($stoken = $pstyle->get_token and $stoken->[1] ne $tempo_token) { - my $tempo_out = &test($stoken->[0],$stoken->[1],$stoken->[2],$stoken->[4],@value_style); - $current_value .= $tempo_out; - } - } - } } - - } - } - } - $current_value =~ s/(\s)+/$1/g; - if ($current_value ne '' ) { - push (@value_style,lc $current_key,$current_value); - } - $current_key = ''; - $current_value = ''; - } - my %style_for_target = @value_style; -# check printing -# while (($current_key,$current_value) = each %style_for_target) { -# print "$current_key => $current_value\n"; -# } -# return result - return %style_for_target; + } + my %style_for_target; + for (my $i=0; $i<=$#keys; $i++) { + if ($values[$i] !~ /^\s*$/) { + $style_for_target{$keys[$i]}=$values[$i]; + } + } + return %style_for_target; } -sub test { - my ($zeroth,$first,$second,$fourth,@value_style) = @_; - my $current_value = ''; - my $num; - my $flag; - - if ($zeroth eq 'T') { - $current_value .= $first; - } elsif ($zeroth eq 'S') { - $flag = 0; - for (my $i=$#value_style-1;$i>=0;$i=$i-2) { - if ($first eq $value_style[$i]) { - $flag = 1; - $num = $i + 1; - last; - } - } - if ($flag == 0) { - $current_value .= $fourth; - } else { - $current_value .= $value_style[$num]; +sub testkey { + + my ($zeroth,$first,@keys) = @_; + my $number = -1; + if ($zeroth eq 'S') { + for (my $i=$#keys; $i>=0; $i=$i-1) { + if ($first eq lc($keys[$i])) { + $number = $i; + last; } - } elsif ($zeroth eq 'E') { - $flag = 0; - for (my $i=$#value_style-1;$i>=0;$i=$i-2) { - if ($first eq $value_style[$i]) { - $flag = 1; - $num = $i + 1; - last; - } + } + } elsif ($zeroth eq 'E') { + for (my $i=$#keys; $i>=0; $i=$i-1) { + if ('/'.$first eq lc($keys[$i])) { + $number = $i; + last; } - if ($flag == 0) { - $current_value .= $second; - } else { - $current_value .= $value_style[$num]; - } - } - return $current_value; + } + } + return $number; +} + +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; + } + } elsif ($zeroth eq 'E') { + $current_content = $values[$number]; + } + return $current_content; } 1; + __END__