1#!/usr/bin/perl -w                                         # -*- perl -*-
2#============================================================= -*-perl-*-
3#
4# t/context.t
5#
6# Test the Template::Context.pm module.
7#
8# Written by Andy Wardley <abw@kfs.org>
9#
10# Copyright (C) 1996-2000 Andy Wardley.  All Rights Reserved.
11# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
12#
13# This is free software; you can redistribute it and/or modify it
14# under the same terms as Perl itself.
15#
16# $Id$
17#
18#========================================================================
19
20use strict;
21use lib qw( ./lib ../lib );
22use Template::Test;
23use Template::Constants qw( :debug );
24
25my $DEBUG = grep(/^--?d(debug)?$/, @ARGV);
26#$Template::Test::DEBUG = 1;
27
28ntests(54);
29
30# script may be being run in distribution root or 't' directory
31my $dir   = -d 't' ? 't/test' : 'test';
32my $tt = Template->new({
33    INCLUDE_PATH => "$dir/src:$dir/lib",	
34    TRIM         => 1,
35    POST_CHOMP   => 1,
36    DEBUG        => $DEBUG ? DEBUG_CONTEXT : 0,
37});
38
39my $ttperl = Template->new({
40    INCLUDE_PATH => "$dir/src:$dir/lib",
41    TRIM         => 1,
42    EVAL_PERL    => 1,
43    POST_CHOMP   => 1,
44    DEBUG        => $DEBUG ? DEBUG_CONTEXT : 0,
45});
46
47#------------------------------------------------------------------------
48# misc
49#------------------------------------------------------------------------
50
51# test we created a context object and check internal values
52my $context = $tt->service->context();
53ok( $context );
54ok( $context eq $tt->context() );
55ok( $context->trim() );
56ok( ! $context->eval_perl() );
57
58ok( $context = $ttperl->service->context() );
59ok( $context->trim() );
60ok( $context->eval_perl() );
61
62#------------------------------------------------------------------------
63# template()
64#------------------------------------------------------------------------
65
66banner('testing template()');
67
68# test we can fetch a template via template()
69my $template = $context->template('header');
70ok( $template );
71ok( UNIVERSAL::isa($template, 'Template::Document') );
72
73# test that non-existance of a template is reported
74eval { $template = $context->template('no_such_template') };
75ok( $@ );
76ok( "$@" eq 'file error - no_such_template: not found' );
77
78# check that template() returns CODE and Template::Document refs intact
79my $code = sub { return "this is a hard-coded template" };
80$template = $context->template($code);
81ok( $template eq $code );
82
83my $doc = "this is a document";
84$doc = bless \$doc, 'Template::Document';
85$template = $context->template($doc);
86ok( $template eq $doc );
87ok( $$doc = 'this is a document' );
88
89# check the use of visit() and leave() to add temporary BLOCK lookup 
90# tables to the context's search space
91my $blocks1 = {
92    some_block_1 => 'hello',
93};
94my $blocks2 = {
95    some_block_2 => 'world',
96};
97
98eval { $context->template('some_block_1') };
99ok( $@ );
100$context->visit('no doc', $blocks1);
101ok( $context->template('some_block_1') eq 'hello' );
102eval { $context->template('some_block_2') };
103ok( $@ );
104$context->visit('no doc', $blocks2);
105ok(   $context->template('some_block_1') eq 'hello' );
106ok(   $context->template('some_block_2') eq 'world' );
107$context->leave();
108ok(   $context->template('some_block_1') eq 'hello' );
109eval { $context->template('some_block_2') };
110ok( $@ );
111$context->leave();
112eval { $context->template('some_block_1') };
113ok( $@ );
114eval { $context->template('some_block_2') };
115ok( $@ );
116
117
118# test that reset() clears all blocks
119$context->visit('no doc', $blocks1);
120ok(   $context->template('some_block_1') eq 'hello' );
121eval { $context->template('some_block_2') };
122ok( $@ );
123$context->visit('no doc', $blocks2);
124ok(   $context->template('some_block_1') eq 'hello' );
125ok(   $context->template('some_block_2') eq 'world' );
126$context->reset();
127eval { $context->template('some_block_1') };
128ok( $@ );
129eval { $context->template('some_block_2') };
130ok( $@ );
131
132#------------------------------------------------------------------------
133# plugin()
134#------------------------------------------------------------------------
135
136banner('testing plugin()');
137
138my $plugin = $context->plugin('Table', [ [1,2,3,4], { rows => 2 } ]);
139ok( $plugin );
140ok( ref $plugin eq 'Template::Plugin::Table' );
141
142my $row = $plugin->row(0);
143ok( $row && ref $row eq 'ARRAY' );
144ok( $row->[0] == 1 );
145ok( $row->[1] == 3 );
146
147eval {
148  $plugin = $context->plugin('no_such_plugin');
149};
150ok( "$@" eq 'plugin error - no_such_plugin: plugin not found' );
151
152#------------------------------------------------------------------------
153# filter()
154#------------------------------------------------------------------------
155
156banner('testing filter()');
157
158my $filter = $context->filter('html');
159ok( $filter );
160ok( ref $filter eq 'CODE' );
161ok( &$filter('<input/>') eq '&lt;input/&gt;' );
162
163$filter = $context->filter('replace', [ 'foo', 'bar' ], 'repsave');
164ok( $filter );
165ok( ref $filter eq 'CODE' );
166ok( &$filter('this is foo, so it is') eq 'this is bar, so it is' );
167
168# check filter got cached
169$filter = $context->filter('repsave');
170ok( $filter );
171ok( ref $filter eq 'CODE' );
172match( &$filter('this is foo, so it is'), 'this is bar, so it is' );
173
174
175#------------------------------------------------------------------------
176# include() and process()
177#------------------------------------------------------------------------
178
179banner('testing include()');
180
181$context = $tt->context();
182ok( $context );
183
184my $stash = $context->stash();
185ok( $stash );
186
187$stash->set('a', 'alpha');
188ok( $stash->get('a') eq 'alpha' );
189
190my $text = $context->include('baz');
191ok( $text eq 'This is the baz file, a: alpha' );
192
193$text = $context->include('baz', { a => 'bravo' });
194ok( $text eq 'This is the baz file, a: bravo' );
195
196# check stash hasn't been altered
197ok( $stash->get('a') eq 'alpha' );
198
199$text = $context->process('baz');
200ok( $text eq 'This is the baz file, a: alpha' );
201
202# check stash *has* been altered
203ok( $stash->get('a') eq 'charlie' );
204
205$text = $context->process('baz', { a => 'bravo' });
206ok( $text eq 'This is the baz file, a: bravo' );
207ok( $stash->get('a') eq 'charlie' );
208
209