#============================================================= -*-perl-*-
#
# t/filter.t
#
# Template script testing FILTER directive.
#
# Written by Andy Wardley <abw@kfs.org>
#
# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: filter.t,v 2.20 2003/04/29 12:49:43 abw Exp $
#
#========================================================================
use strict;
use lib qw( ./lib ../lib );
use Template::Filters;
use Template qw( :status );
use Template::Parser;
use Template::Test;
use Template::Constants qw( :debug );
$^W = 1;
my $DEBUG = grep(/^--?d(debug)?$/, @ARGV);
$Template::Test::DEBUG = 0;
$Template::Test::EXTRA = 1; # ensure redirected file is created
#$Template::Context::DEBUG = 1;
#$Template::DEBUG = 1;
#$Template::Parser::DEBUG = 1;
#$Template::Directive::PRETTY = 1;
#------------------------------------------------------------------------
# hack to allow STDERR to be tied to a variable.
# (I'm really surprised there isn't a standard module which does this)
#------------------------------------------------------------------------
package Tie::File2Str;
sub TIEHANDLE {
my ($class, $textref) = @_;
bless $textref, $class;
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
#------------------------------------------------------------------------
# now for the main event...
#------------------------------------------------------------------------
package main;
# tie STDERR to a variable
my $stderr = '';
tie(*STDERR, "Tie::File2Str", \$stderr);
my $dir = -d 't' ? 't/test/tmp' : 'test/tmp';
my $file = 'xyz';
my ($a, $b, $c, $d) = qw( alpha bravo charlie delta );
my $params = {
'a' => $a,
'b' => $b,
'c' => $c,
'd' => $d,
'list' => [ $a, $b, $c, $d ],
'text' => 'The cat sat on the mat',
outfile => $file,
stderr => sub { $stderr },
despace => bless(\&despace, 'anything'),
};
my $filters = {
'nonfilt' => 'nonsense',
'microjive' => \µjive,
'microsloth' => [ \µsloth, 0 ],
'censor' => [ \&censor_factory, 1 ],
'badfact' => [ sub { return 'nonsense' }, 1 ],
'badfilt' => [ 'rubbish', 1 ],
'barfilt' => [ \&barf_up, 1 ],
};
my $config1 = {
INTERPOLATE => 1,
POST_CHOMP => 1,
FILTERS => $filters,
};
my $config2 = {
EVAL_PERL => 1,
FILTERS => $filters,
OUTPUT_PATH => $dir,
BARVAL => 'some random value',
};
unlink "$dir/$file" if -f "$dir/$file";
my $tt1 = Template->new($config1);
my $tt2 = Template->new($config2);
$tt2->context->define_filter('another', \&another, 1);
test_expect(\*DATA, [ default => $tt1, evalperl => $tt2 ], $params);
ok( -f "$dir/$file", "$dir/$file exists" );
unlink "$dir/$file" if -f "$dir/$file";
#------------------------------------------------------------------------
# custom filter subs
#------------------------------------------------------------------------
sub microjive {
my $text = shift;
$text =~ s/microsoft/The 'Soft/sig;
$text;
}
sub microsloth {
my $text = shift;
$text =~ s/microsoft/Microsloth/sig;
$text;
}
sub censor_factory {
my @forbidden = @_;
return sub {
my $text = shift;
foreach my $word (@forbidden) {
$text =~ s/$word/[** CENSORED **]/sig;
}
return $text;
}
}
sub barf_up {
my $context = shift;
my $foad = shift || 0;
if ($foad == 0) {
return (undef, "barfed");
}
elsif ($foad == 1) {
return (undef, Template::Exception->new('dead', 'deceased'));
}
elsif ($foad == 2) {
die "keeled over\n";
}
else {
die (Template::Exception->new('unwell', 'sick as a parrot'));
}
}
sub despace {
my $text = shift;
$text =~ s/\s+/_/g;
return $text;
}
sub another {
my ($context, $n) = @_;
return sub {
my $text = shift;
return $text x $n;
}
}
__DATA__
#------------------------------------------------------------------------
# test failures
#------------------------------------------------------------------------
-- test --
[% TRY %]
[% FILTER nonfilt %]
blah blah blah
[% END %]
[% CATCH %]
BZZZT: [% error.type %]: [% error.info %]
[% END %]
-- expect --
BZZZT: filter: invalid FILTER entry for 'nonfilt' (not a CODE ref)
-- test --
[% TRY %]
[% FILTER badfact %]
blah blah blah
[% END %]
[% CATCH %]
BZZZT: [% error.type %]: [% error.info %]
[% END %]
-- expect --
BZZZT: filter: invalid FILTER for 'badfact' (not a CODE ref)
-- test --
[% TRY %]
[% FILTER badfilt %]
blah blah blah
[% END %]
[% CATCH %]
BZZZT: [% error.type %]: [% error.info %]
[% END %]
-- expect --
BZZZT: filter: invalid FILTER entry for 'badfilt' (not a CODE ref)
-- test --
[% TRY;
"foo" | barfilt;
CATCH;
"$error.type: $error.info";
END
%]
-- expect --
filter: barfed
-- test --
[% TRY;
"foo" | barfilt(1);
CATCH;
"$error.type: $error.info";
END
%]
-- expect --
dead: deceased
-- test --
[% TRY;
"foo" | barfilt(2);
CATCH;
"$error.type: $error.info";
END
%]
-- expect --
filter: keeled over
-- test --
[% TRY;
"foo" | barfilt(3);
CATCH;
"$error.type: $error.info";
END
%]
-- expect --
unwell: sick as a parrot
#------------------------------------------------------------------------
# test filters
#------------------------------------------------------------------------
-- test --
[% FILTER html %]
This is some html text
All the <tags> should be escaped & protected
[% END %]
-- expect --
This is some html text
All the <tags> should be escaped & protected
-- test --
[% text = "The <cat> sat on the <mat>" %]
[% FILTER html %]
text: $text
[% END %]
-- expect --
text: The <cat> sat on the <mat>
-- test --
[% text = "The <cat> sat on the <mat>" %]
[% text FILTER html %]
-- expect --
The <cat> sat on the <mat>
-- test --
[% FILTER html %]
"It isn't what I expected", he replied.
[% END %]
-- expect --
"It isn't what I expected", he replied.
-- test --
[% FILTER format %]
Hello World!
[% END %]
-- expect --
Hello World!
-- test --
# test aliasing of a filter
[% FILTER comment = format('<!-- %s -->') %]
Hello World!
[% END +%]
[% "Goodbye, cruel World" FILTER comment %]
-- expect --
<!-- Hello World! -->
<!-- Goodbye, cruel World -->
-- test --
[% FILTER format %]
Hello World!
[% END %]
-- expect --
Hello World!
-- test --
[% "Foo" FILTER test1 = format('+++ %-4s +++') +%]
[% FOREACH item = [ 'Bar' 'Baz' 'Duz' 'Doze' ] %]
[% item FILTER test1 +%]
[% END %]
[% "Wiz" FILTER test1 = format("*** %-4s ***") +%]
[% "Waz" FILTER test1 +%]
-- expect --
+++ Foo +++
+++ Bar +++
+++ Baz +++
+++ Duz +++
+++ Doze +++
*** Wiz ***
*** Waz ***
-- test --
[% FILTER microjive %]
The "Halloween Document", leaked to Eric Raymond from an insider
at Microsoft, illustrated Microsoft's strategy of "Embrace,
Extend, Extinguish"
[% END %]
-- expect --
The "Halloween Document", leaked to Eric Raymond from an insider
at The 'Soft, illustrated The 'Soft's strategy of "Embrace,
Extend, Extinguish"
-- test --
[% FILTER microsloth %]
The "Halloween Document", leaked to Eric Raymond from an insider
at Microsoft, illustrated Microsoft's strategy of "Embrace,
Extend, Extinguish"
[% END %]
-- expect --
The "Halloween Document", leaked to Eric Raymond from an insider
at Microsloth, illustrated Microsloth's strategy of "Embrace,
Extend, Extinguish"
-- test --
[% FILTER censor('bottom' 'nipple') %]
At the bottom of the hill, he had to pinch the
nipple to reduce the oil flow.
[% END %]
-- expect --
At the [** CENSORED **] of the hill, he had to pinch the
[** CENSORED **] to reduce the oil flow.
-- test --
[% FILTER bold = format('<b>%s</b>') %]
This is bold
[% END +%]
[% FILTER italic = format('<i>%s</i>') %]
This is italic
[% END +%]
[% 'This is both' FILTER bold FILTER italic %]
-- expect --
<b>This is bold</b>
<i>This is italic</i>
<i><b>This is both</b></i>
-- test --
[% "foo" FILTER format("<< %s >>") FILTER format("=%s=") %]
-- expect --
=<< foo >>=
-- test --
[% blocktext = BLOCK %]
The cat sat on the mat
Mary had a little Lamb
You shall have a fishy on a little dishy, when the boat comes in. What
if I can't wait until then? I'm hungry!
[% END -%]
[% global.blocktext = blocktext; blocktext %]
-- expect --
The cat sat on the mat
Mary had a little Lamb
You shall have a fishy on a little dishy, when the boat comes in. What
if I can't wait until then? I'm hungry!
-- test --
[% global.blocktext FILTER html_para %]
-- expect --
<p>
The cat sat on the mat
</p>
<p>
Mary had a little Lamb
</p>
<p>
You shall have a fishy on a little dishy, when the boat comes in. What
if I can't wait until then? I'm hungry!
</p>
-- test --
[% global.blocktext FILTER html_break %]
-- expect --
The cat sat on the mat
<br />
<br />
Mary had a little Lamb
<br />
<br />
You shall have a fishy on a little dishy, when the boat comes in. What
if I can't wait until then? I'm hungry!
-- test --
[% global.blocktext FILTER html_para_break %]
-- expect --
The cat sat on the mat
<br />
<br />
Mary had a little Lamb
<br />
<br />
You shall have a fishy on a little dishy, when the boat comes in. What
if I can't wait until then? I'm hungry!
-- test --
[% global.blocktext FILTER html_line_break %]
-- expect --
The cat sat on the mat<br />
<br />
Mary had a little Lamb<br />
<br />
<br />
<br />
You shall have a fishy on a little dishy, when the boat comes in. What <br />
if I can't wait until then? I'm hungry!<br />
-- test --
[% global.blocktext FILTER truncate(10) %]
-- expect --
The cat...
-- test --
[% global.blocktext FILTER truncate %]
-- expect --
The cat sat on the mat
Mary ...
-- test --
[% 'Hello World' | truncate(8) +%]
[% 'Hello World' | truncate(10) +%]
[% 'Hello World' | truncate(20) +%]
-- expect --
Hello...
Hello W...
Hello World
-- test --
[% "foo..." FILTER repeat(5) %]
-- expect --
foo...foo...foo...foo...foo...
-- test --
[% FILTER truncate(21) %]
I have much to say on this matter that has previously been said
on more than one occassion.
[% END %]
-- expect --
I have much to say...
-- test --
[% FILTER truncate(25) %]
Nothing much to say
[% END %]
-- expect --
Nothing much to say
-- test --
[% FILTER repeat(3) %]
Am I repeating myself?
[% END %]
-- expect --
Am I repeating myself?
Am I repeating myself?
Am I repeating myself?
-- test --
[% text FILTER remove(' ') +%]
[% text FILTER remove('\s+') +%]
[% text FILTER remove('cat') +%]
[% text FILTER remove('at') +%]
[% text FILTER remove('at', 'splat') +%]
-- expect --
Thecatsatonthemat
Thecatsatonthemat
The sat on the mat
The c s on the m
The c s on the m
-- test --
[% text FILTER replace(' ', '_') +%]
[% text FILTER replace('sat', 'shat') +%]
[% text FILTER replace('at', 'plat') +%]
-- expect --
The_cat_sat_on_the_mat
The cat shat on the mat
The cplat splat on the mplat
-- test --
[% text = 'The <=> operator' %]
[% text|html %]
-- expect --
The <=> operator
-- test --
[% text = 'The <=> operator, blah, blah' %]
[% text | html | replace('blah', 'rhubarb') %]
-- expect --
The <=> operator, rhubarb, rhubarb
-- test --
[% | truncate(25) %]
The cat sat on the mat, and wondered to itself,
"How might I be able to climb up onto the shelf?",
For up there I am sure I'll see,
A tasty fishy snack for me.
[% END %]
-- expect --
The cat sat on the mat...
-- test --
[% FILTER upper %]
The cat sat on the mat
[% END %]
-- expect --
THE CAT SAT ON THE MAT
-- test --
[% FILTER lower %]
The cat sat on the mat
[% END %]
-- expect --
the cat sat on the mat
-- test --
[% 'arse' | stderr %]
stderr: [% stderr %]
-- expect --
stderr: arse
-- test --
[% percent = '%'
left = "[$percent"
right = "$percent]"
dir = "$left a $right blah blah $left b $right"
%]
[% dir +%]
FILTER [[% dir | eval %]]
FILTER [[% dir | evaltt %]]
-- expect --
[% a %] blah blah [% b %]
FILTER [alpha blah blah bravo]
FILTER [alpha blah blah bravo]
-- test --
[% TRY %]
[% dir = "[\% FOREACH a = { 1 2 3 } %\]a: [\% a %\]\n[\% END %\]" %]
[% dir | eval %]
[% CATCH %]
error: [[% error.type %]] [[% error.info %]]
[% END %]
-- expect --
error: [file] [parse error - input text line 1: unexpected token (1)
[% FOREACH a = { 1 2 3 } %]]
-- test --
nothing
[% TRY;
'$x = 10; $b = 20; $x + $b' | evalperl;
CATCH;
"$error.type: $error.info";
END
+%]
happening
-- expect --
nothing
perl: EVAL_PERL is not set
happening
-- test --
[% TRY -%]
before
[% FILTER redirect('xyz') %]
blah blah blah
here is the news
[% a %]
[% END %]
after
[% CATCH %]
ERROR [% error.type %]: [% error.info %]
[% END %]
-- expect --
before
ERROR redirect: OUTPUT_PATH is not set
-- test --
-- use evalperl --
[% FILTER evalperl %]
$a = 10;
$b = 20;
$stash->{ foo } = $a + $b;
$stash->{ bar } = $context->config->{ BARVAL };
"all done"
[% END +%]
foo: [% foo +%]
bar: [% bar %]
-- expect --
all done
foo: 30
bar: some random value
-- test --
[% TRY -%]
before
[% FILTER file(outfile) -%]
blah blah blah
here is the news
[% a %]
[% END -%]
after
[% CATCH %]
ERROR [% error.type %]: [% error.info %]
[% END %]
-- expect --
before
after
-- test --
[% PERL %]
# static filter subroutine
$Template::Filters::FILTERS->{ bar } = sub {
my $text = shift;
$text =~ s/^/bar: /gm;
return $text;
};
[% END -%]
[% FILTER bar -%]
The cat sat on the mat
The dog sat on the log
[% END %]
-- expect --
bar: The cat sat on the mat
bar: The dog sat on the log
-- test --
[% PERL %]
# dynamic filter factory
$Template::Filters::FILTERS->{ baz } = [
sub {
my $context = shift;
my $word = shift || 'baz';
return sub {
my $text = shift;
$text =~ s/^/$word: /gm;
return $text;
};
}, 1 ];
[% END -%]
[% FILTER baz -%]
The cat sat on the mat
The dog sat on the log
[% END %]
[% FILTER baz('wiz') -%]
The cat sat on the mat
The dog sat on the log
[% END %]
-- expect --
baz: The cat sat on the mat
baz: The dog sat on the log
wiz: The cat sat on the mat
wiz: The dog sat on the log
-- test --
-- use evalperl --
[% PERL %]
$stash->set('merlyn', bless \&merlyn1, 'ttfilter');
sub merlyn1 {
my $text = shift || '<no text>';
$text =~ s/stone/henge/g;
return $text;
}
[% END -%]
[% FILTER $merlyn -%]
Let him who is without sin cast the first stone.
[% END %]
-- expect --
Let him who is without sin cast the first henge.
-- test --
-- use evalperl --
[% PERL %]
$stash->set('merlyn', sub { \&merlyn2 });
sub merlyn2 {
my $text = shift || '<no text>';
$text =~ s/stone/henge/g;
return $text;
}
[% END -%]
[% FILTER $merlyn -%]
Let him who is without sin cast the first stone.
[% END %]
-- expect --
Let him who is without sin cast the first henge.
-- test --
[% myfilter = 'html' -%]
[% FILTER $myfilter -%]
<html>
[% END %]
-- expect --
<html>
-- test --
[% FILTER $despace -%]
blah blah blah
[%- END %]
-- expect --
blah_blah_blah
-- test --
-- use evalperl --
[% PERL %]
$context->filter(\&newfilt, undef, 'myfilter');
sub newfilt {
my $text = shift;
$text =~ s/\s+/=/g;
return $text;
}
[% END -%]
[% FILTER myfilter -%]
This is a test
[%- END %]
-- expect --
This=is=a=test
-- test --
[% PERL %]
$context->define_filter('xfilter', \&xfilter);
sub xfilter {
my $text = shift;
$text =~ s/\s+/X/g;
return $text;
}
[% END -%]
[% FILTER xfilter -%]
blah blah blah
[%- END %]
-- expect --
blahXblahXblah
-- test --
[% FILTER another(3) -%]
foo bar baz
[% END %]
-- expect --
foo bar baz
foo bar baz
foo bar baz
-- test --
[% '$stash->{ a } = 25' FILTER evalperl %]
[% a %]
-- expect --
25
25
-- test --
[% '$stash->{ a } = 25' FILTER perl %]
[% a %]
-- expect --
25
25
-- test --
[% FILTER indent -%]
The cat sat
on the mat
[% END %]
-- expect --
The cat sat
on the mat
-- test --
[% FILTER indent(2) -%]
The cat sat
on the mat
[% END %]
-- expect --
The cat sat
on the mat
-- test --
[% FILTER indent('>> ') -%]
The cat sat
on the mat
[% END %]
-- expect --
>> The cat sat
>> on the mat
-- test --
[% text = 'The cat sat on the mat';
text | indent('> ') | indent('+') %]
-- expect --
+> The cat sat on the mat
-- test --
<<[% FILTER trim %]
The cat sat
on the
mat
[% END %]>>
-- expect --
<<The cat sat
on the
mat>>
-- test --
<<[% FILTER collapse %]
The cat sat
on the
mat
[% END %]>>
-- expect --
<<The cat sat on the mat>>
-- test --
[% FILTER format('++%s++') %]Hello World[% END %]
[% FILTER format %]Hello World[% END %]
-- expect --
++Hello World++
Hello World
-- test --
[% "my file.html" FILTER uri %]
-- expect --
my%20file.html
-- test --
[% "my<file & your>file.html" FILTER uri %]
-- expect --
my%3Cfile%20&%20your%3Efile.html
-- test --
[% "my<file & your>file.html" | uri | html %]
-- expect --
my%3Cfile%20&%20your%3Efile.html
-- test --
[% "guitar&file.html" | uri %]
-- expect --
guitar&file.html
-- test --
[% "guitar&file.html" | uri | html %]
-- expect --
guitar&amp;file.html
-- test --
[% 'foobar' | ucfirst %]
-- expect --
Foobar
-- test --
[% 'FOOBAR' | lcfirst %]
-- expect --
fOOBAR