[Templates-cvs] cvs commit: TT3/t component.t
cvs@template-toolkit.org
cvs@template-toolkit.org
Thu, 25 Mar 2004 15:47:26 +0000
cvs 04/03/25 15:47:26
Added: t component.t
Log:
* added t/component.t to test Template::Component
Revision Changes Path
1.1 TT3/t/component.t
Index: component.t
===================================================================
#============================================================= -*-perl-*-
#
# t/component.t
#
# Test the Template::Component.pm module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: component.t,v 1.1 2004/03/25 15:47:25 abw Exp $
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib );
use Template::Component;
use Template::Context;
use Template::Templates;
use Template::TT2::Compiler;
use Test::More tests => 52;
my $DEBUG =
$Template::Component::DEBUG =
$Template::Context::DEBUG =
$Template::Templates::DEBUG =
$Template::Document::DEBUG =
grep(/^--?d(ebug)?/, @ARGV);
my $Component = 'Template::Component';
my $comp;
#------------------------------------------------------------------------
# basic test of locate() method
#------------------------------------------------------------------------
ok( 1, 'testing locate() method' );
$comp = $Component->new({
name => 'kitchen',
food => {
cheese => 'Swiss',
salad => 'Caesar',
},
}) || die $Component->error();
my $locs = $comp->locate('food') || die $comp->error();
ok( $locs, 'got food locations' );
is( ref $locs, 'ARRAY', 'food locations array' );
is( @$locs, 1, 'one food location' );
is( ref $locs->[0], 'HASH', 'food location hash' );
is( $locs->[0]->{ cheese }, 'Swiss', 'swiss cheese' );
is( $locs->[0]->{ salad }, 'Caesar', 'caesar salad' );
my $locs2 = $comp->locate('food') || die $comp->error();
ok( $locs2, 'got cached food locations' );
is( $locs, $locs2, 'food locations are cached' );
#------------------------------------------------------------------------
# test unlocate() method
#------------------------------------------------------------------------
is( $comp->unlocate('food'), $locs, 'unlocated food' );
$locs2 = $comp->locate('food') || die $comp->error();
ok( $locs2, 'got new food locations' );
isnt( $locs, $locs2, 'new food locations are not cached' );
#------------------------------------------------------------------------
# test that locate() expands lists
#------------------------------------------------------------------------
$comp = $Component->new({
name => 'numbers',
numbers => [
0, 1, 2,
[ 3, 5, 7, [ 11, 13, 17, [19, 23 ] ] ],
[ 42, 69 ],
],
}) || die $Component->error();
$locs = $comp->locate('numbers') || die $comp->error();
is( ref $locs, 'ARRAY', 'array of numbers' );
is( @$locs, 13, 'thirteen numbers' );
is( join(', ', @$locs), '0, 1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 42, 69',
'located numbers' );
#------------------------------------------------------------------------
# test that locate() follows context, parent and caller links
#------------------------------------------------------------------------
my $caller2 = $Component->new({
name => 'caller2',
numbers => [
2000, 2001,
[ 2002, 2003 ]
],
}) || die $Component->error();
my $caller1 = $Component->new({
name => 'caller1',
caller => $caller2,
numbers => [
1001, 1002,
[ 1003, 1004 ]
],
}) || die $Component->error();
my $parent2 = $Component->new({
name => 'parent2',
numbers => [
200, 201,
[ 202, 203 ]
],
}) || die $Component->error();
my $parent1 = $Component->new({
name => 'parent1',
parent => $parent2,
numbers => [
101, 102,
[ 103, 104 ]
],
}) || die $Component->error();
my $context2 = $Component->new({
name => 'context2',
numbers => [
20, 21,
[ 22, 23 ]
],
}) || die $Component->error();
my $context1 = $Component->new({
name => 'context1',
context => $context2,
numbers => [
11, 12,
[ 13, 14 ]
],
}) || die $Component->error();
$comp = $Component->new({
name => 'composite',
caller => $caller1,
parent => $parent1,
context => $context1,
numbers => [ 1, 2, 3, 4 ]
}) || die $Component->error();
$locs = $comp->locate('numbers') || die $comp->error();
is( ref $locs, 'ARRAY', 'array of numbers for composite' );
is( @$locs, 28, 'twenty eight numbers' );
is( join(', ', splice(@$locs, 0, 4)),
'1, 2, 3, 4',
'located local numbers' );
is( join(', ', splice(@$locs, 0, 8)),
'11, 12, 13, 14, 20, 21, 22, 23',
'located context numbers' );
is( join(', ', splice(@$locs, 0, 8)),
'101, 102, 103, 104, 200, 201, 202, 203',
'located parent numbers' );
is( join(', ', splice(@$locs, 0, 8)),
'1001, 1002, 1003, 1004, 2000, 2001, 2002, 2003',
'located caller numbers' );
#------------------------------------------------------------------------
# test search() method
#------------------------------------------------------------------------
$comp = $Component->new({
food => {
cheese => 'Swiss',
salad => 'Caesar',
},
}) || die $Component->error();
is( $comp->search( food => 'cheese' ), 'Swiss', 'searched for swiss cheese' );
is( $comp->search( food => 'salad' ), 'Caesar', 'searched for caesar salad' );
$comp = $Component->new({
food => [
{
cheese => 'Swiss',
salad => 'Caesar',
},
{
salad => 'Waldorf',
bread => 'Wholegrain',
},
],
}) || die $Component->error();
is( $comp->search( food => 'salad' ), 'Caesar', 'still a caesar salad' );
is( $comp->search( food => 'bread' ), 'Wholegrain', 'wholegrain bread' );
#------------------------------------------------------------------------
# test search() with a provider object and subroutine
#------------------------------------------------------------------------
my $numbers = {
pi => 3.142,
e => 2.718,
};
sub numbers {
my ($self, $name, %opts) = @_;
die $opts{ sub_fatal } if $opts{ sub_fatal };
return $self->error($opts{ sub_error }) if $opts{ sub_error };
return $numbers->{ $name }
|| $self->decline("$name: not found");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
package My::Provider;
use base qw( Template::Base );
our $THROW = 'my_provider';
sub init {
my ($self, $config) = @_;
$self->{ items } = $config;
return $self;
}
sub fetch {
my ($self, $name, %opts) = @_;
die $opts{ obj_fatal } if $opts{ obj_fatal };
return $self->error($opts{ obj_error }) if $opts{ obj_error };
return $self->{ items }->{ $name }
|| $self->decline("$name: not found");
}
sub old_decline {
my $self = shift;
$self->error(@_) if @_;
return 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
package main;
$comp = $Component->new({
name => 'providers',
numbers => [
{
one => 1,
two => 2,
},
{
foo => '42',
bar => '69',
},
\&numbers,
My::Provider->new({ phi => 1.618 }),
{ x => 10, y => 20 },
],
}) || die $Component->error();
is( $comp->search( numbers => 'one' ), 1, 'number one' );
is( $comp->search( numbers => 'two' ), 2, 'number two' );
is( $comp->search( numbers => 'foo' ), 42, 'number foo' );
is( $comp->search( numbers => 'bar' ), 69, 'number bar' );
is( $comp->search( numbers => 'pi' ), 3.142, 'number pi' );
is( $comp->search( numbers => 'e' ), 2.718, 'number e' );
is( $comp->search( numbers => 'phi' ), 1.618, 'number phi' );
is( $comp->search( numbers => 'x' ), 10, 'number x' );
is( $comp->search( numbers => 'y' ), 20, 'number y' );
#------------------------------------------------------------------------
# test error handling for provider objects and subroutines
#------------------------------------------------------------------------
my $result = eval {
$comp->search( numbers => 'x', sub_error => "planned error" );
};
ok( ! defined $result, 'provider sub raised error' );
is( $comp->error(), 'search.numbers.x error - planned error',
'got planned error message' );
ok( ! eval { $comp->search( numbers => 'y', sub_fatal => "sudden death\n" ) },
'provider sub death' );
is( $comp->error(), 'sudden death', 'got sudden death message' );
ok( ! eval { $comp->search( numbers => 'x',
obj_error => "another planned error" ) },
'provider object raised error' );
is( $comp->error(), 'my_provider error - another planned error',
'got object error message' );
ok( ! eval { $comp->search( numbers => 'y',
obj_fatal => "more sudden death\n" ) },
'provider object death' );
is( $comp->error(), 'more sudden death', 'got object death message' );
#------------------------------------------------------------------------
# create a Template::Templates object to manage templates, and a
# Template::TT2:Compiler to compiler them
#------------------------------------------------------------------------
my $templates = Template::Templates->new( static => 1 )
|| die Template::Templates->error();
ok( $templates, 'created templates resource' );
my $compiler = Template::TT2::Compiler->new( static => 1 )
|| die Template::TT2::Compiler->error();
ok( $compiler, 'created templates compiler' );
#------------------------------------------------------------------------
# test enter() method
#------------------------------------------------------------------------
my $outer = $Component->new({
visited => 1,
name => 'outer',
resources => {
templates => $templates,
},
compilers => {
default => $compiler,
},
variables => {
a => 10,
b => 20,
},
}) || die $Component->error();
ok( $outer, 'created outer component' );
{
my $inner = $outer->enter(
{
name => 'inner',
variables => {
b => 30,
c => 40,
d => 50,
},
},
);
ok( $inner, 'created inner component' );
is( $outer->search( variables => 'a' ), 10, 'outer a is 10' );
is( $outer->search( variables => 'b' ), 20, 'outer b is 20' );
ok( ! defined $outer->search( variables => 'c' ), 'inner c is undefined' );
is( $inner->search( variables => 'a' ), 10, 'inner a is 10' );
is( $inner->search( variables => 'b' ), 30, 'inner b is 30' );
is( $inner->search( variables => 'c' ), 40, 'inner c is 40' );
# $inner should go out of scope here, triggering DESTROY method,
# which calls finish() method, which causes $inner to notify the
# $outer leave() method.
# print STDERR $inner->dump();
}
__END__
# TODO: visit tracking is currently broken
my $visits = $outer->visited();
ok( $visits, 'got outer visits' );
is( @$visits, 1, 'one component visited' );
ok( 1, 'TODO: test enter(), leave() and finish() methods' );
__END__
#------------------------------------------------------------------------
# test declines
#------------------------------------------------------------------------
#------------------------------------------------------------------------
# test resource() method
#------------------------------------------------------------------------
ok( 1, 'TODO: test resource() method' );
#------------------------------------------------------------------------
# test template() method
#------------------------------------------------------------------------
# we also need a templates resource manager
my $templates = Template::Templates->new( static => 1 )
|| die Template::Templates->error();
ok( $templates, 'created templates resource' );
# and a compiler
my $compiler = Template::TT2::Compiler->new( static => 1 )
|| die Template::TT2::Compiler->error();
ok( $compiler, 'created templates compiler' );
#------------------------------------------------------------------------
# define an outer component
#------------------------------------------------------------------------
my ($outer, $inner, $template);
# outer component has simple hash of templates
$outer = $pkg->new({
name => 'outer',
local => {
templates => {
foo => 'the foo template',
bar => 'the bar template',
},
variables => {
a => 10,
b => 20,
},
resources => {
templates => $templates,
},
compilers => {
tt2 => $compiler,
default => 'tt2',
},
},
}) || die $pkg->error();
ok( $outer, 'created outer component' );
#------------------------------------------------------------------------
# inner component has list of hashes and provider subroutines
#------------------------------------------------------------------------
package main;
$inner = $pkg->new({
caller => $outer,
name => 'inner',
local => {
templates => [
{
dizzy => 'delilah [[% a %]]',
wizzy => 'william [[% b %]]',
lizzy => "[% PROCESS dizzy a='alpha'; ', '; PROCESS wizzy %]",
},
\&words,
My::Provider->new($drinks),
],
variables => {
b => 50,
},
},
}) || die $pkg->error();
ok( $inner, 'created inner component' );
#------------------------------------------------------------------------
# check that we can search() everything
#------------------------------------------------------------------------
# these come from the outer component
is( $inner->search( templates => 'foo' ),
'the foo template', 'got foo template' );
is( $inner->search( templates => 'bar' ),
'the bar template', 'got bar template' );
# these come from the first hash in the inner component
is( $inner->search( templates => 'wam' ),
'the wam template', 'got wam template' );
is( $inner->search( templates => 'bam' ),
'the bam template', 'got bam template' );
# these come from the numbers() subroutine
is( $inner->search( templates => 'pi' ),
'3.14', 'pi is 3.14' );
is( $inner->search( templates => 'e' ),
'2.718', 'e is 2.718' );
# these from the animals provider, woof! woof!
is( $inner->search( templates => 'cat' ),
'feline', 'a cat is feline' );
is( $inner->search( templates => 'dog' ),
'canine', 'a dog is canine' );
# these come from the second hash in the inner component
is( $inner->search( templates => 'dizzy' ) || die($inner->error()),
'delilah [[% a %]]', 'dizzy delilah template' );
$template = $inner->template('dizzy') || die $inner->error();
ok( $template, 'got dizzy template' );
my $result = $template->run( caller => $inner )
|| die "dizzy failed: ", $template->error();
is( $result, 'delilah [10]', 'dizzy delilah result' );
$result = $inner->process('wizzy')
|| die "wizzy failed: ", $inner->error();
is( $result, 'william [50]', 'wizzy william result' );
is( $inner->process( wizzy => { b => 90 }),
'william [90]', 'wizzy william 90 result' );
is( $inner->process('lizzy'), 'delilah [alpha], william [50]',
'lizzy bill 50' );
my $lizzy = $inner->template('lizzy');
is( $lizzy->run( caller => $inner, args => { b => 100 } ),
'delilah [alpha], william [100]',
'lizzy bill 100' );
is( $lizzy->execute( { b => 120 }, caller => $inner ),
'delilah [alpha], william [120]',
'lizzy bill 120' );
is( $lizzy->execute( { b => 140 }, { caller => $inner } ),
'delilah [alpha], william [140]',
'lizzy bill 140' );
__END__
is( $inner->template('wizzy'),
'william', 'wizzy william' );
# The question is: "How much more black could this be?"...
is( $inner->template('black'),
'dark', 'black is dark' );
# ..and the answer is "None, none more black"
is( $inner->template('white'),
'light', 'white is light' );
# Phew! This is thirsy work. Anyone fancy a quick drink?
is( $inner->template('beer'),
'guinness', 'guinness is a nice beer' );
is( $inner->template('malt'),
'laphroig', 'laphroig is a nice malt' );
#------------------------------------------------------------------------
# check the resource() method and local caching
#------------------------------------------------------------------------
my $foo = $pkg->new( resources => { wiz => 'wizzle' } );
my $bar = $pkg->new( resources => { waz => 'wazzle' }, component => $foo );
my $baz = $pkg->new( resources => { woz => 'wozzle' }, component => $bar );
ok( $foo, 'made foo' );
ok( $bar, 'made bar' );
ok( $baz, 'made baz' );
is( $baz->resource('woz'), 'wozzle', 'got woz resource' );
is( $baz->{ local }->{ resources }->{ woz }, 'wozzle', 'used wozzle' );
is( $baz->resource('woz'), 'wozzle', 'got cached woz resource' );
$baz->{ local }->{ resources }->{ woz } = 'wazzle';
is( $baz->resource('woz'), 'wazzle', 'got munged cached woz resource' );
is( $baz->resource('waz'), 'wazzle', 'got waz resource' );
is( $baz->resource('waz'), 'wazzle', 'got cached waz resource' );
#$baz->fetch( user => 'abw' ) || die $baz->error();
__END__
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: