First pass at adding key files
This commit is contained in:
dsainty
205
site/slowtwitch.com/cgi-bin/articles/GT/Template/Vars.pm
Normal file
205
site/slowtwitch.com/cgi-bin/articles/GT/Template/Vars.pm
Normal file
@ -0,0 +1,205 @@
|
||||
# ====================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Template::Vars
|
||||
# Author: Jason Rhinelander
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Vars.pm,v 1.8 2006/12/06 23:55:52 brewt 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 (ref $$cur eq 'ARRAY' and $k =~ /^\d+$/) {
|
||||
$cur = \$$cur->[$k];
|
||||
}
|
||||
elsif (ref $$cur eq 'ARRAY' and $k eq 'push') {
|
||||
$cur = \$$cur->[@$$cur];
|
||||
}
|
||||
elsif (ref $$cur eq 'ARRAY' and $k =~ /^last(\d+)?$/) {
|
||||
$cur = \$$cur->[-($1 || 1)];
|
||||
}
|
||||
elsif (ref $$cur eq 'HASH' or not defined $$cur or UNIVERSAL::isa($$cur, 'GT::Config')) {
|
||||
if (exists $$cur->{$k} and ref $$cur->{$k} eq 'SCALAR') {
|
||||
$set[0] = $k . '.' . $set[0];
|
||||
}
|
||||
else {
|
||||
$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 returns the template parser's raw value, bypassing the usual
|
||||
# _get_var-based approach which can escape, be strict, and will flatten
|
||||
# references.
|
||||
sub FETCH {
|
||||
my ($self, $key) = @_;
|
||||
my $value = $self->{t}->_raw_value($key);
|
||||
$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.8 2006/12/06 23:55:52 brewt Exp $
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user