Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 425 lines (344 sloc) 11.333 kb
3ebfa07 @abw Initial revision
authored
1 #============================================================= -*-perl-*-
2 #
3 # t/provider.t
4 #
5 # Test the Template::Provider module.
6 #
7 # Written by Andy Wardley <abw@kfs.org>
8 #
9 # Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
10 # Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
11 #
12 # This is free software; you can redistribute it and/or modify it
13 # under the same terms as Perl itself.
14 #
15 # $Id$
16 #
17 #========================================================================
18
19 use strict;
20 use lib qw( ./lib ../lib );
21 use Template::Test;
22 use Template::Config;
d52480d @abw *** empty log message ***
authored
23 use Template::Provider;
3ebfa07 @abw Initial revision
authored
24 use Cwd 'abs_path';
25
26 $^W = 1;
4e99583 @abw * various minor updates to accomodate new DEBUG options
authored
27 my $DEBUG = grep(/-d/, @ARGV);
3ebfa07 @abw Initial revision
authored
28 $Template::Test::DEBUG = 0;
4e99583 @abw * various minor updates to accomodate new DEBUG options
authored
29 use Template::Constants qw( :debug );
30 $Template::Provider::DEBUG = $DEBUG ? DEBUG_PROVIDER | DEBUG_CALLER : 0;
3e45060 @abw *** empty log message ***
authored
31 #$Template::Parser::DEBUG = 1;
32 #$Template::Directive::PRETTY = 1;
33
6ddeb78 @abw added leak.t
authored
34 # uncommenting the next line should cause test 43 to fail because
35 # the provider doesn't stat the file.
36 # $Template::Provider::STAT_TTL = 10;
37
3ebfa07 @abw Initial revision
authored
38 my $factory = 'Template::Config';
39
40 # script may be being run in distribution root or 't' directory
41 my $dir = -d 't' ? 't/test/src' : 'test/src';
fc832bb @abw * added tests for dynamic paths
authored
42 my $lib = -d 't' ? 't/test/lib' : 'test/lib';
3ebfa07 @abw Initial revision
authored
43 my $file = 'foo';
44 my $relfile = "./$dir/$file";
45 my $absfile = abs_path($dir) . '/' . $file;
b4f721c @abw *** empty log message ***
authored
46 my $newfile = "$dir/foobar";
3ebfa07 @abw Initial revision
authored
47 my $vars = {
48 file => $file,
49 relfile => $relfile,
50 absfile => $absfile,
51 fixfile => \&update_file,
52 };
53
54
55 #------------------------------------------------------------------------
56 # This is used to test that source files are automatically reloaded
57 # when updated on disk. we call it first to write a template file,
58 # which is then included in one of the -- test -- sections below.
59 # Then we call update_file() (via the 'fixfile' variable) and
60 # include it again to see if the new file contents were loaded.
61 #------------------------------------------------------------------------
62
63 sub update_file {
64 local *FP;
65 sleep(2); # ensure file time stamps are different
66 open(FP, ">$newfile") || die "$newfile: $!\n";
d52480d @abw *** empty log message ***
authored
67 print(FP @_) || die "failed to write $newfile: $!\n";
3ebfa07 @abw Initial revision
authored
68 close(FP);
69 }
70
71 update_file('This is the old content');
72
73
74 #------------------------------------------------------------------------
75 # instantiate a bunch of providers, using various different techniques,
76 # with different load options but sharing the same parser; then set them
77 # to work fetching some files and check they respond as expected
78 #------------------------------------------------------------------------
79
80 my $parser = $factory->parser(POST_CHOMP => 1)
81 || die $factory->error();
82 ok( $parser );
83
c942c1b @abw Version 2.15
authored
84 my $provinc = $factory->provider(
85 INCLUDE_PATH => $dir,
86 PARSER => $parser,
87 TOLERANT => 1
88 ) || die $factory->error();
3ebfa07 @abw Initial revision
authored
89 ok( $provinc );
90
c942c1b @abw Version 2.15
authored
91 my $provabs = $factory->provider({
92 ABSOLUTE => 1,
93 PARSER => $parser,
94 }) || die $factory->error();
3ebfa07 @abw Initial revision
authored
95 ok( $provabs );
96
c942c1b @abw Version 2.15
authored
97 my $provrel = Template::Provider->new({
98 RELATIVE => 1,
99 PARSER => $parser,
100 }) || die $Template::Provider::ERROR;
3ebfa07 @abw Initial revision
authored
101 ok( $provrel );
102
103 ok( $provinc->{ PARSER } == $provabs->{ PARSER } );
104 ok( $provabs->{ PARSER } == $provrel->{ PARSER } );
105
49d1e32 @abw *** empty log message ***
authored
106 banner('matrix');
107
3ebfa07 @abw Initial revision
authored
108 ok( delivered( $provinc, $file ) );
109 ok( declined( $provinc, $absfile ) );
110 ok( declined( $provinc, $relfile ) );
111
112 ok( declined( $provabs, $file ) );
113 ok( delivered( $provabs, $absfile ) );
49d1e32 @abw *** empty log message ***
authored
114 ok( denied( $provabs, $relfile ) );
3ebfa07 @abw Initial revision
authored
115
116 ok( declined( $provrel, $file ) );
49d1e32 @abw *** empty log message ***
authored
117 ok( denied( $provrel, $absfile ) );
3ebfa07 @abw Initial revision
authored
118 ok( delivered( $provrel, $relfile ) );
119
120
121 sub delivered {
122 my ($provider, $file) = @_;
123 my ($result, $error) = $provider->fetch($file);
4e99583 @abw * various minor updates to accomodate new DEBUG options
authored
124 my $nice_result = defined $result ? $result : '<undef>';
125 my $nice_error = defined $error ? $error : '<undef>';
126 # print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n"
127 # if $DEBUG;
3ebfa07 @abw Initial revision
authored
128 return ! $error;
129 }
130
131 sub declined {
132 my ($provider, $file) = @_;
133 my ($result, $error) = $provider->fetch($file);
4e99583 @abw * various minor updates to accomodate new DEBUG options
authored
134 my $nice_result = defined $result ? $result : '<undef>';
135 my $nice_error = defined $error ? $error : '<undef>';
136 # print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n"
137 # if $DEBUG;
3ebfa07 @abw Initial revision
authored
138 return ($error == Template::Constants::STATUS_DECLINED);
139 }
140
49d1e32 @abw *** empty log message ***
authored
141 sub denied {
142 my ($provider, $file) = @_;
143 my ($result, $error) = $provider->fetch($file);
4e99583 @abw * various minor updates to accomodate new DEBUG options
authored
144 # print STDERR "$provider->fetch($file) -> [$result] [$error]\n"
145 # if $DEBUG;
49d1e32 @abw *** empty log message ***
authored
146 return ($error == Template::Constants::STATUS_ERROR);
147 }
148
3ebfa07 @abw Initial revision
authored
149 #------------------------------------------------------------------------
93e861c @abw updates to tests for provider patches
authored
150 # Test if can fetch from a file handle
151 #------------------------------------------------------------------------
152
153 my $ttglob = Template->new || die "$Template::ERROR\n";
154 ok( $ttglob, 'Created template for glob test' );
155
156 # Make sure we have a multi-line template file so $/ is tested.
157 my $glob_file = abs_path($dir) . '/baz';
158
159 open GLOBFILE, $glob_file or die "Failed to open '$absfile': $!";
160 my $outstr = '';
161
162 $ttglob->process( \*GLOBFILE, { a => 'globtest' }, \$outstr ) || die $ttglob->error;
163
164 close GLOBFILE;
165
166 my $glob_expect = "This is the baz file, a: globtest\n";
167
168 my $ok = $glob_expect eq $outstr;
169
170 ok( $ok, $ok ? 'Fetch template from file handle' : <<EOF );
171 template text did not match template from file handle
172 MATCH FAILED
173 expect: $glob_expect
174 output: $outstr
175 EOF
176
177
178 #------------------------------------------------------------------------
3ebfa07 @abw Initial revision
authored
179 # now we'll fold those providers up into some Template objects that
180 # we can pass to text_expect() to do some template driven testing
181 #------------------------------------------------------------------------
182
e39913f @abw *** empty log message ***
authored
183 my $ttinc = Template->new( LOAD_TEMPLATES => [ $provinc ] )
3ebfa07 @abw Initial revision
authored
184 || die "$Template::ERROR\n";
185 ok( $ttinc );
186
e39913f @abw *** empty log message ***
authored
187 my $ttabs = Template->new( LOAD_TEMPLATES => [ $provabs ] )
3ebfa07 @abw Initial revision
authored
188 || die "$Template::ERROR\n";
189 ok( $ttabs );
190
e39913f @abw *** empty log message ***
authored
191 my $ttrel = Template->new( LOAD_TEMPLATES => [ $provrel ] )
3ebfa07 @abw Initial revision
authored
192 || die "$Template::ERROR\n";
193 ok( $ttrel );
194
195
fc832bb @abw * added tests for dynamic paths
authored
196 #------------------------------------------------------------------------
197 # here's a test of the dynamic path capability. we'll define a handler
198 # sub and an object to return a dynamic list of paths
199 #------------------------------------------------------------------------
200
201 package My::DPaths;
202
203 sub new {
204 my ($class, @paths) = @_;
205 bless \@paths, $class;
206 }
207 sub paths {
208 my $self = shift;
209 return [ @$self ];
210 }
211
212 package main;
213
214 sub dpaths {
215 return [ "$lib/one", "$lib/two" ],
216 }
217
6074e0f @abw * added test for MAX_DIRS runaway
authored
218 # this one is designed to test the $MAX_DIRS runaway limit
219 $Template::Provider::MAX_DIRS = 42;
220
221 sub badpaths {
222 return [ \&badpaths ],
223 }
224
fc832bb @abw * added tests for dynamic paths
authored
225 my $dpaths = My::DPaths->new("$lib/two", "$lib/one");
226
227 my $ttd1 = Template->new({
228 INCLUDE_PATH => [ \&dpaths, $dir ],
229 PARSER => $parser,
230 }) || die "$Template::ERROR\n";
231 ok( $ttd1, 'dynamic path (sub) template object created' );
232
233 my $ttd2 = Template->new({
234 INCLUDE_PATH => [ $dpaths, $dir ],
235 PARSER => $parser,
236 }) || die "$Template::ERROR\n";
237 ok( $ttd1, 'dynamic path (obj) template object created' );
238
6074e0f @abw * added test for MAX_DIRS runaway
authored
239 my $ttd3 = Template->new({
240 INCLUDE_PATH => [ \&badpaths ],
241 PARSER => $parser,
242 }) || die "$Template::ERROR\n";
243 ok( $ttd3, 'dynamic path (bad) template object created' );
244
fc832bb @abw * added tests for dynamic paths
authored
245
c942c1b @abw Version 2.15
authored
246 my $uselist = [
247 ttinc => $ttinc,
248 ttabs => $ttabs,
249 ttrel => $ttrel,
250 ttd1 => $ttd1,
251 ttd2 => $ttd2,
252 ttdbad => $ttd3 ];
3ebfa07 @abw Initial revision
authored
253
254 test_expect(\*DATA, $uselist, $vars);
255
256
257 __DATA__
258 -- test --
259 -- use ttinc --
260 [% TRY %]
261 [% INCLUDE foo %]
262 [% INCLUDE $relfile %]
263 [% CATCH file %]
264 Error: [% error.type %] - [% error.info.split(': ').1 %]
265 [% END %]
266 -- expect --
f4df3b6 @abw approach v2.03
authored
267 This is the foo file, a is Error: file - not found
6ddeb78 @abw added leak.t
authored
268
3ebfa07 @abw Initial revision
authored
269
270 -- test --
271 [% TRY %]
272 [% INCLUDE foo %]
273 [% INCLUDE $absfile %]
274 [% CATCH file %]
275 Error: [% error.type %] - [% error.info.split(': ').1 %]
276 [% END %]
277 -- expect --
f4df3b6 @abw approach v2.03
authored
278 This is the foo file, a is Error: file - not found
6ddeb78 @abw added leak.t
authored
279
3ebfa07 @abw Initial revision
authored
280
3e45060 @abw *** empty log message ***
authored
281 -- test --
282 [% TRY %]
f4df3b6 @abw approach v2.03
authored
283 [% INSERT foo +%]
3e45060 @abw *** empty log message ***
authored
284 [% INSERT $absfile %]
285 [% CATCH file %]
286 Error: [% error %]
287 [% END %]
288 -- expect --
289 -- process --
290 [% TAGS [* *] %]
f4df3b6 @abw approach v2.03
authored
291 This is the foo file, a is [% a -%]
3e45060 @abw *** empty log message ***
authored
292 Error: file error - [* absfile *]: not found
293
3ebfa07 @abw Initial revision
authored
294 #------------------------------------------------------------------------
295
296 -- test --
297 -- use ttrel --
298 [% TRY %]
299 [% INCLUDE $relfile %]
300 [% INCLUDE foo %]
6ddeb78 @abw added leak.t
authored
301 [% CATCH file -%]
3ebfa07 @abw Initial revision
authored
302 Error: [% error.type %] - [% error.info %]
303 [% END %]
304 -- expect --
f4df3b6 @abw approach v2.03
authored
305 This is the foo file, a is Error: file - foo: not found
3ebfa07 @abw Initial revision
authored
306
307 -- test --
308 [% TRY %]
6ddeb78 @abw added leak.t
authored
309 [% INCLUDE $relfile -%]
3ebfa07 @abw Initial revision
authored
310 [% INCLUDE $absfile %]
6ddeb78 @abw added leak.t
authored
311 [% CATCH file %]
3ebfa07 @abw Initial revision
authored
312 Error: [% error.type %] - [% error.info.split(': ').1 %]
313 [% END %]
314 -- expect --
f4df3b6 @abw approach v2.03
authored
315 This is the foo file, a is Error: file - absolute paths are not allowed (set ABSOLUTE option)
3ebfa07 @abw Initial revision
authored
316
6ddeb78 @abw added leak.t
authored
317
3e45060 @abw *** empty log message ***
authored
318 -- test --
319 foo: [% TRY; INSERT foo; CATCH; "$error\n"; END %]
f4df3b6 @abw approach v2.03
authored
320 rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END +%]
3e45060 @abw *** empty log message ***
authored
321 abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %]
322 -- expect --
323 -- process --
324 [% TAGS [* *] %]
325 foo: file error - foo: not found
f4df3b6 @abw approach v2.03
authored
326 rel: This is the foo file, a is [% a -%]
3e45060 @abw *** empty log message ***
authored
327 abs: file error - [* absfile *]: absolute paths are not allowed (set ABSOLUTE option)
328
3ebfa07 @abw Initial revision
authored
329 #------------------------------------------------------------------------
330
331 -- test --
332 -- use ttabs --
333 [% TRY %]
334 [% INCLUDE $absfile %]
335 [% INCLUDE foo %]
6ddeb78 @abw added leak.t
authored
336 [% CATCH file %]
3ebfa07 @abw Initial revision
authored
337 Error: [% error.type %] - [% error.info %]
338 [% END %]
339 -- expect --
f4df3b6 @abw approach v2.03
authored
340 This is the foo file, a is Error: file - foo: not found
3ebfa07 @abw Initial revision
authored
341
342 -- test --
343 [% TRY %]
344 [% INCLUDE $absfile %]
345 [% INCLUDE $relfile %]
6ddeb78 @abw added leak.t
authored
346 [% CATCH file %]
3ebfa07 @abw Initial revision
authored
347 Error: [% error.type %] - [% error.info.split(': ').1 %]
348 [% END %]
349 -- expect --
f4df3b6 @abw approach v2.03
authored
350 This is the foo file, a is Error: file - relative paths are not allowed (set RELATIVE option)
3ebfa07 @abw Initial revision
authored
351
352
3e45060 @abw *** empty log message ***
authored
353 -- test --
354 foo: [% TRY; INSERT foo; CATCH; "$error\n"; END %]
355 rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END %]
356 abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %]
357 -- expect --
358 -- process --
359 [% TAGS [* *] %]
360 foo: file error - foo: not found
361 rel: file error - [* relfile *]: relative paths are not allowed (set RELATIVE option)
f4df3b6 @abw approach v2.03
authored
362 abs: This is the foo file, a is [% a -%]
3e45060 @abw *** empty log message ***
authored
363
364
6ddeb78 @abw added leak.t
authored
365
3ebfa07 @abw Initial revision
authored
366 #------------------------------------------------------------------------
367 # test that files updated on disk are automatically reloaded.
368 #------------------------------------------------------------------------
369
370 -- test --
371 -- use ttinc --
1303d12 @abw *** empty log message ***
authored
372 [% INCLUDE foobar %]
3ebfa07 @abw Initial revision
authored
373 -- expect --
374 This is the old content
375
376 -- test --
377 [% CALL fixfile('This is the new content') %]
1303d12 @abw *** empty log message ***
authored
378 [% INCLUDE foobar %]
3ebfa07 @abw Initial revision
authored
379 -- expect --
380 This is the new content
381
fc832bb @abw * added tests for dynamic paths
authored
382 #------------------------------------------------------------------------
383 # dynamic path tests
384 #------------------------------------------------------------------------
385
386 -- test --
387 -- use ttd1 --
388 foo: [% PROCESS foo | trim +%]
389 bar: [% PROCESS bar | trim +%]
390 baz: [% PROCESS baz a='alpha' | trim %]
391 -- expect --
392 foo: This is one/foo
393 bar: This is two/bar
394 baz: This is the baz file, a: alpha
3ebfa07 @abw Initial revision
authored
395
fc832bb @abw * added tests for dynamic paths
authored
396 -- test --
b7b169c @abw * test INSERT with dynamic paths
authored
397 foo: [% INSERT foo | trim +%]
398 bar: [% INSERT bar | trim +%]
399 -- expect --
400 foo: This is one/foo
401 bar: This is two/bar
402
403 -- test --
fc832bb @abw * added tests for dynamic paths
authored
404 -- use ttd2 --
405 foo: [% PROCESS foo | trim +%]
406 bar: [% PROCESS bar | trim +%]
407 baz: [% PROCESS baz a='alpha' | trim %]
408 -- expect --
409 foo: This is two/foo
410 bar: This is two/bar
411 baz: This is the baz file, a: alpha
b7b169c @abw * test INSERT with dynamic paths
authored
412
413 -- test --
414 foo: [% INSERT foo | trim +%]
415 bar: [% INSERT bar | trim +%]
416 -- expect --
417 foo: This is two/foo
418 bar: This is two/bar
6074e0f @abw * added test for MAX_DIRS runaway
authored
419
420 -- test --
421 -- use ttdbad --
422 [% TRY; INCLUDE foo; CATCH; e; END %]
423 -- expect --
424 file error - INCLUDE_PATH exceeds 42 directories
Something went wrong with that request. Please try again.