# -------------------------------------------------------------------------------------
# lib::Template::AbstractTag
# -------------------------------------------------------------------------------------
#
#    Author   : Jean-Michel Hiver                         (c) Jean-Michel Hiver, 2001.
#    Synopsis : Provides methods which should be the same for all the
#               existing tags. This is made so that it's possible to
#               quickly develop new template tags.
#
# -------------------------------------------------------------------------------------
package lib::Template::AbstractTag;
use lib::Exception;
use lib::Template;
use strict;


##
# $class->new ( hash   => $values_hash,
#               result => $result_array,
#               tokens => $tokens_array );
# ----------------------------------------
#   Returns a new tag.
##
sub new
{
    my $class = shift;
    $class    = ref $class || $class;
    my $self  = bless { @_ }, $class;

    # performs a few checks
    (defined $self->{hash}) or
	throw (new lib::Exception ( code => 'NO_HASH_DEFINED',
				    info => $self ) );

    (defined $self->{result}) or
	throw (new lib::Exception ( code => 'NO_RESULT_ARRAY',
				    info => $self ) );

    (defined $self->{tokens}) or
	throw (new lib::Exception ( code => 'NO_TOKENS_ARRAY',
				    info => $self ) );
    
    return $self;
}


##
# $obj->get ( $varname );
# -----------------------
#   Returns the value matching $varname in current context.
##
sub get
{
    my $self = shift;
    
    # as long as @access is not empty, we have to continue
    # finding our way trough the path.
    my $invoke = shift;
    my @invoke = split /:/, $invoke;
    
    # if $self->{hash} is an object and $invoke has one element
    # only, then we should try to invoke a method on that object.
    if (@invoke == 1 and ref $self->{hash} ne 'HASH')
    {
	return $self->{hash}->$invoke() if ($self->{hash}->can ($invoke));
    }
    
    # copy the stash and the current hash in a variable
    # called $current. It doesn't clone the whole structure,
    # it's just a convenient way to reorganize the entries.
    my $current = { %{$lib::Template::STASH} };
    foreach (keys %{$self->{hash}}) { $current->{$_} = $self->{hash}->{$_} };
    
    # make our way to the value using references and
    # eventually method calls if we're dealing with an
    # object.
    my @path = ();
    while (@invoke)
    {
	(defined $current and ref $current) or
	    throw (new lib::Exception ( code => 'VARIABLE_NOT_SET',
					info => "$invoke was not set" ) );
	
	push @path, shift (@invoke);
	my $name = join ':', @path;
	
	if (@path > 1)
	{
	    if (defined $current->{$name})
	    {
		@path = ();
		$current = $current->{$name};
	    }
	}
	else
	{
	    if (ref $current ne 'HASH' and $current->can ($name))
	    {
		@path = ();
		$current = $current->$name();
	    }
	    else
	    {
		@path = ();
		$current = $current->{$name};
	    }
	}
    }
    
    (@path > 0) and
	throw (new lib::Exception ( code => 'VARIABLE_NOT_SET',
				    info => "$invoke was not set in this $self" ) );
    
    # return the value we found
    return $current;
}


##
# $obj->parse_tag ( '<% some_tag attr1="value1" attr2="value2" %>' );
# -------------------------------------------------------------------
#   Returns tag name and tag associated information.
##
sub parse_tag
{
    my $self  = shift;
    my $token = shift;
    my $r_token = $lib::Template::RIGHT_TOKEN;
    my $l_token = $lib::Template::LEFT_TOKEN;
    
    my ($token_name) = $token =~ /$l_token\s+(\S+)/o;
    my %token_hash   = $token =~ /(\S+)\=\"(.*?)\"/gos;
    return $token_name, \%token_hash;
}


##
# $obj->is_tag ( $some_string );
# ------------------------------
#   Returns TRUE if $some_string is a tag, FALSE otherwise.
##
sub is_tag
{
    my $self  = shift;
    my $token = shift;
    
    my $r_token = $lib::Template::RIGHT_TOKEN;
    my $l_token = $lib::Template::LEFT_TOKEN;
    
    return ($token =~ /^$l_token/o) and ($token =~ /$r_token$/o);
}


##
# $obj->stack_hash ($hash1, $hash2);
# ----------------------------------
#   Creates a new hash which is hash2 stacked onto hash1
##
sub stack_hash
{
    my $self = shift;
    my $result = { %{shift()} };
    my $hash   = shift;
    foreach (keys %{$hash}) { $result->{$_} = $hash->{$_} }
    return $result;
}


sub result { return shift->{result} }
sub tokens { return shift->{tokens} }


1;















