File:  [LON-CAPA] / loncom / xml / style.pm
Revision 1.22: download - view: text, annotated - select for diffs
Mon Nov 24 18:55:01 2008 UTC (15 years, 4 months ago) by jms
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_99_1, version_2_8_99_0, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse
Added/modified POD comments

# The LearningOnline Network with CAPA
# Style Parser Module (new version)
#
# $Id: style.pm,v 1.22 2008/11/24 18:55:01 jms 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
#

package Apache::style;

use strict;
use HTML::TokeParser;

sub styleparser {

    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];
		}
	    }
	}
    }
    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 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') {
	for (my $i=$#keys; $i>=0; $i=$i-1) {
	    if ('/'.$first eq lc($keys[$i]))  { 
		$number = $i;
	 	last;
	    }
	}
    }
	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__

=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


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>