# The LearningOnline Network with CAPA
# Style Parser Module (new version)
#
# $Id: style.pm,v 1.14 2002/10/16 20:37:46 albertel 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 $current_key = '';
    my $current_value = '';
    my @keys = ();
    my @values = ();
    my @style_array = ();
    my $stoken;

    my $b_pos;
    my $e_pos;
    my $entry;

    $b_pos = index($content_style_string,'<definetag',0);
    while ($b_pos != -1) {
	$e_pos = index($content_style_string,'</definetag',$b_pos);
	$entry = substr($content_style_string,$b_pos,$e_pos-$b_pos+12);       
	$_ = $entry;
	m/<definetag\s+name\s*=\s*\"([^\"]*)\"/;
	$current_key = $1;
	push @keys,$current_key;
#	&Apache::lonxml::debug("$current_key\n");
	my $b_position =  index($entry,'<'.$target.'>',0);
	my $e_position =  index($entry,'</'.$target.'>',$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=-1;
		    if ($stoken->[1] ne "$current_key") {
			$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=-1;
		    if (('/'.$stoken->[1]) ne "$current_key") {
			$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,'<definetag',$b_pos+1);
    }

    for (my $i=0; $i<=$#keys; $i++) {
	push @style_array,$keys[$i],$values[$i]; 
    }
    my %style_for_target =  @style_array;

# check printing
#    foreach $current_key (sort keys %style_for_target) {
#	&Apache::lonxml::debug("$current_key => $style_for_target{$current_key}\n");
#    }
# return result
  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__