# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Template::Vars
#   Author: Jason Rhinelander
#   CVS Info :                          
#   $Id: Vars.pm,v 1.3 2005/03/05 01:17:20 jagerman Exp $
#
# Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
# ====================================================================
#
# Description:
#   GT::Template variable handling tied hash reference.
#

package GT::Template::Vars;
use strict;
use Carp 'croak';

sub TIEHASH {
    my ($class, $tpl) = @_;

    my $self = { t => $tpl, keys => [] };
    bless $self, ref $class || $class;
}

sub STORE {
    my ($self, $key, $value) = @_;
    if ($key =~ /^\w+(?:\.\$?\w+)+$/) {
        my $cur = \$self->{t}->{VARS};
        my @set = split /\./, $key;
        for (my $i = 0; $i < @set; $i++) {
            if ($set[$i] =~ /^\$/) {
                my $val = $self->{t}->_get_var(substr($set[$i], 1));
                $val = '' if not defined $val;
                my @pieces = split /\./, $val;
                @pieces = '' if !@pieces;
                splice @set, $i, 1, @pieces;
                $i += @pieces - 1 if @pieces > 1;
            }
        }
        while (@set) {
            my $k = shift @set;
            if ($k =~ s/^\$//) {
                $k = '' . ($self->FETCH($k) || '');
            }
            if ($k =~ /^\d+$/ and ref $$cur eq 'ARRAY') {
                $cur = \$$cur->[$k];
            }
            elsif (ref $$cur eq 'HASH' or not defined $$cur or UNIVERSAL::isa($$cur, 'GT::Config')) {
                $cur = \$$cur->{$k};
            }
            elsif (UNIVERSAL::isa($$cur, 'GT::CGI') and !@set) {
                # You can set a GT::CGI parameter, but only to a scalar value (or reference to a scalar value)
                return $$cur->param(
                    $k => ((ref $value eq 'SCALAR' or ref $value eq 'LVALUE') and not ref $$value) ? $$value : "$value"
                );
            }
            else {
                croak 'Not a HASH reference';
            }
        }
        $$cur = $value;
    }
    else {
        $self->{t}->{VARS}->{$key} = $value;
    }
}

# Fetching wraps around _get_var, using the template parser's escape value.
# Strict is never passed because we want $tags->{foo} to be false if it isn't
# set, instead of "Unknown tag 'foo'".  In cases where overriding escape is
# necessary, _get_var is used directly.  _get_var's fourth argument is used
# here to avoid a potential infinite loop caused by recalling code references
# when their value is implicitly retrieved (for example, in a "while-each"
# loop).
sub FETCH {
    my ($self, $key) = @_;
    my $value = $self->{t}->_raw_value($key, 1);
    $value = $$value if ref $value eq 'SCALAR' or ref $value eq 'LVALUE';
    return $value;
}

# Keys/exists are a little strange - if "foo" is set to { a => 1 }, exists
# $tags->{"foo.a"} will be true, but only "foo", not "foo.a", will be returned
# by keys %$tags.
sub FIRSTKEY {
    my $self = shift;
    my @keys;
    for (keys %{$self->{t}->{VARS}}) {
        push @keys, $_;
    }
    for (keys %{$self->{t}->{ALIAS}}) {
        push @keys, $_ unless exists $self->{t}->{VARS}->{$_};
    }

    $self->{keys} = \@keys;

    return shift @keys;
}

sub EXISTS {
    my ($self, $key) = @_;
    my @val = $self->{t}->_raw_value($key);
    return !!@val;
}

sub NEXTKEY {
    my $self = shift;
    if (!$self->{keys}) {
        return $self->FIRSTKEY;
    }
    elsif (!@{$self->{keys}}) {
        delete $self->{keys};
        return;
    }
    return shift @{$self->{keys}};
}

sub DELETE {
    my ($self, $key) = @_;
    my $value = $self->FETCH($key);
    delete $self->{t}->{VARS}->{$key};
    $value;
}
sub CLEAR  { %{$_[0]->{t}->{VARS}} = () }
sub SCALAR { scalar %{$_[0]->{t}->{VARS}} }

1;

__END__

=head1 NAME

GT::Template::Vars - Tied hash for template tags handling

=head1 SYNOPSIS

    my $vars = GT::Template->vars;
    print $vars->{foo};

=head1 DESCRIPTION

This module is designed to provide a simple interface to GT::Template tags from
Perl code.  Prior to this module, the tags() method of GT::Template returned a
hash reference which could contain all sorts of different values - scalar
references, LVALUE references, GT::Config objects, etc.  This new interface
provides a tied hash reference designed to aid in retrieving and setting values
in the same way template variables are retrieved and set from templates.

=head1 INTERFACE

=head2 Accessing values

Accessing a value is simple - just access C<$vars-E<gt>{name}>.  The regular
rules of escaping apply here: if the value would have been HTML-escaped in the
template, it will be escaped when you get it.

=head2 Setting values

Setting a value is easy - simply do: C<$vars-E<gt>{name} = $value;>.  "name"
can be anything GT::Template recognises as a variable, so
C<$vars-E<gt>{'name.key'}> would set C<-E<gt>{name}-E<gt>{key}> (see
L<GT::Template::Tutorial/"Advanced variables using references"> for more
information on complex variables).

The regular rules of escaping apply here: if escaping is turned on, a value you
set will be escaped when accessed again via $vars or in a template.  If you
want to set a tag containing raw HTML, you should set a scalar reference, such
as: C<$vars-E<gt>{name} = \$value;>.

=head2 Keys, Exists

You can use C<keys %$vars> to get a list of keys of the tag object, but you
should note that while C<$vars-E<gt>{"a.b"}> is valid and
C<exists $vars-E<gt>{"a.b"}> may return true, it will B<not> be present in the
list of keys returned by C<keys %$vars>.

=head1 SEE ALSO

L<GT::Template>

L<GT::Template::Tutorial>

=head1 MAINTAINER

Jason Rhinelander

=head1 COPYRIGHT

Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Vars.pm,v 1.3 2005/03/05 01:17:20 jagerman Exp $

=cut