199 lines
5.8 KiB
Perl
199 lines
5.8 KiB
Perl
# ====================================================================
|
|
# 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
|