Template-Toolkit-3.102/0000755000000000000000000000000014635373376013434 5ustar rootrootTemplate-Toolkit-3.102/t/0000755000000000000000000000000014635373376013677 5ustar rootrootTemplate-Toolkit-3.102/t/zz-url2.t0000644000000000000000000000732514635371175015413 0ustar rootroot#============================================================= -*-perl-*- # # t/url.t # # Template script testing URL plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ../lib ); use Template; use Template::Test; use Template::Plugin::URL; $^W = 1; skip_all("We can't agree on the right joint for the URL plugin"); $Template::Test::DEBUG = 0; my $urls = { product => { map { $_->{ name }, Template::Plugin::URL->new(undef, # no context $_->{ url }, $_->{ args }); } ( { name => 'view', url => '/product', }, { name => 'add', url => '/product', args => { action => 'add' }, }, { name => 'edit', url => '/product', args => { action => 'edit', style => 'editor' }, }, ), }, }; my $vars = { url => $urls, sorted => \&sort_params, }; test_expect(\*DATA, { INTERPOLATE => 1 }, $vars); # url params are constructed in a non-deterministic order. we obviously # can't test against this so we use this devious hack to reorder a # query so that its parameters are in alphabetical order. # ------------------------------------------------------------------------ # later note: in adding support for parameters with multiple values, the # sort_params() hacked below got broken so as a temporary solution, I # changed teh URL plugin to sort all params by key when generating the # URL sub sort_params { my $query = shift; my ($base, $args) = split(/\?/, $query); my (@args, @keys, %argtab); print STDERR "sort_parms(\"$query\")\n" if $Template::Test::DEBUG; @args = split('&', $args); @keys = map { (split('=', $_))[0] } @args; @argtab{ @keys } = @args; @keys = sort keys %argtab; @args = map { $argtab{ $_ } } @keys; $args = join('&', @args); $query = join('?', length $base ? ($base, $args) : $args); print STDERR "returning [$query]\n" if $Template::Test::DEBUG; return $query; } #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- [% USE url -%] loaded [% url %] [% url('foo') %] [% url(foo='bar') %] [% url('bar', wiz='woz') %] -- expect -- loaded foo foo=bar bar?wiz=woz -- test -- [% USE url('here') -%] [% url %] [% url('there') %] [% url(any='where') %] [% url('every', which='way') %] [% sorted( url('every', which='way', you='can') ) %] -- expect -- here there here?any=where every?which=way every?which=way;you=can -- test -- [% USE url('there', name='fred') -%] [% url %] [% url(name='tom') %] [% sorted( url(age=24) ) %] [% sorted( url(age=42, name='frank') ) %] -- expect -- there?name=fred there?name=tom there?age=24;name=fred there?age=42;name=frank -- test -- [% USE url('/cgi-bin/woz.pl') -%] [% url(name="Elrich von Benjy d'Weiro") %] -- expect -- /cgi-bin/woz.pl?name=Elrich%20von%20Benjy%20d%27Weiro -- test -- [% USE url '/script' { one => 1, two => [ 2, 4 ], three => [ 3, 6, 9] } -%] [% url %] -- expect -- /script?one=1;three=3;three=6;three=9;two=2;two=4 -- test -- [% url.product.view %] [% url.product.view(style='compact') %] -- expect -- /product /product?style=compact -- test -- [% url.product.add %] [% url.product.add(style='compact') %] -- expect -- /product?action=add /product?action=add;style=compact -- test -- [% url.product.edit %] [% url.product.edit(style='compact') %] -- expect -- /product?action=edit;style=editor /product?action=edit;style=compact Template-Toolkit-3.102/t/trace_vars.t0000644000000000000000000000215513600243610016172 0ustar rootroot#!/usr/bin/perl # # Perl script to test statis analysis of variables used. # # Written by Andy Wardley http://wardley.org/ # # 31 July 2009 # use lib qw( ./lib ../lib ); use strict; use warnings; use Template; use Template::Test; my $tt = Template->new( TRACE_VARS => 1 ); my $template = $tt->template(\*DATA) || die $tt->error; my $vars = $template->variables; ok( $vars->{ foo }, 'foo is used' ); ok( $vars->{ bar }, 'bar is used' ); ok( $vars->{ bar }->{ baz }, 'bar.baz is used' ); ok( $vars->{ blam }, 'blam is used' ); ok( $vars->{ blam }->{ 0 }, 'blam.0 is used' ); ok( $vars->{ wig }, 'wig is used' ); ok( $vars->{ wig }->{ wam }, 'wig.wam is used' ); ok( $vars->{ wig }->{ wam }->{ bam }, 'wig.wam.bam is used' ); # NOTE: we don't currently detect variables being set, only those being # fetched... foreach my $letter ('a'..'e') { ok( $vars->{ $letter }, "$letter is used" ); } # TODO: extend this so we can detect the variables f, g, x and y.z being # assigned to. __END__ Hello World [% foo -%] [% bar.baz -%] [% blam.0 -%] [% wig(10).wam(a,b,c).bam(f = d, g = e) -%] [% x = 10; y.z = 20 -%] Goodbye Template-Toolkit-3.102/t/test/0000755000000000000000000000000014635373376014656 5ustar rootrootTemplate-Toolkit-3.102/t/test/src/0000755000000000000000000000000014635373376015445 5ustar rootrootTemplate-Toolkit-3.102/t/test/src/divisionbyzero0000644000000000000000000000006413600243610020421 0ustar rootroot[% a = 420; b = 0; TRY; a / b; CATCH; error; END %] Template-Toolkit-3.102/t/test/src/baz0000644000000000000000000000017413600243610016120 0ustar rootroot[% "name: $template.name modtime: $template.modtime\n" IF showname -%] This is the baz file, a: [% a %][% a = 'charlie' %] Template-Toolkit-3.102/t/test/src/blam0000644000000000000000000000002513600243610016252 0ustar rootrootThis is the blam fileTemplate-Toolkit-3.102/t/test/src/recurse0000644000000000000000000000021313600243610017006 0ustar rootroot[% META name = 'my file' -%] recursion count: [% counter %] [% counter = counter + 1 -%] [% RETURN IF counter > 3 -%] [% PROCESS recurse %]Template-Toolkit-3.102/t/test/src/leak20000644000000000000000000000006213600243610016336 0ustar rootroot [% USE h = holler('Goodbye') -%] Template-Toolkit-3.102/t/test/src/bar/0000755000000000000000000000000014635373376016211 5ustar rootrootTemplate-Toolkit-3.102/t/test/src/bar/baz.txt0000644000000000000000000000010313600243610017472 0ustar rootroot[% DEFAULT time = 'now' -%] [% INCLUDE bar/baz %] The time is $timeTemplate-Toolkit-3.102/t/test/src/bar/baz0000644000000000000000000000010513600243610016656 0ustar rootroot[% DEFAULT word = 'qux' -%] This is file baz The word is '[% word %]'Template-Toolkit-3.102/t/test/src/evalperl0000644000000000000000000000007413600243610017155 0ustar rootrootThis file includes a [% PERL %]print "perl"[% END %] block. Template-Toolkit-3.102/t/test/src/benchmark0000644000000000000000000000073313600243610017277 0ustar rootroot[% PROCESS header title = 'This is a Test' %] Once upon a time there was a small caterpillar called Frank. Frank was very hungry so he went into the garden and ate all the cabbages. Item: [% FOREACH item = ['foo', 'bar', 'baz'] %] * [% item %] [% END %] People: [% FOREACH person = people %] * [% person.id %] : [% person.name %] ([% person.email %]) [% IF person.isadmin -%] ** THIS PERSON IS AN ADMINISTRATOR ** [% END -%] [% END -%] [% PROCESS footer %]Template-Toolkit-3.102/t/test/src/leak10000644000000000000000000000005413600243610016336 0ustar rootroot [% a = holler('Hello') -%] Template-Toolkit-3.102/t/test/src/complex0000644000000000000000000000072614635373143017034 0ustar rootroot[% META author = 'abw' version = 1.23 %] [% INCLUDE header title = "Yet Another Template Test" +%] This is a more complex file which includes some BLOCK definitions [% INCLUDE footer +%] [% BLOCK header %] This is the header, title: [% title %] [% END %] [% BLOCK footer %][%# NOTE: the 'template' is the parent doc, not this one %] This is the footer, author: [% template.author %], version: [% template.version+%] [% "- $x " FOREACH x = [3 2 1] %] [% END %] Template-Toolkit-3.102/t/test/src/golf0000644000000000000000000000007013600243610016266 0ustar rootroot[% DEFAULT g = c.f.g -%] This is the golf file, g is $g Template-Toolkit-3.102/t/test/src/foobar0000644000000000000000000000002714635373155016632 0ustar rootrootThis is the new contentTemplate-Toolkit-3.102/t/test/src/metadata0000644000000000000000000000024113600243610017117 0ustar rootroot[% META title = 'The cat sat on the mat' author = 'Andy Wardley' -%] TITLE: [% template.title %] [% template.name %] last modified [% template.modtime %] Template-Toolkit-3.102/t/test/src/README0000644000000000000000000000011113600243610016270 0ustar rootrootThis directory contains various template files used by the test scripts. Template-Toolkit-3.102/t/test/src/mywrap0000644000000000000000000000007613600243610016664 0ustar rootrootWrapper Header Title: [% title %] [% content %] Wrapper FooterTemplate-Toolkit-3.102/t/test/src/foo0000644000000000000000000000004313600243610016122 0ustar rootrootThis is the foo file, a is [% a -%]Template-Toolkit-3.102/t/test/lib/0000755000000000000000000000000014635373376015424 5ustar rootrootTemplate-Toolkit-3.102/t/test/lib/trimme0000644000000000000000000000025113600243610016614 0ustar rootroot[% DEFAULT title = 'something' colour = 'red' %] [%# more spae-gobbling directives %] I am a template element file which will get TRIMmed [% foo = 'bar' %] Template-Toolkit-3.102/t/test/lib/outer0000644000000000000000000000006313600243610016456 0ustar rootroot [% content %] Template-Toolkit-3.102/t/test/lib/badrawperl0000644000000000000000000000017613600243610017450 0ustar rootrootThis is some text [% RAWPERL %] This is some illegal perl code which should cause a parse error [% END %] more stuff goes hereTemplate-Toolkit-3.102/t/test/lib/warning0000644000000000000000000000003513600243610016764 0ustar rootrootHello [% a = a + 1 -%] World Template-Toolkit-3.102/t/test/lib/header0000644000000000000000000000007013600243610016546 0ustar rootrootheader: title: [% title %] menu: [% INCLUDE menu %] Template-Toolkit-3.102/t/test/lib/config0000644000000000000000000000015213600243610016564 0ustar rootroot[% DEFAULT title = 'Default Title' -%] [% BLOCK menu -%] This is the menu, defined in 'config' [%- END -%]Template-Toolkit-3.102/t/test/lib/dos_newlines0000644000000000000000000000003213600243610020005 0ustar rootroot[% ding -%] [% dong -%] Template-Toolkit-3.102/t/test/lib/chomp0000644000000000000000000000007013600243610016424 0ustar rootroot[%- 1 %] [%- 1 %] [%- 1 %] [%- 1 %] [%- 1 %] [%- END %] Template-Toolkit-3.102/t/test/lib/process0000644000000000000000000000006213600243610016775 0ustar rootrootbegin process [% PROCESS $template -%] end processTemplate-Toolkit-3.102/t/test/lib/incblock0000644000000000000000000000040113600243610017100 0ustar rootroot[% BLOCK first_block -%] this is my first block, a is set to '[% a %]' [%- END -%] [% BLOCK second_block; DEFAULT b = 99 m = 98 -%] this is my second block, a is initially set to '[% a %]' and then set to [% a = s %]'[% a %]' b is $b m is $m [%- END -%] Template-Toolkit-3.102/t/test/lib/before0000644000000000000000000000002213600243610016555 0ustar rootrootThis comes before Template-Toolkit-3.102/t/test/lib/inner0000644000000000000000000000012013600243610016425 0ustar rootroot [% content %] [% title = "inner $title" -%]Template-Toolkit-3.102/t/test/lib/udata20000644000000000000000000000027313600243610016503 0ustar rootroot# more test data for the Datafile plugin id | name | email way | Wendy Yardley | way@cre.canon.co.uk mop | Marty Proton | mop@cre.canon.co.uk nellb | Nell Browser | nellb@cre.canon.co.uk Template-Toolkit-3.102/t/test/lib/one/0000755000000000000000000000000014635373376016205 5ustar rootrootTemplate-Toolkit-3.102/t/test/lib/one/foo0000644000000000000000000000001713600243610016663 0ustar rootrootThis is one/fooTemplate-Toolkit-3.102/t/test/lib/default0000644000000000000000000000003113600243610016737 0ustar rootrootThis is the default file Template-Toolkit-3.102/t/test/lib/error0000644000000000000000000000005513600243610016452 0ustar rootrooterror: [[% error.type %]] [[% error.info %]] Template-Toolkit-3.102/t/test/lib/after0000644000000000000000000000002013600243610016412 0ustar rootrootThis comes afterTemplate-Toolkit-3.102/t/test/lib/two/0000755000000000000000000000000014635373376016235 5ustar rootrootTemplate-Toolkit-3.102/t/test/lib/two/bar0000644000000000000000000000001713600243610016674 0ustar rootrootThis is two/barTemplate-Toolkit-3.102/t/test/lib/two/foo0000644000000000000000000000001713600243610016713 0ustar rootrootThis is two/fooTemplate-Toolkit-3.102/t/test/lib/footer0000644000000000000000000000000713600243610016614 0ustar rootrootfooter Template-Toolkit-3.102/t/test/lib/simple20000644000000000000000000000006313600243610016673 0ustar rootroot[% USE Simple -%] test 2: [% 'badger' | simple -%] Template-Toolkit-3.102/t/test/lib/header.tt20000644000000000000000000000007413600243610017262 0ustar rootrootheader.tt2: title: [% title %] menu: [% INCLUDE menu %] Template-Toolkit-3.102/t/test/lib/blockdef0000644000000000000000000000030713600243610017072 0ustar rootrootstart of blockdef [%- BLOCK block1 -%] This is block 1, defined in blockdef, a is [% a %] [% END %] [% BLOCK block2 -%] This is block 2, defined in blockdef, b is [% b %] [% END -%] end of blockdef Template-Toolkit-3.102/t/test/lib/barfed0000644000000000000000000000005613600243610016545 0ustar rootrootbarfed: [[% error.type %]] [[% error.info %]] Template-Toolkit-3.102/t/test/lib/content0000644000000000000000000000016313600243610016773 0ustar rootrootThis is the main content wrapper for "[% template.title or 'untitled' %]" [% PROCESS $template %] This is the end. Template-Toolkit-3.102/t/test/lib/menu0000644000000000000000000000005013600243610016260 0ustar rootrootThis is the menu defined in its own fileTemplate-Toolkit-3.102/t/test/lib/udata10000644000000000000000000000032013600243610016473 0ustar rootroot# test data for the Datafile plugin id : name : email # this is another comment way : Wendy Yardley : way@cre.canon.co.uk mop : Marty Proton : mop@cre.canon.co.uk nellb : Nell Browser : nellb@cre.canon.co.uk Template-Toolkit-3.102/t/test/lib/README0000644000000000000000000000012113600243610016250 0ustar rootrootThis directory contains various template components as used by the test scripts.Template-Toolkit-3.102/t/test/dir/0000755000000000000000000000000014635373376015434 5ustar rootrootTemplate-Toolkit-3.102/t/test/dir/sub_one/0000755000000000000000000000000014635373376017066 5ustar rootrootTemplate-Toolkit-3.102/t/test/dir/sub_one/foo0000644000000000000000000000002313600243610017541 0ustar rootrootThis is sub_one/fooTemplate-Toolkit-3.102/t/test/dir/sub_one/bar0000644000000000000000000000002313600243610017522 0ustar rootrootThis is sub_one/barTemplate-Toolkit-3.102/t/test/dir/file10000644000000000000000000000001613600243610016326 0ustar rootrootThis is file 1Template-Toolkit-3.102/t/test/dir/sub_two/0000755000000000000000000000000014635373376017116 5ustar rootrootTemplate-Toolkit-3.102/t/test/dir/sub_two/wiz.html0000644000000000000000000000003013600243610020560 0ustar rootrootThis is sub_two/wiz.htmlTemplate-Toolkit-3.102/t/test/dir/sub_two/waz.html0000644000000000000000000000003013600243610020550 0ustar rootrootThis is sub_two/waz.htmlTemplate-Toolkit-3.102/t/test/dir/file20000644000000000000000000000001613600243610016327 0ustar rootrootThis is file 2Template-Toolkit-3.102/t/test/dir/xyzfile0000644000000000000000000000002313600243610017016 0ustar rootrootThis is the xyzfileTemplate-Toolkit-3.102/t/test/plugin/0000755000000000000000000000000014635373376016154 5ustar rootrootTemplate-Toolkit-3.102/t/test/plugin/MyPlugs/0000755000000000000000000000000014635373376017554 5ustar rootrootTemplate-Toolkit-3.102/t/test/plugin/MyPlugs/Baz.pm0000644000000000000000000000033013600243610020574 0ustar rootrootpackage MyPlugs::Baz; sub new { my ($class, $value) = @_; bless { VALUE => $value, }, $class; } sub output { my $self = shift; return "This is the Baz module, value is $self->{ VALUE }"; } 1; Template-Toolkit-3.102/t/test/plugin/MyPlugs/Bar.pm0000644000000000000000000000043213600243610020567 0ustar rootrootpackage MyPlugs::Bar; use Template::Plugin; use base qw( Template::Plugin ); sub new { my ($class, $context, $value) = @_; bless { VALUE => $value, }, $class; } sub output { my $self = shift; return "This is the Bar plugin, value is $self->{ VALUE }"; } 1; Template-Toolkit-3.102/t/test/plugin/MyPlugs/Foo.pm0000644000000000000000000000043213600243610020606 0ustar rootrootpackage MyPlugs::Foo; use Template::Plugin; use base qw( Template::Plugin ); sub new { my ($class, $context, $value) = @_; bless { VALUE => $value, }, $class; } sub output { my $self = shift; return "This is the Foo plugin, value is $self->{ VALUE }"; } 1; Template-Toolkit-3.102/t/test/tmp/0000755000000000000000000000000014635373376015456 5ustar rootrootTemplate-Toolkit-3.102/t/test/tmp/README0000644000000000000000000000010013600243610016277 0ustar rootrootThis is a temporary directory used by some of the test scripts. Template-Toolkit-3.102/t/test/pod/0000755000000000000000000000000014635373376015440 5ustar rootrootTemplate-Toolkit-3.102/t/test/pod/test1.pod0000644000000000000000000000053313600243610017157 0ustar rootroot=head1 NAME My::Module =head1 SYNOPSIS use My::Module; =head1 DESCRIPTION This is the description for My::Module. This is verbatim =head2 First Subsection This is the first subsection. foo->bar(); =head2 Second Subsection This is the second subsection. bar->baz(); =head1 THE END This is the end. Beautiful friend, the end. Template-Toolkit-3.102/t/object.t0000644000000000000000000001636013600243620015313 0ustar rootroot#============================================================= -*-perl-*- # t/object.t # # Template script testing code bindings to objects. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Exception; use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #------------------------------------------------------------------------ # definition of test object class #------------------------------------------------------------------------ package T1; sub new { my $class = shift; bless { @_ }, $class; } sub die { die "barfed up\n"; } package TestObject; our $AUTOLOAD; sub new { my ($class, $params) = @_; $params ||= {}; bless { PARAMS => $params, DAYS => [ qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday ) ], DAY => 0, 'public' => 314, '.private' => 425, '_hidden' => 537, }, $class; } sub yesterday { my $self = shift; return "Love was such an easy game to play..."; } sub today { my $self = shift; return "Live for today and die for tomorrow."; } sub tomorrow { my ($self, $dayno) = @_; $dayno = $self->{ DAY }++ unless defined $dayno; $dayno %= 7; return $self->{ DAYS }->[$dayno]; } sub belief { my $self = shift; my $b = join(' and ', @_); $b = '' unless length $b; return "Oh I believe in $b."; } sub concat { my $self = shift; local $" = ', '; $self->{ PARAMS }->{ args } = "ARGS: @_"; } sub _private { my $self = shift; die "illegal call to private method _private()\n"; } sub AUTOLOAD { my ($self, @params) = @_; my $name = $AUTOLOAD; $name =~ s/.*:://; return if $name eq 'DESTROY'; my $value = $self->{ PARAMS }->{ $name }; if (ref($value) eq 'CODE') { return &$value(@params); } elsif (@params) { return $self->{ PARAMS }->{ $name } = shift @params; } else { return $value; } } #------------------------------------------------------------------------ # another object for testing auto-stringification #------------------------------------------------------------------------ package Stringy; use overload '""' => 'stringify', fallback => 1; sub new { my ($class, $text) = @_; bless \$text, $class; } sub stringify { my $self = shift; return "stringified '$$self'"; } #------------------------------------------------------------------------ # Another object for tracking down a bug with DBIx::Class where TT is # causing the numification operator to be called. Matt S Trout suggests # we've got a truth test somewhere that should be a defined but that # doesn't appear to be the case... # http://rt.cpan.org/Ticket/Display.html?id=23763 #------------------------------------------------------------------------ package Numbersome; use overload '""' => 'stringify', '0+' => 'numify', fallback => 1; sub new { my ($class, $text) = @_; bless \$text, $class; } sub numify { my $self = shift; return "FAIL: numified $$self"; } sub stringify { my $self = shift; return "PASS: stringified $$self"; } sub things { return [qw( foo bar baz )]; } package GetNumbersome; sub new { my ($class, $text) = @_; bless { }, $class; } sub num { Numbersome->new("from GetNumbersome"); } #------------------------------------------------------------------------ # main #------------------------------------------------------------------------ package main; sub new { my ($class, $text) = @_; bless \$text, $class; } my $objconf = { 'a' => 'alpha', 'b' => 'bravo', 'w' => 'whisky', }; my $replace = { thing => TestObject->new($objconf), string => Stringy->new('Test String'), t1 => T1->new(a => 10), num => Numbersome->new("Numbersome"), getnum => GetNumbersome->new, %{ callsign() }, }; test_expect(\*DATA, { INTERPOLATE => 1 }, $replace); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ # test method calling via autoload to get parameters [% thing.a %] [% thing.a %] [% thing.b %] $thing.w -- expect -- alpha alpha bravo whisky # ditto to set parameters -- test -- [% thing.c = thing.b -%] [% thing.c %] -- expect -- bravo -- test -- [% thing.concat = thing.b -%] [% thing.args %] -- expect -- ARGS: bravo -- test -- [% thing.concat(d) = thing.b -%] [% thing.args %] -- expect -- ARGS: delta, bravo -- test -- [% thing.yesterday %] [% thing.today %] [% thing.belief(thing.a thing.b thing.w) %] -- expect -- Love was such an easy game to play... Live for today and die for tomorrow. Oh I believe in alpha and bravo and whisky. -- test -- Yesterday, $thing.yesterday $thing.today ${thing.belief('yesterday')} -- expect -- Yesterday, Love was such an easy game to play... Live for today and die for tomorrow. Oh I believe in yesterday. -- test -- [% thing.belief('fish' 'chips') %] [% thing.belief %] -- expect -- Oh I believe in fish and chips. Oh I believe in . -- test -- ${thing.belief('fish' 'chips')} $thing.belief -- expect -- Oh I believe in fish and chips. Oh I believe in . -- test -- [% thing.tomorrow %] $thing.tomorrow -- expect -- Monday Tuesday -- test -- [% FOREACH [ 1 2 3 4 5 ] %]$thing.tomorrow [% END %]. -- expect -- Wednesday Thursday Friday Saturday Sunday . #------------------------------------------------------------------------ # test private methods do not get exposed #------------------------------------------------------------------------ -- test -- before[% thing._private %] mid [% thing._hidden %]after -- expect -- before mid after -- test -- [% key = '_private' -%] [[% thing.$key %]] -- expect -- [] -- test -- [% key = '.private' -%] [[% thing.$key = 'foo' %]] [[% thing.$key %]] -- expect -- [] [] #------------------------------------------------------------------------ # test auto-stringification #------------------------------------------------------------------------ -- test -- [% string.stringify %] -- expect -- stringified 'Test String' -- test -- [% string %] -- expect -- stringified 'Test String' -- test -- [% "-> $string <-" %] -- expect -- -> stringified 'Test String' <- -- test -- [% "$string" %] -- expect -- stringified 'Test String' -- test -- foo $string bar -- expect -- foo stringified 'Test String' bar -- test -- .[% t1.dead %]. -- expect -- .. -- test -- .[% TRY; t1.die; CATCH; error; END %]. -- expect -- .undef error - barfed up . #----------------------------------------------------------------------- # try and pin down the numification bug #----------------------------------------------------------------------- -- test -- [% FOREACH item IN num.things -%] * [% item %] [% END -%] -- expect -- * foo * bar * baz -- test -- [% num %] -- expect -- PASS: stringified Numbersome -- test -- [% getnum.num %] -- expect -- PASS: stringified from GetNumbersome Template-Toolkit-3.102/t/math.t0000644000000000000000000000234413600243610014772 0ustar rootroot#============================================================= -*-perl-*- # # t/math.t # # Test the Math plugin module. # # Written by Andy Wardley and ... # # Copyright (C) 2002 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test qw( :all ); $^W = 1; test_expect(\*DATA); __DATA__ -- test -- [% USE Math; Math.sqrt(9) %] -- expect -- 3 -- test -- [% USE Math; Math.abs(-1) %] -- expect -- 1 -- test -- [% USE Math; Math.atan2(42, 42).substr(0,17) %] -- expect -- 0.785398163397448 -- test -- [% USE Math; Math.cos(2).substr(0,18) %] -- expect -- -0.416146836547142 -- test -- [% USE Math; Math.exp(6).substr(0,16) %] -- expect -- 403.428793492735 -- test -- [% USE Math; Math.hex(42) %] -- expect -- 66 -- test -- [% USE Math; Math.int(9.9) %] -- expect -- 9 -- test -- [% USE Math; Math.log(42).substr(0,15) %] -- expect -- 3.7376696182833 -- test -- [% USE Math; Math.oct(72) %] -- expect -- 58 -- test -- [% USE Math; Math.sin(0.304).substr(0,17) %] -- expect -- 0.299339178269093 Template-Toolkit-3.102/t/outline_line.t0000644000000000000000000000171314635371175016547 0ustar rootroot#============================================================= -*-perl-*- # # t/outline_line.t # # Test the OUTLINE_TAG option reporting incorrect line numbers. # https://github.com/abw/Template2/issues/295 # # Written by Andy Wardley # # Copyright (C) 2022 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use Template::Parser; $/=undef; my $text = ; my $parser = Template::Parser->new({ OUTLINE_TAG => '%%' }); my $parsed = $parser->parse($text, { name => 'test' }); my $template = $parsed->{ BLOCK }; my @lines; while ($template =~ /#line (\d) "test"/g) { push(@lines, $1); } is( join(', ', @lines), "1, 2, 3, 4", "lines 1, 2, 3, 4" ); __DATA__ %% line1 %% line2 [% line3 %] [% line4 %] Template-Toolkit-3.102/t/zz-plugin-leak-rt-46691.t0000644000000000000000000000571213600243610020026 0ustar rootroot#!/usr/bin/perl #============================================================= -*-perl-*- # # t/zz-plugin-leak-rt-46691.t # # Testcase from RT #46691 aka GH #144 # view https://github.com/abw/Template2/issues/144 # # Written by Nicolas R. # # Copyright (C) 2018 cPanel Inc. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use lib qw( t/lib ./lib ../lib ../blib/arch ./test ); use Template; use Test::More; use File::Temp qw(tempfile tempdir); plan( skip_all => "Developer test only - set RELEASE_TESTING=1" ) unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ); plan tests => 2; # ------- t1.txt - checkleak template my $t1 = <<'EOT'; [% USE checkleak %] test 1: [% name | checkleak %] [% INCLUDE t2.txt %] test 3: [% name3 | checkleak %] EOT # ------- t2.txt - an included template my $t2 = <<'EOT'; [% USE checkleak %] test 2: [% name2 | checkleak %] EOT # ------- checkleak.pm a super checkleak custom filter my $plugin_checkleak = <<'EOT'; package Template::Plugin::checkleak; use Template::Plugin::Filter; use base qw( Template::Plugin::Filter ); no warnings; sub filter { my ($self, $text, $args, $conf) = @_; return qq|**|.$text.qq|**|; } sub init { my $self = shift; $self->{'_DYNAMIC'}=1; my $name = $self->{ _CONFIG }->{ name } || 'checkleak'; $self->install_filter($name); return $self; } 1; EOT my $template_tmpdir = tempdir( CLEANUP => 1 ); write_text( qq[$template_tmpdir/t1.txt], $t1 ); write_text( qq[$template_tmpdir/t2.txt], $t2 ); my $plugindir = tempdir( CLEANUP => 1 ); my $plugin_pm = qq[$plugindir/Template/Plugin/checkleak.pm]; # pretty ugly but only run by authors... mkdir("$plugindir/Template") && mkdir("$plugindir/Template/Plugin"); die q[Failed to create plugindir] unless -d "$plugindir/Template/Plugin"; write_text( $plugin_pm, $plugin_checkleak ); unshift @INC, $plugindir; ok eval { do $plugin_pm; 1 }, "can load Template::Plugin::checkleak" or die "Failed to load Template::Plugin::checkleak - $@"; # chdir to our temporary folder with templates chdir($template_tmpdir) or die; my $tt = Template->new( { 'PLUGIN_BASE' => $plugindir } ); my $out; $tt->process( 't1.txt', { 'name' => 'jason', 'name2' => 'fred', 'name3' => 'jim', }, \$out ) || print STDERR $tt->error(); # make sure we can process the template without any issues # the original bug was doing a weaken on the plugin itself.. # resulting in not being able to load it a second time is $out, <<'EXPECT', "Template processed correctly using Plugin checkleak twice"; test 1: **jason** test 2: **fred** test 3: **jim** EXPECT done_testing; exit; sub write_text { # could also use File::Slurper::write_file .... my ( $file, $content ) = @_; open( my $fh, '>', $file ) or die $!; print {$fh} $content; close($fh); } Template-Toolkit-3.102/t/context.t0000644000000000000000000001357213600243610015532 0ustar rootroot#!/usr/bin/perl -w # -*- perl -*- #============================================================= -*-perl-*- # # t/context.t # # Test the Template::Context.pm module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Constants qw( :debug ); my $DEBUG = grep(/^--?d(debug)?$/, @ARGV); #$Template::Test::DEBUG = 1; ntests(54); # script may be being run in distribution root or 't' directory my $dir = -d 't' ? 't/test' : 'test'; my $tt = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", TRIM => 1, POST_CHOMP => 1, DEBUG => $DEBUG ? DEBUG_CONTEXT : 0, }); my $ttperl = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", TRIM => 1, EVAL_PERL => 1, POST_CHOMP => 1, DEBUG => $DEBUG ? DEBUG_CONTEXT : 0, }); #------------------------------------------------------------------------ # misc #------------------------------------------------------------------------ # test we created a context object and check internal values my $context = $tt->service->context(); ok( $context ); ok( $context eq $tt->context() ); ok( $context->trim() ); ok( ! $context->eval_perl() ); ok( $context = $ttperl->service->context() ); ok( $context->trim() ); ok( $context->eval_perl() ); #------------------------------------------------------------------------ # template() #------------------------------------------------------------------------ banner('testing template()'); # test we can fetch a template via template() my $template = $context->template('header'); ok( $template ); ok( UNIVERSAL::isa($template, 'Template::Document') ); # test that non-existance of a template is reported eval { $template = $context->template('no_such_template') }; ok( $@ ); ok( "$@" eq 'file error - no_such_template: not found' ); # check that template() returns CODE and Template::Document refs intact my $code = sub { return "this is a hard-coded template" }; $template = $context->template($code); ok( $template eq $code ); my $doc = "this is a document"; $doc = bless \$doc, 'Template::Document'; $template = $context->template($doc); ok( $template eq $doc ); ok( $$doc = 'this is a document' ); # check the use of visit() and leave() to add temporary BLOCK lookup # tables to the context's search space my $blocks1 = { some_block_1 => 'hello', }; my $blocks2 = { some_block_2 => 'world', }; eval { $context->template('some_block_1') }; ok( $@ ); $context->visit('no doc', $blocks1); ok( $context->template('some_block_1') eq 'hello' ); eval { $context->template('some_block_2') }; ok( $@ ); $context->visit('no doc', $blocks2); ok( $context->template('some_block_1') eq 'hello' ); ok( $context->template('some_block_2') eq 'world' ); $context->leave(); ok( $context->template('some_block_1') eq 'hello' ); eval { $context->template('some_block_2') }; ok( $@ ); $context->leave(); eval { $context->template('some_block_1') }; ok( $@ ); eval { $context->template('some_block_2') }; ok( $@ ); # test that reset() clears all blocks $context->visit('no doc', $blocks1); ok( $context->template('some_block_1') eq 'hello' ); eval { $context->template('some_block_2') }; ok( $@ ); $context->visit('no doc', $blocks2); ok( $context->template('some_block_1') eq 'hello' ); ok( $context->template('some_block_2') eq 'world' ); $context->reset(); eval { $context->template('some_block_1') }; ok( $@ ); eval { $context->template('some_block_2') }; ok( $@ ); #------------------------------------------------------------------------ # plugin() #------------------------------------------------------------------------ banner('testing plugin()'); my $plugin = $context->plugin('Table', [ [1,2,3,4], { rows => 2 } ]); ok( $plugin ); ok( ref $plugin eq 'Template::Plugin::Table' ); my $row = $plugin->row(0); ok( $row && ref $row eq 'ARRAY' ); ok( $row->[0] == 1 ); ok( $row->[1] == 3 ); eval { $plugin = $context->plugin('no_such_plugin'); }; ok( "$@" eq 'plugin error - no_such_plugin: plugin not found' ); #------------------------------------------------------------------------ # filter() #------------------------------------------------------------------------ banner('testing filter()'); my $filter = $context->filter('html'); ok( $filter ); ok( ref $filter eq 'CODE' ); ok( &$filter('') eq '<input/>' ); $filter = $context->filter('replace', [ 'foo', 'bar' ], 'repsave'); ok( $filter ); ok( ref $filter eq 'CODE' ); ok( &$filter('this is foo, so it is') eq 'this is bar, so it is' ); # check filter got cached $filter = $context->filter('repsave'); ok( $filter ); ok( ref $filter eq 'CODE' ); match( &$filter('this is foo, so it is'), 'this is bar, so it is' ); #------------------------------------------------------------------------ # include() and process() #------------------------------------------------------------------------ banner('testing include()'); $context = $tt->context(); ok( $context ); my $stash = $context->stash(); ok( $stash ); $stash->set('a', 'alpha'); ok( $stash->get('a') eq 'alpha' ); my $text = $context->include('baz'); ok( $text eq 'This is the baz file, a: alpha' ); $text = $context->include('baz', { a => 'bravo' }); ok( $text eq 'This is the baz file, a: bravo' ); # check stash hasn't been altered ok( $stash->get('a') eq 'alpha' ); $text = $context->process('baz'); ok( $text eq 'This is the baz file, a: alpha' ); # check stash *has* been altered ok( $stash->get('a') eq 'charlie' ); $text = $context->process('baz', { a => 'bravo' }); ok( $text eq 'This is the baz file, a: bravo' ); ok( $stash->get('a') eq 'charlie' ); Template-Toolkit-3.102/t/README0000644000000000000000000000614214635371175014555 0ustar rootrootScript Testing ----------------------------------------------------------------------------- args.t Passing positional and named arguments to code/object methods autoform.t Autoformat plugin (Template::Plugin::Autoformat) base.t Template::Base.pm module binop.t Binary operators block.t BLOCK definition capture.t Capture directive output and assign to a variable case.t CASE option to switch case sensitivity compile1.t Compile templates to Perl code and save to file compile2.t Reload above compiled templates without re-parsing compile3.t Ensure that touching source template causes re-compilation compile4.t Compiling templates to a COMPILE_DIR compile5.t Reload templates from a COMPILE_DIR config.t Template::Config factory module context.t Template::Context module datafile.t Datafile plugin (Template::Plugin::Datafile) date.t Date plugin (Template::Plugin::Date) dbi.t DBI plugin (Template::Plugin::DBI) directive.t Directive layout, chomping, comments, etc. document.t Template::Document module dom.t XML::DOM plugin (Template::Plugin::XML::DOM) dumper.t Data::Dumper plugin (Template::Plugin::Data::Dumper) error.t Test that errors are reported back to caller as exceptions evalperl.t Evaluation of PERL and RAWPERL blocks exception.t Template::Exception module filter.t FILTER directive and various filters foreach.t FOREACH directive format.t Format plugin (Template::Plugin::Format) include.t INCLUDE and PROCESS directive iterator.t Template::Iterator and Iterator plugin modules list.t List definition and access via various methods macro.t MACRO directive object.t Binding objects to template variables output.t OUTPUT_PATH and OUTPUT options parser.t Template::Parser module plugins.t Template::Plugins provider module (incomplete) process.t PRE_PROCESS, PROCESS and POST_PROCESS options provider.t Template::Provider module ref.t Test the \ reference operator (currently undocumented) rss.t XML::RSS plugin (Template::Plugin::XML::RSS) service.t Template::Service module skel.t Skeleton test file. Copy and edit to create your own tests. stash.t Template::Stash module stop.t STOP directive and throwing 'stop' exception switch.t SWITCH / CASE directives table.t Table plugin (Template::Plugin::Table) tags.t TAGS directive template.t Template front-end module text.t Plain text blocks, ensuring all characters are reproducable try.t TRY / THROW / CATCH / FINAL directives url.t URL plugin (Template::Plugin::URL) vars.t Variable usage and GET / SET / CALL / DEFAULT directives varsv1.t As above, using version 1 handling of leading '$' vmeth.t Virtual scalar/hash/list methods while.t WHILE directive wrap.t Wrap plugin (Template::Plugin::Wrap) wrapper.t WRAPPER directive xpath.t XML::XPath plugin (Template::Plugin::XML::XPath) Template-Toolkit-3.102/t/wrap.t0000644000000000000000000000520714635371175015034 0ustar rootroot#============================================================= -*-perl-*- # # t/wrap.t # # Template script testing wrap plugin. # # Written by Andy Wardley # # Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ../lib ); use Template; use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; eval "use Text::Wrap"; if ($@) { skip_all('Text::Wrap not installed'); } test_expect(\*DATA); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- [% USE Wrap -%] [% text = BLOCK -%] This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! [%- END -%] [% text = BLOCK; text FILTER replace('\s+', ' '); END -%] [% Wrap(text, 25,) %] -- expect -- This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! -- test -- [% FILTER wrap -%] This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! [% END %] -- expect -- This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! -- test -- [% USE wrap -%] [% FILTER wrap(25) -%] This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! [% END %] -- expect -- This is a long block of text that goes on for a long long time and then carries on some more after that, it's very interesting, NOT! -- test -- [% FILTER wrap(10, '> ', '+ ') -%] The cat sat on the mat and then sat on the flat. [%- END %] -- expect -- > The cat + sat on + the mat + and + then + sat on + the + flat. -- test -- [% USE wrap -%] [% FILTER bullet = wrap(40, '* ', ' ') -%] First, attach the transmutex multiplier to the cross-wired quantum homogeniser. [%- END %] [% FILTER remove('\s+(?=\n)') -%] [% FILTER bullet -%] Then remodulate the shield to match the harmonic frequency, taking care to correct the phase difference. [% END %] [% END %] -- expect -- * First, attach the transmutex multiplier to the cross-wired quantum homogeniser. * Then remodulate the shield to match the harmonic frequency, taking care to correct the phase difference. Template-Toolkit-3.102/t/html.t0000644000000000000000000000502114635371175015021 0ustar rootroot#============================================================= -*-perl-*- # # t/html.t # # Tests the 'HTML' plugin. # # Written by Andy Wardley # # Copyright (C) 2001-2022 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use utf8; use strict; use warnings; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Plugin::HTML; my $DEBUG = grep(/-d/, @ARGV); $Template::Test::DEBUG = $DEBUG; $Template::Test::PRESERVE = $DEBUG; #------------------------------------------------------------------------ # behaviour of html filter depends on these being available #------------------------------------------------------------------------ use constant HAS_HTML_Entities => eval { require HTML::Entities; 1; }; use constant HAS_Apache_Util => eval { require Apache::Util; Apache::Util::escape_html(''); 1; }; #print "Has HTML::Entities: ", HAS_HTML_Entities ? 'yes' : 'no', "\n"; #print "Has Apache::Util: ", HAS_Apache_Util ? 'yes' : 'no', "\n"; my $h = Template::Plugin::HTML->new('foo'); ok( $h, 'created HTML plugin' ); my $cfg = { }; my $vars = { entities => HAS_HTML_Entities || HAS_Apache_Util || 0, }; test_expect(\*DATA, $cfg, $vars); __DATA__ -- test -- -- name html plugin -- [% USE HTML -%] OK -- expect -- OK -- test -- -- name html filter -- [% FILTER html -%] < & > [%- END %] -- expect -- < &amp; > -- test -- -- name html entity -- [% TRY; text = "Léon Brocard" | html_entity; IF text == "Léon Brocard"; 'passed'; ELSIF text == "Léon Brocard"; 'passed'; ELSE; "failed: $text"; END; CATCH; error; END; %] -- expect -- -- process -- [% IF entities -%] passed [%- ELSE -%] html_entity error - cannot locate Apache::Util or HTML::Entities [%- END %] -- test -- [% USE html; html.url('my file.html') -%] -- expect -- my%20file.html -- test -- -- name escape -- [% USE HTML -%] [% HTML.escape("if (a < b && c > d) ...") %] -- expect -- if (a < b && c > d) ... -- test -- -- name sorted -- [% USE HTML(sorted=1) -%] [% HTML.element(table => { border => 1, cellpadding => 2 }) %] -- expect -- -- test -- -- name attributes -- [% USE HTML -%] [% HTML.attributes(border => 1, cellpadding => 2).split.sort.join %] -- expect -- border="1" cellpadding="2" Template-Toolkit-3.102/t/zz-pod-kwalitee.t0000644000000000000000000000141013600243610017060 0ustar rootroot#============================================================= -*-perl-*- # # t/pod_kwalitee.t # # Use Test::Pod (if available) to test the POD documentation. # # Written by Andy Wardley # # Copyright (C) 2008-2013 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Test::More; plan( skip_all => "Author tests not required for installation" ) unless $ENV{ RELEASE_TESTING } or $ENV{ AUTHOR_TESTING }; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Template-Toolkit-3.102/t/url.t0000644000000000000000000001010014635371175014651 0ustar rootroot#============================================================= -*-perl-*- # # t/url.t # # Template script testing URL plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use utf8; use strict; use lib qw( ../lib ); use Template; use Template::Test; use Template::Plugin::URL; $^W = 1; $Template::Test::DEBUG = 0; my $urls = { product => { map { $_->{ name }, Template::Plugin::URL->new(undef, # no context $_->{ url }, $_->{ args }); } ( { name => 'view', url => '/product', }, { name => 'add', url => '/product', args => { action => 'add' }, }, { name => 'edit', url => '/product', args => { action => 'edit', style => 'editor' }, }, ), }, }; my $vars = { url => $urls, sorted => \&sort_params, no_escape => sub { $Template::Plugin::URL::JOINT = '&' }, }; test_expect(\*DATA, { INTERPOLATE => 1 }, $vars); # url params are constructed in a non-deterministic order. we obviously # can't test against this so we use this devious hack to reorder a # query so that its parameters are in alphabetical order. # ------------------------------------------------------------------------ # later note: in adding support for parameters with multiple values, the # sort_params() hacked below got broken so as a temporary solution, I # changed teh URL plugin to sort all params by key when generating the # URL sub sort_params { my $query = shift; my ($base, $args) = split(/\?/, $query); my (@args, @keys, %argtab); print STDERR "sort_parms(\"$query\")\n" if $Template::Test::DEBUG; @args = split('&', $args); @keys = map { (split('=', $_))[0] } @args; @argtab{ @keys } = @args; @keys = sort keys %argtab; @args = map { $argtab{ $_ } } @keys; $args = join('&', @args); $query = join('?', length $base ? ($base, $args) : $args); print STDERR "returning [$query]\n" if $Template::Test::DEBUG; return $query; } #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- [% USE url -%] loaded [% url %] [% url('foo') %] [% url(foo='bar') %] [% url('bar', wiz='woz') %] -- expect -- loaded foo foo=bar bar?wiz=woz -- test -- [% USE url('here') -%] [% url %] [% url('there') %] [% url(any='where') %] [% url('every', which='way') %] [% sorted( url('every', which='way', you='can') ) %] -- expect -- here there here?any=where every?which=way every?which=way&you=can -- test -- [% USE url('there', name='fred') -%] [% url %] [% url(name='tom') %] [% sorted( url(age=24) ) %] [% sorted( url(age=42, name='frank') ) %] -- expect -- there?name=fred there?name=tom there?age=24&name=fred there?age=42&name=frank -- test -- [% USE url('/cgi-bin/woz.pl') -%] [% url(name="Elrich von Benjy d'Weiro") %] -- expect -- /cgi-bin/woz.pl?name=Elrich%20von%20Benjy%20d%27Weiro -- test -- [% USE url '/script' { one => 1, two => [ 2, 4 ], three => [ 3, 6, 9] } -%] [% url %] -- expect -- /script?one=1&three=3&three=6&three=9&two=2&two=4 -- test -- [% url.product.view %] [% url.product.view(style='compact') %] -- expect -- /product /product?style=compact -- test -- [% url.product.add %] [% url.product.add(style='compact') %] -- expect -- /product?action=add /product?action=add&style=compact -- test -- [% url.product.edit %] [% url.product.edit(style='compact') %] -- expect -- /product?action=edit&style=editor /product?action=edit&style=compact -- test -- [% CALL no_escape -%] [% url.product.edit %] [% url.product.edit(style='compact') %] -- expect -- /product?action=edit&style=editor /product?action=edit&style=compact -- test -- [% USE url('/cgi-bin/woz.pl') -%] [% url(utf8="Naïve Unicode") %] -- expect -- /cgi-bin/woz.pl?utf8=Na%C3%AFve%20Unicode Template-Toolkit-3.102/t/zz-stash-xs-leak.t0000644000000000000000000000313113600243610017161 0ustar rootroot#============================================================= -*-perl-*- # # t/stash-xs-leak.t # # Template script to investigate a leak in the XS Stash # # Written by Andy Wardley # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ./blib/lib ./blib/arch ); use Template::Constants qw( :status ); use Template; use Template::Config; use Test::More; # belt and braces unless (grep(/--dev/, @ARGV)) { plan( skip_all => 'Internal test for developer, add the --dev flag to run' ); } unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Developer tests not required for installation" ); } # only run the test when compiled with Template::Stash if ( $Template::Config::STASH ne 'Template::Stash::XS' ) { skip_all('Template::Config is not using Template::Stash::XS'); } require Template::Stash::XS; my $stash = Template::Stash::XS->new( { x => 10, y => { } } ); my ($a, $b) = (5, 10_000); print <get( ['x', 0, 'y', 0] ); $stash->get( ['x', 0, 'length', 0] ); $stash->get( ['y', 0, 'length', 0] ); } print "pausing...\n"; sleep 1; } Template-Toolkit-3.102/t/image.t0000644000000000000000000000434213600243610015123 0ustar rootroot#============================================================= -*-perl-*- # # t/image.t # # Tests the Image plugin. # # Written by Andy Wardley # # Copyright (C) 2002 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Cwd; use File::Spec; $^W = 1; eval "use Image::Info"; if ($@) { eval "use Image::Size"; skip_all('Neither Image::Info nor Image::Size installed') if $@; } my $dir = -d 't' ? 'images' : File::Spec->catfile(File::Spec->updir(), 'images'); my $vars = { dir => $dir, file => { logo => File::Spec->catfile($dir, 'ttdotorg.gif'), power => File::Spec->catfile($dir, 'tt2power.gif'), lname => 'ttdotorg.gif', }, }; test_expect(\*DATA, undef, $vars); __DATA__ -- test -- [% USE Image(file.logo) -%] file: [% Image.file %] size: [% Image.size.join(', ') %] width: [% Image.width %] height: [% Image.height %] -- expect -- -- process -- file: [% file.logo %] size: 110, 60 width: 110 height: 60 -- test -- [% USE image( name = file.power) -%] name: [% image.name %] file: [% image.file %] width: [% image.width %] height: [% image.height %] size: [% image.size.join(', ') %] -- expect -- -- process -- name: [% file.power %] file: [% file.power %] width: 78 height: 47 size: 78, 47 -- test -- [% USE image file.logo -%] attr: [% image.attr %] -- expect -- attr: width="110" height="60" -- test -- [% USE image file.logo -%] tag: [% image.tag %] tag: [% image.tag(class="myimage", alt="image") %] -- expect -- -- process -- tag: tag: image # test "root" -- test -- [% USE image( root=dir name=file.lname ) -%] [% image.tag %] -- expect -- -- process -- # test separate file and name -- test -- [% USE image( file= file.logo name = "other.jpg" alt="myfile") -%] [% image.tag %] -- expect -- myfile Template-Toolkit-3.102/t/ref.t0000644000000000000000000000321213600243610014610 0ustar rootroot#============================================================= -*-perl-*- # # t/ref.t # # Template script testing variable references. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Constants qw( :status ); use Template; use Template::Test; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Context::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY= 1; local $" = ', '; my $replace = { a => sub { return "a sub [@_]" }, j => { k => 3, l => 5, m => { n => sub { "nsub [@_]" } } }, z => sub { my $sub = shift; return "z called " . &$sub(10, 20, 30) }, }; test_expect(\*DATA, undef, $replace); __DATA__ -- test -- a: [% a %] a(5): [% a(5) %] a(5,10): [% a(5,10) %] -- expect -- a: a sub [] a(5): a sub [5] a(5,10): a sub [5, 10] -- test -- [% b = \a -%] b: [% b %] b(5): [% b(5) %] b(5,10): [% b(5,10) %] -- expect -- b: a sub [] b(5): a sub [5] b(5,10): a sub [5, 10] -- test -- [% c = \a(10,20) -%] c: [% c %] c(30): [% c(30) %] c(30,40): [% c(30,40) %] -- expect -- c: a sub [10, 20] c(30): a sub [10, 20, 30] c(30,40): a sub [10, 20, 30, 40] -- test -- [% z(\a) %] -- expect -- z called a sub [10, 20, 30] -- test -- [% f = \j.k -%] f: [% f %] -- expect -- f: 3 -- test -- [% f = \j.m.n -%] f: [% f %] f(11): [% f(11) %] -- expect -- f: nsub [] f(11): nsub [11] Template-Toolkit-3.102/t/binop.t0000644000000000000000000001151213600243610015145 0ustar rootroot#============================================================= -*-perl-*- # # t/binop.t # # Template script testing the conditional binary operators: and/&&, or/||, # not/!, <, >, <=, >= , == and !=. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Test; use Template::Parser; $^W = 1; $Template::Test::DEBUG = 0; $Template::Parser::DEBUG = 0; my $counter = 0; my $params = { 'yes' => 1, 'no' => 0, 'true' => 'this is true', 'false' => '0', 'happy' => 'yes', 'sad' => '', 'ten' => 10, 'twenty' => 20, 'alpha' => sub { return ++$counter }, 'omega' => sub { $counter += 10; return 0 }, 'count' => sub { return $counter }, 'reset' => sub { return $counter == 0 }, }; my $template = Template->new({ INTERPOLATE => 1, POST_CHOMP => 1 }); test_expect(\*DATA, $template, $params); __DATA__ maybe [% IF yes %] yes [% END %] -- expect -- maybe yes -- test -- [% IF yes %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes and true %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes && true %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes && sad || happy %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes AND ten && true and twenty && 30 %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF ! yes %] no [% ELSE %] yes [% END %] -- expect -- yes -- test -- [% UNLESS yes %] no [% ELSE %] yes [% END %] -- expect -- yes -- test -- [% "yes" UNLESS no %] -- expect -- yes -- test -- [% IF ! yes %] no [% ELSE %] yes [% END %] -- expect -- yes -- test -- [% IF yes || no %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes || no || true || false %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF yes or no %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF not false and not sad %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF ten == 10 %] yes [% ELSE %] no [% END %] -- expect -- yes -- test -- [% IF ten == twenty %] I canna break the laws of mathematics, Captain. [% ELSIF ten > twenty %] Your numerical system is inverted. Please reboot your Universe. [% ELSIF twenty < ten %] Your inverted system is numerical. Please universe your reboot. [% ELSE %] Normality is restored. Anything you can't cope with is your own problem. [% END %] -- expect -- Normality is restored. Anything you can't cope with is your own problem. -- test -- [% IF ten >= twenty or false %] no [% ELSIF twenty <= ten %] nope [% END %] nothing -- expect -- nothing -- test -- [% IF ten >= twenty or false %] no [% ELSIF twenty <= ten %] nope [% END %] nothing -- expect -- nothing -- test -- [% IF ten > twenty %] no [% ELSIF ten < twenty %] yep [% END %] -- expect -- yep -- test -- [% IF ten != 10 %] no [% ELSIF ten == 10 %] yep [% END %] -- expect -- yep #------------------------------------------------------------------------ # test short-circuit operations #------------------------------------------------------------------------ -- test -- [% IF alpha AND omega %] alpha and omega are true [% ELSE %] alpha and/or omega are not true [% END %] count: [% count %] -- expect -- alpha and/or omega are not true count: 11 -- test -- [% IF omega AND alpha %] omega and alpha are true [% ELSE %] omega and/or alpha are not true [% END %] count: [% count %] -- expect -- omega and/or alpha are not true count: 21 -- test -- [% IF alpha OR omega %] alpha and/or omega are true [% ELSE %] neither alpha nor omega are true [% END %] count: [% count %] -- expect -- alpha and/or omega are true count: 22 -- test -- [% IF omega OR alpha %] alpha and/or omega are true [% ELSE %] neither alpha nor omega are true [% END %] count: [% count %] -- expect -- alpha and/or omega are true count: 33 -- test -- [% small = 5 mid = 7 big = 10 both = small + big less = big - mid half = big / small left = big % mid mult = big * small %] both: [% both +%] less: [% less +%] half: [% half +%] left: [% left +%] mult: [% mult +%] maxi: [% mult + 2 * 2 +%] mega: [% mult * 2 + 2 * 3 %] -- expect -- both: 15 less: 3 half: 2 left: 3 mult: 50 maxi: 54 mega: 106 -- test -- [% 10 mod 4 +%] [% 10 MOD 4 +%] [% 10 div 3 %] [% 10 DIV 3 %] -- expect -- 2 2 3 3 -- stop -- # this is for testing the lt operator which isn't enabled by default. -- test -- [% IF 'one' lt 'two' -%] one is less than two [% ELSE -%] ERROR! [% END -%] -- expect -- one is less than two Template-Toolkit-3.102/t/strict.t0000644000000000000000000000302013600243610015341 0ustar rootroot#============================================================= -*-perl-*- # # t/strict.t # # Test strict mode. # # Written by Andy Wardley # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ../lib ); use Template; use Template::Test; my $template = Template->new( STRICT => 1 ); test_expect( \*DATA, { STRICT => 1 }, { foo => 10, bar => undef, baz => { boz => undef } } ); __DATA__ -- test -- -- name defined variable -- [% foo %] -- expect -- 10 -- test -- -- name variable with undefined value -- [% TRY; bar; CATCH; error; END %] -- expect -- var.undef error - undefined variable: bar -- test -- -- name dotted variable with undefined value -- [% TRY; baz.boz; CATCH; error; END %] -- expect -- var.undef error - undefined variable: baz.boz -- test -- -- name undefined first part of dotted.variable -- [% TRY; wiz.bang; CATCH; error; END %] -- expect -- var.undef error - undefined variable: wiz.bang -- test -- -- name undefined second part of dotted.variable -- [% TRY; baz.booze; CATCH; error; END %] -- expect -- var.undef error - undefined variable: baz.booze -- test -- -- name dotted.variable with args -- [% TRY; baz(10).booze(20, 'blah', "Foo $foo"); CATCH; error; END %] -- expect -- var.undef error - undefined variable: baz(10).booze(20, 'blah', 'Foo 10') Template-Toolkit-3.102/t/vmethods/0000755000000000000000000000000014635373376015530 5ustar rootrootTemplate-Toolkit-3.102/t/vmethods/text.t0000644000000000000000000002024313600243610016654 0ustar rootroot#============================================================= -*-perl-*- # # t/vmethods/text.t # # Testing scalar (text) virtual variable methods. # # Written by Andy Wardley # # Copyright (C) 1996-2015 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../../lib ); use Template::Test; # make sure we're using the Perl stash $Template::Config::STASH = 'Template::Stash'; # define a new text method $Template::Stash::SCALAR_OPS->{ commify } = sub { local $_ = shift; my $c = shift || ","; my $n = int(shift || 3); return $_ if $n<1; 1 while s/^([-+]?\d+)(\d{$n})/$1$c$2/; return $_; }; my $tt = Template->new(); my $tc = $tt->context(); # define vmethods using define_vmethod() interface. $tc->define_vmethod( item => commas => $Template::Stash::SCALAR_OPS->{ commify } ); my $params = { undef => undef, zero => 0, one => 1, animal => 'cat', string => 'The cat sat on the mat', spaced => ' The dog sat on the log', word => 'bird', # The bird is the word WORD => 'BIRD', the_bird => "\n The bird\n is the word \n ", quotable => "Tim O'Reilly said \"Oh really?\"", markup => 'a < b > & c "d" \'e\'', }; test_expect(\*DATA, undef, $params); __DATA__ -- test -- -- name text.defined implicit undef -- [% notdef.defined ? 'def' : 'undef' %] -- expect -- undef -- test -- -- name text.defined explicit undef -- [% undef.defined ? 'def' : 'undef' %] -- expect -- undef -- test -- -- name text.defined zero -- [% zero.defined ? 'def' : 'undef' %] -- expect -- def -- test -- -- name text.defined one -- [% one.defined ? 'def' : 'undef' %] -- expect -- def -- test -- -- name string.length -- [% string.length %] -- expect -- 22 -- test -- -- name text.upper -- [% string.upper %] -- expect -- THE CAT SAT ON THE MAT -- test -- -- name text.lower -- [% string.lower %] -- expect -- the cat sat on the mat -- test -- -- name text.ucfirst -- [% word.ucfirst %] [% WORD.ucfirst %] [% WORD.lower.ucfirst %] -- expect -- Bird BIRD Bird -- test -- -- name text.lcfirst -- [% word.lcfirst %] [% WORD.lcfirst %] -- expect -- bird bIRD -- test -- -- name text.trim -- >[% the_bird.trim %]< -- expect -- >The bird is the word< -- test -- -- name text.collapse -- >[% the_bird.collapse %]< -- expect -- >The bird is the word< -- test -- -- name text.sort.join -- [% string.sort.join %] -- expect -- The cat sat on the mat -- test -- -- name text.split.join a -- [% string.split.join('_') %] -- expect -- The_cat_sat_on_the_mat -- test -- -- name text.split.join b -- [% string.split(' ', 3).join('_') %] -- expect -- The_cat_sat on the mat -- test -- -- name text.split.join c -- [% spaced.split.join('_') %] -- expect -- The_dog_sat_on_the_log -- test -- -- name text.split.join d -- [% spaced.split(' ').join('_') %] -- expect -- __The_dog_sat_on_the_log -- test -- -- name text.list -- [% string.list.join %] -- expect -- The cat sat on the mat -- test -- -- name text.hash -- [% string.hash.value %] -- expect -- The cat sat on the mat -- test -- -- name text.size -- [% string.size %] -- expect -- 1 -- test -- -- name text.empty on empty -- [% text = ''; text.empty %] -- expect -- 1 -- test -- -- name text.empty on non-empty -- [% text = 'bandanna'; text.empty %] -- expect -- 0 -- test -- -- name text.squote -- [% quotable %] [% quotable.squote %] -- expect -- Tim O'Reilly said "Oh really?" Tim O\'Reilly said "Oh really?" -- test -- -- name text.dquote -- [% quotable %] [% quotable.dquote %] -- expect -- Tim O'Reilly said "Oh really?" Tim O'Reilly said \"Oh really?\" -- test -- -- name text.html -- [% markup.html %] -- expect -- a < b > & c "d" 'e' -- test -- -- name text.xml -- [% markup.xml %] -- expect -- a < b > & c "d" 'e' -- test -- -- name text.repeat -- [% animal.repeat(3) %] -- expect -- catcatcat -- test -- -- name text.search -- [% animal.search('at$') ? "found 'at\$'" : "didn't find 'at\$'" %] -- expect -- found 'at$' -- test -- -- name text.search -- [% animal.search('^at') ? "found '^at'" : "didn't find '^at'" %] -- expect -- didn't find '^at' -- test -- -- name text.match an -- [% text = 'bandanna'; text.match('an') ? 'match' : 'no match' %] -- expect -- match -- test -- -- name text.match on -- [% text = 'bandanna'; text.match('on') ? 'match' : 'no match' %] -- expect -- no match -- test -- -- name text.match global an -- [% text = 'bandanna'; text.match('an', 1).size %] matches -- expect -- 2 matches -- test -- -- name text.match global an -- [% text = 'bandanna' -%] matches are [% text.match('an+', 1).join(', ') %] -- expect -- matches are an, ann -- test -- -- name text.match global on -- [% text = 'bandanna'; text.match('on+', 1) ? 'match' : 'no match' %] -- expect -- no match -- test -- -- name: text substr method -- [% text = 'Hello World' -%] a: [% text.substr(6) %]! b: [% text.substr(0, 5) %]! c: [% text.substr(0, 5, 'Goodbye') %]! d: [% text %]! -- expect -- a: World! b: Hello! c: Goodbye World! d: Hello World! -- test -- -- name: another text substr method -- [% text = 'foo bar baz wiz waz woz' -%] a: [% text.substr(4, 3) %] b: [% text.substr(12) %] c: [% text.substr(0, 11, 'FOO') %] d: [% text %] -- expect -- a: bar b: wiz waz woz c: FOO wiz waz woz d: foo bar baz wiz waz woz -- test -- -- name: text.remove -- [% text = 'hello world!'; text.remove('\s+world') %] -- expect -- hello! -- test -- -- name chunk left -- [% string = 'TheCatSatTheMat' -%] [% string.chunk(3).join(', ') %] -- expect -- The, Cat, Sat, The, Mat -- test -- -- name chunk leftover -- [% string = 'TheCatSatonTheMat' -%] [% string.chunk(3).join(', ') %] -- expect -- The, Cat, Sat, onT, heM, at -- test -- -- name chunk right -- [% string = 'TheCatSatTheMat' -%] [% string.chunk(-3).join(', ') %] -- expect -- The, Cat, Sat, The, Mat -- test -- -- name chunk rightover -- [% string = 'TheCatSatonTheMat' -%] [% string.chunk(-3).join(', ') %] -- expect -- Th, eCa, tSa, ton, The, Mat -- test -- -- name chunk ccard -- [% ccard_no = "1234567824683579"; ccard_no.chunk(4).join %] -- expect -- 1234 5678 2468 3579 -- test -- [% string = 'foo' -%] [% string.repeat(3) %] -- expect -- foofoofoo -- test -- [% string1 = 'foobarfoobarfoo' string2 = 'foobazfoobazfoo' -%] [% string1.search('bar') ? 'ok' : 'not ok' %] [% string2.search('bar') ? 'not ok' : 'ok' %] [% string1.replace('bar', 'baz') %] [% string2.replace('baz', 'qux') %] -- expect -- ok ok foobazfoobazfoo fooquxfooquxfoo -- test -- [% string1 = 'foobarfoobarfoo' string2 = 'foobazfoobazfoo' -%] [% string1.match('bar') ? 'ok' : 'not ok' %] [% string2.match('bar') ? 'not ok' : 'ok' %] -- expect -- ok ok -- test -- [% string = 'foo bar ^%$ baz' -%] [% string.replace('\W+', '_') %] -- expect -- foo_bar_baz -- test -- [% var = 'value99' ; var.replace('value', '') %] -- expect -- 99 -- test -- [% bob = "0" -%] bob: [% bob.replace('0','') %]. -- expect -- bob: . -- test -- [% string = 'The cat sat on the mat'; match = string.match('The (\w+) (\w+) on the (\w+)'); -%] [% match.0 %].[% match.1 %]([% match.2 %]) -- expect -- cat.sat(mat) -- test -- [% string = 'The cat sat on the mat' -%] [% IF (match = string.match('The (\w+) sat on the (\w+)')) -%] matched animal: [% match.0 %] place: [% match.1 %] [% ELSE -%] no match [% END -%] [% IF (match = string.match('The (\w+) shat on the (\w+)')) -%] matched animal: [% match.0 %] place: [% match.1 %] [% ELSE -%] no match [% END -%] -- expect -- matched animal: cat place: mat no match -- test -- [% big_num = "1234567890"; big_num.commify %] -- expect -- 1,234,567,890 -- test -- [% big_num = "1234567890"; big_num.commify(":", 2) %] -- expect -- 12:34:56:78:90 -- test -- [% big_num = "1234567812345678"; big_num.commify(" ", 4) %] -- expect -- 1234 5678 1234 5678 -- test -- [% big_num = "hello world"; big_num.commify %] -- expect -- hello world -- test -- [% big_num = "1234567890"; big_num.commas %] -- expect -- 1,234,567,890 Template-Toolkit-3.102/t/vmethods/replace.t0000644000000000000000000001055013600243610017303 0ustar rootroot#============================================================= -*-perl-*- # # t/vmethods/replace.t # # Testing the 'replace' scalar virtual method, and in particular the # use of backreferences. # # Written by Andy Wardley and Sergey Martynoff # # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ../../lib ); use Template::Test; use Template::Config; use Template::Stash; $^W = 1; # make sure we're using the Perl stash $Template::Config::STASH = 'Template::Stash'; test_expect(\*DATA); __DATA__ -- test -- -- name: two backrefs -- [% text = 'The cat sat on the mat'; text.replace( '(\w+) sat on the (\w+)', 'dirty $1 shat on the filthy $2' ) %] -- expect -- The dirty cat shat on the filthy mat # test more than 9 captures to make sure $10, $11, etc., work ok -- test -- -- name: ten+ backrefs -- [% text = 'one two three four five six seven eight nine ten eleven twelve thirteen'; text.replace( '(\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+) (\w+)', '[$12-$11-$10-$9-$8-$7-$6-$5-$4-$3-$2-$1]' ) %] -- expect -- [twelve-eleven-ten-nine-eight-seven-six-five-four-three-two-one] thirteen -- test -- -- name: repeat backrefs -- [% text = 'one two three four five six seven eight nine ten eleven twelve thirteen'; text.replace( '(\w+) ', '[$1]-' ) %] -- expect -- [one]-[two]-[three]-[four]-[five]-[six]-[seven]-[eight]-[nine]-[ten]-[eleven]-[twelve]-thirteen -- test -- -- name: one backref -- [% var = 'foo'; var.replace('f(o+)$', 'b$1') %] -- expect -- boo -- test -- -- name: three backrefs -- [% var = 'foo|bar/baz'; var.replace('(fo+)\|(bar)(.*)$', '[ $1, $2, $3 ]') %] -- expect -- [ foo, bar, /baz ] #------------------------------------------------------------------------ # tests based on Sergey's test script: http://martynoff.info/tt2/ #------------------------------------------------------------------------ -- test -- [% text = 'foo bar'; text.replace('foo', 'bar') %] -- expect -- bar bar -- test -- [% text = 'foo bar'; text.replace('(f)(o+)', '$2$1') %] -- expect -- oof bar -- test -- [% text = 'foo bar foo'; text.replace('(?i)FOO', 'zoo') %] -- expect -- zoo bar zoo #------------------------------------------------------------------------ # references to $n vars that don't exists are ignored #------------------------------------------------------------------------ -- test -- [% text = 'foo bar'; text.replace('(f)(o+)', '$20$1') %] -- expect -- f bar -- test -- [% text = 'foo bar'; text.replace('(f)(o+)', '$2$10') %] -- expect -- oo bar -- test -- [% text = 'foo fgoo foooo bar'; text.replace('((?:f([^o]*)(o+)\s)+)', '1=$1;2=$2;3=$3;') %] -- expect -- 1=foo fgoo foooo ;2=;3=oooo;bar #------------------------------------------------------------------------ # $n in source string should not be interpolated #------------------------------------------------------------------------ -- test -- [% text = 'foo $1 bar'; text.replace('(foo)(.*)(bar)', '$1$2$3') %] -- expect -- foo $1 bar -- test -- [% text = 'foo $1 bar'; text.replace('(foo)(.*)(bar)', '$3$2$1') %] -- expect -- bar $1 foo -- test -- [% text = 'foo $200bar foobar'; text.replace('(f)(o+)', 'zoo') %] -- expect -- zoo $200bar zoobar #------------------------------------------------------------------------ # escaped \$ in replacement string #------------------------------------------------------------------------ -- test -- -- name: escape dollar -- [% text = 'foo bar'; text.replace('(f)(o+)', '\\$2$1') %] -- expect -- $2f bar -- test -- -- name: escape backslash -- [% text = 'foo bar'; text.replace('(f)(o+)', 'x$1\\\\y$2'); # this is 'x$1\\y$2' %] -- expect -- xf\yoo bar -- test -- -- name: backslash again -- [% text = 'foo bar'; text.replace('(f)(o+)', '$2\\\\$1'); # this is '$2\\$1' %] -- expect -- oo\f bar -- test -- -- name: escape all over -- [% text = 'foo bar'; text.replace('(f)(o+)', '$2\\\\\\$1'); # this is '$2\\\$') %] -- expect -- oo\$1 bar -- test -- [% text = 'foo bar foobar'; text.replace('(o)|([ar])', '$2!') %] -- expect -- f!! ba!r! f!!ba!r! -- test -- -- name: no warnings -- [% text = 'foo'; text.replace('(optional)?(foo)', '$1$2'); %] -- expect -- foo Template-Toolkit-3.102/t/vmethods/list.t0000644000000000000000000002355413600243610016653 0ustar rootroot#============================================================= -*-perl-*- # # t/vmethods/list.t # # Testing list virtual variable methods. # # Written by Andy Wardley # # Copyright (C) 1996-2015 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../../lib ../../../lib ); use Template::Test; # make sure we're using the Perl stash $Template::Config::STASH = 'Template::Stash'; # add some new list ops $Template::Stash::LIST_OPS->{ sum } = \∑ $Template::Stash::LIST_OPS->{ odd } = \&odd; $Template::Stash::LIST_OPS->{ jumble } = \&jumble; # make sure we're using the Perl stash $Template::Config::STASH = 'Template::Stash'; #------------------------------------------------------------------------ # define a simple object to test sort vmethod calling object method #------------------------------------------------------------------------ package My::Object; sub new { my ($class, $name, $extra) = @_; bless { _NAME => $name, _EXTRA => $extra, }, $class; } sub name { my $self = shift; return $self->{ _NAME }; } sub extra { my $self = shift; return $self->{ _EXTRA }; } #------------------------------------------------------------------------ package main; sub sum { my $list = shift; my $n = 0; foreach (@$list) { $n += $_; } return $n; } sub odd { my $list = shift; return [ grep { $_ % 2 } @$list ]; } sub jumble { my ($list, $chop) = @_; $chop = 1 unless defined $chop; return $list unless @$list > 3; push(@$list, splice(@$list, 0, $chop)); return $list; } my $params = { metavars => [ qw( foo bar baz qux wiz waz woz ) ], people => [ { id => 'tom', name => 'Tom' }, { id => 'dick', name => 'Richard' }, { id => 'larry', name => 'Larry' }, ], primes => [ 13, 11, 17, 19, 2, 3, 5, 7 ], phones => { 3141 => 'Leon', 5131 => 'Andy', 4131 => 'Simon' }, groceries => { 'Flour' => 3, 'Milk' => 1, 'Peanut Butter' => 21 }, names => [ map { My::Object->new($_) } qw( Tom Dick Larry ) ], more_names => [ My::Object->new('Smith', 'William'), My::Object->new('Smith', 'Andrew'), My::Object->new('Jones', 'Peter'), My::Object->new('Jones', 'Mark'), ], numbers => [ map { My::Object->new($_) } qw( 1 02 10 12 021 ) ], duplicates => [ 1, 1, 2, 2, 3, 3, 4, 4, 5, 5], }; my $tt = Template->new(); my $tc = $tt->context(); # define vmethods using define_vmethod() interface. $tc->define_vmethod(list => oddnos => \&odd); $tc->define_vmethod(array => jumblate => \&jumble); test_expect(\*DATA, undef, $params); __DATA__ #------------------------------------------------------------------------ # list virtual methods #------------------------------------------------------------------------ -- test -- [% metavars.first %] -- expect -- foo -- test -- [% metavars.last %] -- expect -- woz -- test -- [% metavars.size %] -- expect -- 7 -- test -- -- name list.empty on empty -- [% empty = [ ]; empty.empty %] -- expect -- 1 -- test -- -- name list.empty on non-empty -- [% nonempty = [ 'e', 'f' ]; nonempty.empty %] -- expect -- 0 -- test -- [% empty = [ ]; empty.size %] -- expect -- 0 -- test -- [% metavars.max %] -- expect -- 6 -- test -- [% metavars.join %] -- expect -- foo bar baz qux wiz waz woz -- test -- [% metavars.join(', ') %] -- expect -- foo, bar, baz, qux, wiz, waz, woz -- test -- [% metavars.sort.join(', ') %] -- expect -- bar, baz, foo, qux, waz, wiz, woz -- test -- [% metavars.defined ? 'list def ok' : 'list def not ok' %] [% metavars.defined(2) ? 'list two ok' : 'list two not ok' %] [% metavars.defined(7) ? 'list seven not ok' : 'list seven ok' %] -- expect -- list def ok list two ok list seven ok -- test -- [% list = [1]; list.defined('asdf') ? 'asdf is defined' : 'asdf is not defined' %] -- expect -- asdf is not defined -- test -- [% FOREACH person = people.sort('id') -%] [% person.name +%] [% END %] -- expect -- Richard Larry Tom -- test -- [% FOREACH obj = names.sort('name') -%] [% obj.name +%] [% END %] -- expect -- Dick Larry Tom -- test -- [% FOREACH obj IN more_names.sort('name', 'extra') -%] [% obj.extra %] [% obj.name %] [% END %] -- expect -- Mark Jones Peter Jones Andrew Smith William Smith -- test -- [% FOREACH obj = numbers.sort('name') -%] [% obj.name +%] [% END %] -- expect -- 02 021 1 10 12 -- test -- [% FOREACH obj = numbers.nsort('name') -%] [% obj.name +%] [% END %] -- expect -- 1 02 10 12 021 -- test -- [% FOREACH person = people.sort('name') -%] [% person.name +%] [% END %] -- expect -- Larry Richard Tom -- test -- [% folk = [] -%] [% folk.push("$person.name") FOREACH person = people.sort('id') -%] [% folk.join(",\n") %] -- expect -- Richard, Larry, Tom -- test -- [% primes.sort.join(', ') %] -- expect -- 11, 13, 17, 19, 2, 3, 5, 7 -- test -- [% primes.nsort.join(', ') %] -- expect -- 2, 3, 5, 7, 11, 13, 17, 19 -- test -- [% duplicates.unique.join(', ') %] --expect -- 1, 2, 3, 4, 5 -- test -- [% duplicates.unique.join(', ') %] -- expect -- 1, 2, 3, 4, 5 -- test -- -- name list import one -- [% list_one = [ 1 2 3 ]; list_two = [ 4 5 6 ]; list_one.import(list_two).join(', ') %] -- expect -- 1, 2, 3, 4, 5, 6 -- test -- -- name list import two -- [% list_one = [ 1 2 3 ]; list_two = [ 4 5 6 ]; list_three = [ 7 8 9 0 ]; list_one.import(list_two, list_three).join(', ') %] -- expect -- 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 -- test -- -- name list import two -- [% list_one = [ 1 2 3 ]; list_two = [ 4 5 6 ]; list_three = [ 7 8 9 0 ]; list_one.import(list_two).import(list_three).join(', ') %] -- expect -- 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 -- test -- -- name list merge one -- [% list_one = [ 1 2 3 ]; list_two = [ 4 5 6 ]; "'$l' " FOREACH l = list_one.merge(list_two) %] -- expect -- '1' '2' '3' '4' '5' '6' -- test -- -- name list merge two -- [% list_one = [ 1 2 3 ]; list_two = [ 4 5 6 ]; list_three = [ 7 8 9 0 ]; "'$l' " FOREACH l = list_one.merge(list_two, list_three) %] -- expect -- '1' '2' '3' '4' '5' '6' '7' '8' '9' '0' -- test -- [% list_one = [ 1 2 3 4 5 ] -%] a: [% list_one.splice.join(', ') %] b: [% list_one.size ? list_one.join(', ') : 'empty list' %] -- expect -- a: 1, 2, 3, 4, 5 b: empty list -- test -- [% list_one = [ 'a' 'b' 'c' 'd' 'e' ] -%] a: [% list_one.splice(3).join(', ') %] b: [% list_one.join(', ') %] -- expect -- a: d, e b: a, b, c -- test -- [% list_one = [ 'a' 'b' 'c' 'd' 'e' ] -%] c: [% list_one.splice(3, 1).join(', ') %] d: [% list_one.join(', ') %] -- expect -- c: d d: a, b, c, e -- test -- [% list_one = [ 'a' 'b' 'c' 'd' 'e' ] -%] c: [% list_one.splice(3, 1, 'foo').join(', ') %] d: [% list_one.join(', ') %] e: [% list_one.splice(0, 1, 'ping', 'pong').join(', ') %] f: [% list_one.join(', ') %] g: [% list_one.splice(-1, 1, ['wibble', 'wobble']).join(', ') %] h: [% list_one.join(', ') %] -- expect -- c: d d: a, b, c, foo, e e: a f: ping, pong, b, c, foo, e g: e h: ping, pong, b, c, foo, wibble, wobble -- test -- -- name scrabble -- [% play_game = [ 'play', 'scrabble' ]; ping_pong = [ 'ping', 'pong' ] -%] a: [% play_game.splice(1, 1, ping_pong).join %] b: [% play_game.join %] -- expect -- a: scrabble b: play ping pong -- test -- -- name first -- [% primes = [ 2, 3, 5, 7, 11, 13 ] -%] [% primes.first +%] [% primes.first(3).join(', ') %] -- expect -- 2 2, 3, 5 -- test -- -- name first -- [% primes = [ 2, 3, 5, 7, 11, 13 ] -%] [% primes.last +%] [% primes.last(3).join(', ') %] -- expect -- 13 7, 11, 13 -- test -- -- name slice -- [% primes = [ 2, 3, 5, 7, 11, 13 ] -%] [% primes.slice(0, 2).join(', ') +%] [% primes.slice(-2, -1).join(', ') +%] [% primes.slice(3).join(', ') +%] [% primes.slice.join(', ') +%] --expect -- 2, 3, 5 11, 13 7, 11, 13 2, 3, 5, 7, 11, 13 -- test -- -- name list.hash -- [% items = ['zero', 'one', 'two', 'three']; hash = items.hash(0); "$key = $value\n" FOREACH hash.pairs; -%] -- expect -- 0 = zero 1 = one 2 = two 3 = three -- test -- -- name list.hash(10) -- [% items = ['zero', 'one', 'two', 'three']; hash = items.hash(10); "$key = $value\n" FOREACH hash.pairs; -%] -- expect -- 10 = zero 11 = one 12 = two 13 = three -- test -- -- name list.hash -- [% items = ['zero', 'one', 'two', 'three']; hash = items.hash; "$key = $value\n" FOREACH hash.pairs; -%] -- expect -- two = three zero = one #------------------------------------------------------------------------ # USER DEFINED LIST OPS #------------------------------------------------------------------------ -- test -- [% items = [0..6] -%] [% items.jumble.join(', ') %] [% items.jumble(3).join(', ') %] -- expect -- 1, 2, 3, 4, 5, 6, 0 4, 5, 6, 0, 1, 2, 3 -- test -- -- name jumblate method -- [% items = [0..6] -%] [% items.jumblate.join(', ') %] [% items.jumblate(3).join(', ') %] -- expect -- 1, 2, 3, 4, 5, 6, 0 4, 5, 6, 0, 1, 2, 3 -- test -- [% primes.sum %] -- expect -- 77 -- test -- [% primes.odd.nsort.join(', ') %] -- expect -- 3, 5, 7, 11, 13, 17, 19 -- test -- -- name oddnos -- [% primes.oddnos.nsort.join(', ') %] -- expect -- 3, 5, 7, 11, 13, 17, 19 -- test -- [% FOREACH n = phones.sort -%] [% phones.$n %] is [% n %], [% END %] -- expect -- Andy is 5131, Leon is 3141, Simon is 4131, -- test -- -- name groceries -- [% FOREACH n = groceries.nsort.reverse -%] I want [% groceries.$n %] kilos of [% n %], [% END %] -- expect -- I want 21 kilos of Peanut Butter, I want 3 kilos of Flour, I want 1 kilos of Milk, -- test -- [% hash = { } list = [ hash ] list.last.message = 'Hello World'; "message: $list.last.message\n" -%] -- expect -- message: Hello World Template-Toolkit-3.102/t/vmethods/hash.t0000644000000000000000000000614413600243610016617 0ustar rootroot#============================================================= -*-perl-*- # # t/vmethods/hash.t # # Testing hash virtual variable methods. # # Written by Andy Wardley # # Copyright (C) 1996-2015 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../../lib ); use Template::Test; # make sure we're using the Perl stash $Template::Config::STASH = 'Template::Stash'; my $params = { hash => { a => 'b', c => 'd' }, uhash => { tobe => '2b', nottobe => undef }, }; my $tt = Template->new() || die Template->error(); my $tc = $tt->context(); $tc->define_vmethod(hash => dump => sub { my $hash = shift; return '{ ' . join(', ', map { "$_ => '$hash->{$_}'" } sort keys %$hash) . ' }'; }); test_expect(\*DATA, undef, $params); __DATA__ #------------------------------------------------------------------------ # hash virtual methods #------------------------------------------------------------------------ -- test -- -- name hash keys -- [% hash.keys.sort.join(', ') %] -- expect -- a, c -- test -- -- name hash values -- [% hash.values.sort.join(', ') %] -- expect -- b, d -- test -- -- name hash each -- [% hash.each.sort.join(', ') %] -- expect -- a, b, c, d -- test -- -- name hash items -- [% hash.items.sort.join(', ') %] -- expect -- a, b, c, d -- test -- -- name hash size -- [% hash.size %] -- expect -- 2 -- test -- -- name hash.empty on empty -- [% empty = { }; empty.empty %] -- expect -- 1 -- test -- -- name hash.empty on non-empty -- [% nonempty = { e => 'f' }; nonempty.empty %] -- expect -- 0 -- test -- [% hash.defined('a') ? 'good' : 'bad' %] [% hash.a.defined ? 'good' : 'bad' %] [% hash.defined('x') ? 'bad' : 'good' %] [% hash.x.defined ? 'bad' : 'good' %] [% hash.defined ? 'good def' : 'bad def' %] [% no_such_hash.defined ? 'bad no def' : 'good no def' %] -- expect -- good good good good good def good no def -- test -- [% uhash.defined('tobe') ? 'good' : 'bad' %] [% uhash.tobe.defined ? 'good' : 'bad' %] [% uhash.exists('tobe') ? 'good' : 'bad' %] [% uhash.defined('nottobe') ? 'bad' : 'good' %] [% hash.nottobe.defined ? 'bad' : 'good' %] [% uhash.exists('nottobe') ? 'good' : 'bad' %] -- expect -- good good good good good good -- test -- -- name hash.pairs -- [% FOREACH pair IN hash.pairs -%] * [% pair.key %] => [% pair.value %] [% END %] -- expect -- * a => b * c => d -- test -- -- name hash.list (old style) -- [% FOREACH pair IN hash.list -%] * [% pair.key %] => [% pair.value %] [% END %] -- expect -- * a => b * c => d #------------------------------------------------------------------------ # user defined hash virtual methods #------------------------------------------------------------------------ -- test -- -- name dump hash -- [% product = { id = 'abc-123', name = 'ABC Widget #123' price = 7.99 }; product.dump %] -- expect -- { id => 'abc-123', name => 'ABC Widget #123', price => '7.99' } Template-Toolkit-3.102/t/args.t0000644000000000000000000000464213600243610015000 0ustar rootroot#============================================================= -*-perl-*- # # t/args.t # # Testing the passing of positional and named arguments to sub-routine and # object methods. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Constants qw( :status ); $^W = 1; #------------------------------------------------------------------------ # define simple object and package sub for reporting arguments passed #------------------------------------------------------------------------ package MyObj; use base qw( Template::Base ); sub foo { my $self = shift; return "object:\n" . args(@_); } sub args { my @args = @_; my $named = ref $args[$#args] eq 'HASH' ? pop @args : { }; local $" = ', '; return " ARGS: [ @args ]\n NAMED: { " . join(', ', map { "$_ => $named->{ $_ }" } sort keys %$named) . " }\n"; } #------------------------------------------------------------------------ # main tests #------------------------------------------------------------------------ package main; use Template::Parser; $Template::Test::DEBUG = 0; $Template::Parser::DEBUG = 0; my $replace = callsign(); $replace->{ args } = \&MyObj::args; $replace->{ obj } = MyObj->new(); test_expect(\*DATA, { INTERPOLATE => 1 }, $replace); __DATA__ -- test -- [% args(a b c) %] -- expect -- ARGS: [ alpha, bravo, charlie ] NAMED: { } -- test -- [% args(a b c d=e f=g) %] -- expect -- ARGS: [ alpha, bravo, charlie ] NAMED: { d => echo, f => golf } -- test -- [% args(a, b, c, d=e, f=g) %] -- expect -- ARGS: [ alpha, bravo, charlie ] NAMED: { d => echo, f => golf } -- test -- [% args(a, b, c, d=e, f=g,) %] -- expect -- ARGS: [ alpha, bravo, charlie ] NAMED: { d => echo, f => golf } -- test -- [% args(d=e, a, b, f=g, c) %] -- expect -- ARGS: [ alpha, bravo, charlie ] NAMED: { d => echo, f => golf } -- test -- [% obj.foo(d=e, a, b, f=g, c) %] -- expect -- object: ARGS: [ alpha, bravo, charlie ] NAMED: { d => echo, f => golf } -- test -- [% obj.foo(d=e, a, b, f=g, c).split("\n").1 %] -- expect -- ARGS: [ alpha, bravo, charlie ] Template-Toolkit-3.102/t/unicode.t0000644000000000000000000001106413600243610015466 0ustar rootroot#============================================================= -*-perl-*- # # t/unicode.t # # Test the handling of Unicode text in templates. # # Written by Mark Fowler # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Provider; #use Template::Test; #ntests(20); BEGIN { unless ($] > 5.007) { print "1..0 # Skip perl < 5.8 can't do unicode well enough\n"; exit; } } use Template; use File::Temp qw(tempfile tempdir); use File::Spec::Functions; use Cwd; use Test::More tests => 20; # This is 'moose...' (with slashes in the 'o's them, and the '...' as one char). my $moose = "m\x{f8}\x{f8}se\x{2026}"; # right, create some templates in various encodings by hand # (it's the only way to be 100% sure they contain the right text) my %encoded_text = ( 'UTF-8' => "\x{ef}\x{bb}\x{bf}m\x{c3}\x{b8}\x{c3}\x{b8}se\x{e2}\x{80}\x{a6}", 'UTF-16BE' => "\x{fe}\x{ff}\x{0}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e &", 'UTF-16LE' => "\x{ff}\x{fe}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e\x{0}& ", 'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}\x{0}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0} &", 'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0}\x{0}& \x{0}\x{0}", ); # write those variables to temp files in a temp directory my %filenames = ( map { $_ => write_to_temp_file( filename => $_, text => $encoded_text{ $_ }, # uncomment to create files in cwd # dir => cwd, ) } keys %encoded_text ); my $tempdir = create_cache_dir(); # setup template toolkit and test all the encodings my $tt = setup_tt( tempdir => $tempdir ); test_it("first try", $tt, \%filenames, $moose); test_it("in memory", $tt, \%filenames, $moose); # okay, now we test everything again to see if the cache file # was written in a consisant state $tt = setup_tt( tempdir => $tempdir ); test_it("from cache", $tt, \%filenames, $moose); test_it("in cache, in memory", $tt, \%filenames, $moose); ######################################################################### sub create_cache_dir { return tempdir( CLEANUP => 1 ); } sub setup_tt { my %args = @_; return Template->new( ABSOLUTE => 1, COMPILE_DIR => $args{tempdir}, COMPILE_EXT => ".ttcache"); } sub test_it { local $Test::Builder::Level = $Test::Builder::Level + 1; my $name = shift; my $tt = shift; my $filenames = shift; my $string = shift; foreach my $encoding (keys %{ $filenames }) { my $output; $tt->process($filenames->{ $encoding },{},\$output) or $output = $tt->error; is(reasciify($output), reasciify($string), "$name - $encoding"); } } #------------------------------------------------------------------------ # reascify($string) # # escape all the high and low chars to \x{..} sequences #------------------------------------------------------------------------ sub reasciify { my $string = shift; $string = join '', map { my $ord = ord($_); ($ord > 127 || ($ord < 32 && $ord != 10)) ? sprintf '\x{%x}', $ord : $_ } split //, $string; return $string; } #------------------------------------------------------------------------ # write_to_temp_file( dir => $dir, filename => $file, text => $text) # # escape all the high and low chars to \x{..} sequences #------------------------------------------------------------------------ sub write_to_temp_file { my %args = @_; # use a temp dir unless one was specified. We automatically # delete the contents when we're done with the tempdir, where # otherwise we just leave the files lying around. unless (exists $args{dir}) { $args{dir} = tempdir( CLEANUP => 1 ); } # work out where we're going to store it my $temp_filename = catfile($args{dir}, $args{filename}); # open a filehandle with some PerlIO magic to convert data into # the correct encoding with the correct BOM on the front open my $temp_fh, ">:raw", $temp_filename or die "Can't write to '$temp_filename': $!"; # write the data out print $temp_fh $args{text}; close $temp_fh; # return where we've created it return $temp_filename; } Template-Toolkit-3.102/t/zz-plugin-cycle.t0000644000000000000000000000315114232015000017062 0ustar rootroot#============================================================= -*-perl-*- # # t/zz-plugin-cycle.t # # Check for memory leak when using Template::Plugin::Simple # # Written by Nicolas R. # # Copyright (C) 2018 cPanel Inc. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use lib qw( t/lib ./lib ../lib ../blib/arch ); use Template; use Template::Plugin::Simple; use Test::More; plan skip_all => "Developer test" unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ); eval { require Test::LeakTrace }; if ( $@ or !$INC{'Test/LeakTrace.pm'} ) { plan skip_all => 'Test::LeakTrace not installed'; } plan tests => 2; note "plugin_simple_test();"; ok plugin_simple_test(), "plugin_simple_test"; note "Searching for leak using Test::LeakTrace..."; my $no_leaks = Test::LeakTrace::no_leaks_ok( \&plugin_simple_test, 'no leak from Template::Plugin' ); if ( !$no_leaks ) { diag "Memory leak detected..."; if ( eval { require Devel::Cycle; 1 } ) { Devel::Cycle::find_cycle( plugin_simple_test() ); } else { diag "consider installing Devel::Cycle to detect leak"; } } exit; sub plugin_simple_test { my $tpl = Template->new({ PLUGIN_BASE => [ 'test' ], DEBUG => 1, }) or die; $tpl->context->plugin( 'Simple', [] ); return $tpl; } package test::Simple; sub new { my ($pkg) = @_; return bless {}, $pkg; } sub load { my $class = shift; return $class; } 1;Template-Toolkit-3.102/t/outline.t0000644000000000000000000000444514232015000015514 0ustar rootroot#============================================================= -*-perl-*- # # t/outline.t # # Test the OUTLINE_TAG option. # # Written by Andy Wardley # # Copyright (C) 1996-2020 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. # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; ok(1); my $tt_vanilla = Template->new; my $tt_outline = Template->new({ TAG_STYLE => 'outline', }); my $tt_outtag = Template->new({ OUTLINE_TAG => '%%', }); my $tt_shell = Template->new({ OUTLINE_TAG => quotemeta '$ ', }); my $engines = [ default => $tt_vanilla, outline => $tt_outline, outtag => $tt_outtag, shell => $tt_shell, ]; test_expect(\*DATA, $engines, callsign); __DATA__ -- test -- -- name TAGS outline -- # Outline tags are not enabled by default %% [% r %] and [% j %] # Turn them on like so [% TAGS outline -%] %% IF a # outline tags can contain comments a is set to [% a %] %% ELSE a is not set %% END # Turn them off again [% TAGS default -%] %% [% f %] and [% t %] -- expect -- %% romeo and juliet a is set to alpha %% foxtrot and tango -- test -- -- name TAGS -- %% [% r %] and [% j %] # You can also use TAGS to specify your own [% TAGS {{ }} >> -%] >> IF b b is set to {{b}} >> ELSE b is not set >> END -- expect -- %% romeo and juliet b is set to bravo -- test -- -- name TAG_STYLE outline -- -- use outline -- # This engine should already have TAG_STYLE set to 'outline' %% IF c c is set to [% c %] %% ELSE c is not set %% END # Turn them off again [% TAGS default -%] %% [% f %] and [% t %] -- expect -- c is set to charlie %% foxtrot and tango -- test -- -- name OUTLINE_TAG -- -- use outtag -- # This engine should already have OUTLINE_TAG set to '%%' %% IF d d is set to [% d %] %% ELSE d is not set %% END -- expect -- d is set to delta -- test -- -- name OUTLINE_TAG shell -- -- use shell -- # This engine should already have OUTLINE_TAG set to '$ ' $ IF e e is set to [% e %] $ ELSE e is not set $ END -- expect -- e is set to echo Template-Toolkit-3.102/t/stash-xs-unicode.t0000644000000000000000000000403214232015000017223 0ustar rootroot#============================================================= -*-perl-*- # # t/stash-xs-unicode.t # # Template script to test unicode data with the XS Stash # # Written by Andy Wardley based on code provided # by МакÑим Вуец. # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ./blib/lib ./blib/arch ); use utf8; use Template; use Template::Test; use Template::Config; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; BEGIN { unless ($] > 5.007) { skip_all("perl < 5.8 can't do unicode well enough\n"); } } # only run the test when compiled with Template::Stash if ( $Template::Config::STASH ne 'Template::Stash::XS' ) { skip_all('Template::Config is not using Template::Stash::XS'); } require Template::Stash::XS; binmode STDOUT, ':utf8'; my $data = { ascii => 'key', utf8 => 'ключ', hash => { key => 'value', ключ => 'значение' }, str => 'щука' }; test_expect(\*DATA, undef, $data); __DATA__ -- test -- -- name ASCII key -- ascii = [% ascii %] hash.$ascii = [% hash.$ascii %] -- expect -- ascii = key hash.$ascii = value -- test -- -- name UTF8 length -- str.length = [% str.length %] -- expect -- str.length = 4 -- test -- -- name UTF8 key fetch -- utf8 = [% utf8 %] hash.$utf8 = hash.[% utf8 %] = [% hash.$utf8 %] -- expect -- utf8 = ключ hash.$utf8 = hash.ключ = значение -- test -- -- name UTF8 key assign -- [% value = hash.$utf8; hash.$value = utf8 -%] value = [% value %] hash.$value = hash.[% value %] = [% hash.$value %] -- expect -- value = значение hash.$value = hash.значение = ключ Template-Toolkit-3.102/t/view.t0000644000000000000000000004267513600243610015026 0ustar rootroot#============================================================= -*-perl-*- # # t/view.t # # Tests the 'View' plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; use Template::View; #$Template::View::DEBUG = 1; #$Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; $Template::Test::PRESERVE = 1; #------------------------------------------------------------------------ package Foo; sub new { my $class = shift; bless { @_ }, $class; } sub present { my $self = shift; return '{ ' . join(', ', map { "$_ => $self->{ $_ }" } sort keys %$self) . ' }'; } sub reverse { my $self = shift; return '{ ' . join(', ', map { "$_ => $self->{ $_ }" } reverse sort keys %$self) . ' }'; } #------------------------------------------------------------------------ package Blessed::List; sub as_list { my $self = shift; return @$self; } #------------------------------------------------------------------------ package main; my $vars = { foo => Foo->new( pi => 3.14, e => 2.718 ), blessed_list => bless([ "Hello", "World" ], 'Blessed::List'), }; my $template = Template->new() || die Template->error; my $context = $template->context(); my $view = $context->view( ); ok( $view ); $view = $context->view( prefix => 'my' ); ok( $view ); match( $view->prefix(), 'my' ); my $config = { VIEWS => [ bottom => { prefix => 'bottom/' }, middle => { prefix => 'middle/', base => 'bottom' }, ], }; test_expect(\*DATA, $config, $vars); __DATA__ -- test -- -- name pre-defined bottom view -- [% BLOCK bottom/list; "BOTTOM LIST: "; item.join(', '); END; list = [10, 20 30]; bottom.print(list) %] -- expect -- BOTTOM LIST: 10, 20, 30 -- test -- -- name pre-defined middle view -- [% BLOCK bottom/list; "BOTTOM LIST: "; item.join(', '); END; BLOCK middle/hash; "MIDDLE HASH: "; item.values.nsort.join(', '); END; list = [10, 20 30]; hash = { pi => 3.142, e => 2.718 }; middle.print(list); "\n"; middle.print(hash); "\n"; %] -- expect -- BOTTOM LIST: 10, 20, 30 MIDDLE HASH: 2.718, 3.142 -- test -- [% USE v = View -%] [[% v.prefix %]] -- expect -- [] -- test -- [% USE v = View( map => { default="any" } ) -%] [[% v.map.default %]] -- expect -- [any] -- test -- [% USE view( prefix=> 'foo/', suffix => '.tt2') -%] [[% view.prefix %]bar[% view.suffix %]] [[% view.template_name('baz') %]] -- expect -- [foo/bar.tt2] [foo/baz.tt2] -- test -- [% USE view( prefix=> 'foo/', suffix => '.tt2') -%] [[% view.prefix %]bar[% view.suffix %]] [[% view.template_name('baz') %]] -- expect -- [foo/bar.tt2] [foo/baz.tt2] -- test -- [% USE view -%] [% view.print('Hello World') %] [% BLOCK text %]TEXT: [% item %][% END -%] -- expect -- TEXT: Hello World -- test -- [% USE view -%] [% view.print( { foo => 'bar' } ) %] [% BLOCK hash %]HASH: { [% FOREACH key = item.keys.sort -%] [% key %] => [% item.$key %] [%- END %] } [% END -%] -- expect -- HASH: { foo => bar } -- test -- [% USE view -%] [% view = view.clone( prefix => 'my_' ) -%] [% view.view('hash', { bar => 'baz' }) %] [% BLOCK my_hash %]HASH: { [% FOREACH key = item.keys.sort -%] [% key %] => [% item.$key %] [%- END %] } [% END -%] -- expect -- HASH: { bar => baz } -- test -- [% USE view(prefix='my_') -%] [% view.print( foo => 'wiz', bar => 'waz' ) %] [% BLOCK my_hash %]KEYS: [% item.keys.sort.join(', ') %][% END %] -- expect -- KEYS: bar, foo -- test -- [% USE view -%] [% view.print( view ) %] [% BLOCK Template_View %]Printing a Template::View object[% END -%] -- expect -- Printing a Template::View object -- test -- [% USE view(prefix='my_') -%] [% view.print( view ) %] [% view.print( view, prefix='your_' ) %] [% BLOCK my_Template_View %]Printing my Template::View object[% END -%] [% BLOCK your_Template_View %]Printing your Template::View object[% END -%] -- expect -- Printing my Template::View object Printing your Template::View object -- test -- [% USE view(prefix='my_', notfound='any' ) -%] [% view.print( view ) %] [% view.print( view, prefix='your_' ) %] [% BLOCK my_any %]Printing any of my objects[% END -%] [% BLOCK your_any %]Printing any of your objects[% END -%] -- expect -- Printing any of my objects Printing any of your objects -- test -- [% USE view(prefix => 'my_', map => { default => 'catchall' } ) -%] [% view.print( view ) %] [% view.print( view, default="catchsome" ) %] [% BLOCK my_catchall %]Catching all defaults[% END -%] [% BLOCK my_catchsome %]Catching some defaults[% END -%] -- expect -- Catching all defaults Catching some defaults -- test -- [% USE view(prefix => 'my_', map => { default => 'catchnone' } ) -%] [% view.default %] [% view.default = 'catchall' -%] [% view.default %] [% view.print( view ) %] [% view.print( view, default="catchsome" ) %] [% BLOCK my_catchall %]Catching all defaults[% END -%] [% BLOCK my_catchsome %]Catching some defaults[% END -%] -- expect -- catchnone catchall Catching all defaults Catching some defaults -- test -- [% USE view(prefix='my_', default='catchall' notfound='lost') -%] [% view.print( view ) %] [% BLOCK my_lost %]Something has been found[% END -%] -- expect -- Something has been found -- test -- [% USE view -%] [% TRY ; view.print( view ) ; CATCH view ; "[$error.type] $error.info" ; END %] -- expect -- [view] file error - Template_View: not found -- test -- [% USE view -%] [% view.print( foo ) %] -- expect -- { e => 2.718, pi => 3.14 } -- test -- [% USE view -%] [% view.print( foo, method => 'reverse' ) %] -- expect -- { pi => 3.14, e => 2.718 } -- test -- [% USE view(prefix='my_', include_naked=0, view_naked=1) -%] [% BLOCK my_foo; "Foo: $item"; END -%] [[% view.view_foo(20) %]] [[% view.foo(30) %]] -- expect -- [Foo: 20] [Foo: 30] -- test -- [% USE view(prefix='my_', include_naked=0, view_naked=0) -%] [% BLOCK my_foo; "Foo: $item"; END -%] [[% view.view_foo(20) %]] [% TRY ; view.foo(30) ; CATCH ; error.info ; END %] -- expect -- [Foo: 20] no such view member: foo -- test -- [% USE view(map => { HASH => 'my_hash', ARRAY => 'your_list' }) -%] [% BLOCK text %]TEXT: [% item %][% END -%] [% BLOCK my_hash %]HASH: [% item.keys.sort.join(', ') %][% END -%] [% BLOCK your_list %]LIST: [% item.join(', ') %][% END -%] [% view.print("some text") %] [% view.print({ alpha => 'a', bravo => 'b' }) %] [% view.print([ 'charlie', 'delta' ]) %] -- expect -- TEXT: some text HASH: alpha, bravo LIST: charlie, delta -- test -- [% USE view(item => 'thing', map => { HASH => 'my_hash', ARRAY => 'your_list' }) -%] [% BLOCK text %]TEXT: [% thing %][% END -%] [% BLOCK my_hash %]HASH: [% thing.keys.sort.join(', ') %][% END -%] [% BLOCK your_list %]LIST: [% thing.join(', ') %][% END -%] [% view.print("some text") %] [% view.print({ alpha => 'a', bravo => 'b' }) %] [% view.print([ 'charlie', 'delta' ]) %] -- expect -- TEXT: some text HASH: alpha, bravo LIST: charlie, delta -- test -- [% USE view -%] [% view.print('Hello World') %] [% view1 = view.clone( prefix='my_') -%] [% view1.print('Hello World') %] [% view2 = view1.clone( prefix='dud_', notfound='no_text' ) -%] [% view2.print('Hello World') %] [% BLOCK text %]TEXT: [% item %][% END -%] [% BLOCK my_text %]MY TEXT: [% item %][% END -%] [% BLOCK dud_no_text %]NO TEXT: [% item %][% END -%] -- expect -- TEXT: Hello World MY TEXT: Hello World NO TEXT: Hello World -- test -- [% USE view( prefix = 'base_', default => 'any' ) -%] [% view1 = view.clone( prefix => 'one_') -%] [% view2 = view.clone( prefix => 'two_') -%] [% view.default %] / [% view.map.default %] [% view1.default = 'anyone' -%] [% view1.default %] / [% view1.map.default %] [% view2.map.default = 'anytwo' -%] [% view2.default %] / [% view2.map.default %] [% view.print("Hello World") %] / [% view.print(blessed_list) %] [% view1.print("Hello World") %] / [% view1.print(blessed_list) %] [% view2.print("Hello World") %] / [% view2.print(blessed_list) %] [% BLOCK base_text %]ANY TEXT: [% item %][% END -%] [% BLOCK one_text %]ONE TEXT: [% item %][% END -%] [% BLOCK two_text %]TWO TEXT: [% item %][% END -%] [% BLOCK base_any %]BASE ANY: [% item.as_list.join(', ') %][% END -%] [% BLOCK one_anyone %]ONE ANY: [% item.as_list.join(', ') %][% END -%] [% BLOCK two_anytwo %]TWO ANY: [% item.as_list.join(', ') %][% END -%] -- expect -- any / any anyone / anyone anytwo / anytwo ANY TEXT: Hello World / BASE ANY: Hello, World ONE TEXT: Hello World / ONE ANY: Hello, World TWO TEXT: Hello World / TWO ANY: Hello, World -- test -- [% USE view( prefix => 'my_', item => 'thing' ) -%] [% view.view('thingy', [ 'foo', 'bar'] ) %] [% BLOCK my_thingy %]thingy: [ [% thing.join(', ') %] ][%END %] -- expect -- thingy: [ foo, bar ] -- test -- [% USE view -%] [% view.map.${'Template::View'} = 'myview' -%] [% view.print(view) %] [% BLOCK myview %]MYVIEW[% END%] -- expect -- MYVIEW -- test -- [% USE view -%] [% view.include('greeting', msg => 'Hello World!') %] [% BLOCK greeting %]msg: [% msg %][% END -%] -- expect -- msg: Hello World! -- test -- [% USE view( prefix="my_" )-%] [% view.include('greeting', msg => 'Hello World!') %] [% BLOCK my_greeting %]msg: [% msg %][% END -%] -- expect -- msg: Hello World! -- test -- [% USE view( prefix="my_" )-%] [% view.include_greeting( msg => 'Hello World!') %] [% BLOCK my_greeting %]msg: [% msg %][% END -%] -- expect -- msg: Hello World! -- test -- [% USE view( prefix="my_" )-%] [% INCLUDE $view.template('greeting') msg = 'Hello World!' %] [% BLOCK my_greeting %]msg: [% msg %][% END -%] -- expect -- msg: Hello World! -- test -- [% USE view( title="My View" )-%] [% view.title %] -- expect -- My View -- test -- [% USE view( title="My View" )-%] [% newview = view.clone( col = 'Chartreuse') -%] [% newerview = newview.clone( title => 'New Title' ) -%] [% view.title %] [% newview.title %] [% newview.col %] [% newerview.title %] [% newerview.col %] -- expect -- My View My View Chartreuse New Title Chartreuse #------------------------------------------------------------------------ -- test -- [% VIEW fred prefix='blat_' %] This is the view [% END -%] [% BLOCK blat_foo; 'This is blat_foo'; END -%] [% fred.view_foo %] -- expect -- This is blat_foo -- test -- [% VIEW fred %] This is the view [% view.prefix = 'blat_' %] [% END -%] [% BLOCK blat_foo; 'This is blat_foo'; END -%] [% fred.view_foo %] -- expect -- This is blat_foo -- test -- [% VIEW fred %] This is the view [% view.prefix = 'blat_' %] [% view.thingy = 'bloop' %] [% fred.name = 'Freddy' %] [% END -%] [% fred.prefix %] [% fred.thingy %] [% fred.name %] -- expect -- blat_ bloop Freddy -- test -- [% VIEW fred prefix='blat_'; view.name='Fred'; END -%] [% fred.prefix %] [% fred.name %] [% TRY; fred.prefix = 'nonblat_'; CATCH; error; END %] [% TRY; fred.name = 'Derek'; CATCH; error; END %] -- expect -- blat_ Fred view error - cannot update config item in sealed view: prefix view error - cannot update item in sealed view: name -- test -- [% VIEW foo prefix='blat_' default="default" notfound="notfound" title="fred" age=23 height=1.82 %] [% view.other = 'another' %] [% END -%] [% BLOCK blat_hash -%] [% FOREACH key = item.keys.sort -%] [% key %] => [% item.$key %] [% END -%] [% END -%] [% foo.print(foo.data) %] -- expect -- age => 23 height => 1.82 other => another title => fred -- test -- [% VIEW foo %] [% BLOCK hello -%] Hello World! [% END %] [% BLOCK goodbye -%] Goodbye World! [% END %] [% END -%] [% TRY; INCLUDE foo; CATCH; error; END %] [% foo.include_hello %] -- expect -- file error - foo: not found Hello World! -- test -- [% title = "Previous Title" -%] [% VIEW foo include_naked = 1 title = title or 'Default Title' copy = 'me, now' -%] [% view.bgcol = '#ffffff' -%] [% BLOCK header -%] Header: bgcol: [% view.bgcol %] title: [% title %] view.title: [% view.title %] [%- END %] [% BLOCK footer -%] © Copyright [% view.copy %] [%- END %] [% END -%] [% title = 'New Title' -%] [% foo.header %] [% foo.header(bgcol='#dead' title="Title Parameter") %] [% foo.footer %] [% foo.footer(copy="you, then") %] -- expect -- Header: bgcol: #ffffff title: New Title view.title: Previous Title Header: bgcol: #ffffff title: Title Parameter view.title: Previous Title © Copyright me, now © Copyright me, now -- test -- [% VIEW foo title = 'My View' author = 'Andy Wardley' bgcol = bgcol or '#ffffff' -%] [% view.arg1 = 'argument #1' -%] [% view.data.arg2 = 'argument #2' -%] [% END -%] [% foo.title %] [% foo.author %] [% foo.bgcol %] [% foo.arg1 %] [% foo.arg2 %] [% bar = foo.clone( title='New View', arg1='New Arg1' ) %]cloned! [% bar.title %] [% bar.author %] [% bar.bgcol %] [% bar.arg1 %] [% bar.arg2 %] originals: [% foo.title %] [% foo.arg1 %] -- expect -- My View Andy Wardley #ffffff argument #1 argument #2 cloned! New View Andy Wardley #ffffff New Arg1 argument #2 originals: My View argument #1 -- test -- [% VIEW basic title = "My Web Site" %] [% BLOCK header -%] This is the basic header: [% title or view.title %] [%- END -%] [% END -%] [%- VIEW fancy title = "$basic.title" basic = basic %] [% BLOCK header ; view.basic.header(title = title or view.title) %] Fancy new part of header [%- END %] [% END -%] === [% basic.header %] [% basic.header( title = "New Title" ) %] === [% fancy.header %] [% fancy.header( title = "Fancy Title" ) %] -- expect -- === This is the basic header: My Web Site This is the basic header: New Title === This is the basic header: My Web Site Fancy new part of header This is the basic header: Fancy Title Fancy new part of header -- test -- [% VIEW baz notfound='lost' %] [% BLOCK lost; 'lost, not found'; END %] [% END -%] [% baz.any %] -- expect -- lost, not found -- test -- [% VIEW woz prefix='outer_' %] [% BLOCK wiz; 'The inner wiz'; END %] [% END -%] [% BLOCK outer_waz; 'The outer waz'; END -%] [% woz.wiz %] [% woz.waz %] -- expect -- The inner wiz The outer waz -- test -- [% VIEW foo %] [% BLOCK file -%] File: [% item.name %] [%- END -%] [% BLOCK directory -%] Dir: [% item.name %] [%- END %] [% END -%] [% foo.view_file({ name => 'some_file' }) %] [% foo.include_file(item => { name => 'some_file' }) %] [% foo.view('directory', { name => 'some_dir' }) %] -- expect -- File: some_file File: some_file Dir: some_dir -- test -- [% BLOCK parent -%] This is the base block [%- END -%] [% VIEW super %] [%- BLOCK parent -%] [%- INCLUDE parent | replace('base', 'super') -%] [%- END -%] [% END -%] base: [% INCLUDE parent %] super: [% super.parent %] -- expect -- base: This is the base block super: This is the super block -- test -- [% BLOCK foo -%] public foo block [%- END -%] [% VIEW plain %] [% BLOCK foo -%] [% PROCESS foo %] [%- END %] [% END -%] [% VIEW fancy %] [% BLOCK foo -%] [%- plain.foo | replace('plain', 'fancy') -%] [%- END %] [% END -%] [% plain.foo %] [% fancy.foo %] -- expect -- public foo block public foo block -- test -- [% VIEW foo %] [% BLOCK Blessed_List -%] This is a list: [% item.as_list.join(', ') %] [% END -%] [% END -%] [% foo.print(blessed_list) %] -- expect -- This is a list: Hello, World -- test -- [% VIEW my.foo value=33; END -%] n: [% my.foo.value %] -- expect -- n: 33 -- test -- [% VIEW parent -%] [% BLOCK one %]This is base one[% END %] [% BLOCK two %]This is base two[% END %] [% END -%] [%- VIEW child1 base=parent %] [% BLOCK one %]This is child1 one[% END %] [% END -%] [%- VIEW child2 base=parent %] [% BLOCK two %]This is child2 two[% END %] [% END -%] [%- VIEW child3 base=child2 %] [% BLOCK two %]This is child3 two[% END %] [% END -%] [%- FOREACH child = [ child1, child2, child3 ] -%] one: [% child.one %] [% END -%] [% FOREACH child = [ child1, child2, child3 ] -%] two: [% child.two %] [% END %] -- expect -- one: This is child1 one one: This is base one one: This is base one two: This is base two two: This is child2 two two: This is child3 two -- test -- [% VIEW my.view.default prefix = 'view/default/' value = 3.14; END -%] value: [% my.view.default.value %] -- expect -- value: 3.14 -- test -- [% VIEW my.view.default prefix = 'view/default/' value = 3.14; END; VIEW my.view.one base = my.view.default prefix = 'view/one/'; END; VIEW my.view.two base = my.view.default value = 2.718; END; -%] [% BLOCK view/default/foo %]Default foo[% END -%] [% BLOCK view/one/foo %]One foo[% END -%] 0: [% my.view.default.foo %] 1: [% my.view.one.foo %] 2: [% my.view.two.foo %] 0: [% my.view.default.value %] 1: [% my.view.one.value %] 2: [% my.view.two.value %] -- expect -- 0: Default foo 1: One foo 2: Default foo 0: 3.14 1: 3.14 2: 2.718 -- test -- [% VIEW foo number = 10 sealed = 0; END -%] a: [% foo.number %] b: [% foo.number = 20 %] c: [% foo.number %] d: [% foo.number(30) %] e: [% foo.number %] -- expect -- a: 10 b: c: 20 d: 30 e: 30 -- test -- [% VIEW foo number = 10 silent = 1; END -%] a: [% foo.number %] b: [% foo.number = 20 %] c: [% foo.number %] d: [% foo.number(30) %] e: [% foo.number %] -- expect -- a: 10 b: c: 10 d: 10 e: 10 -- test -- -- name bad base -- [% TRY; VIEW wiz base=no_such_base_at_all; END; CATCH; error; END -%] -- expect -- view error - Invalid base specified for view Template-Toolkit-3.102/t/template.t0000644000000000000000000000276613600243610015664 0ustar rootroot#============================================================= -*-perl-*- # # t/template.t # # Test the Template.pm module. Does nothing of any great importance # at the moment, but all of its options are tested in the various other # test scripts. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; my $out; my $dir = -d 't' ? 't/test' : 'test'; my $tt = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", OUTPUT => \$out, }); ok( $tt ); ok( $tt->process('header') ); ok( $out ); $out = ''; ok( ! $tt->process('this_file_does_not_exist') ); my $error = $tt->error(); ok( $error->type() eq 'file' ); ok( $error->info() eq 'this_file_does_not_exist: not found' ); my @output; $tt->process('header', undef, \@output); ok(length($output[-1])); sub myout { my $output = shift; ok($output) } ok($tt->process('header', undef, \&myout)); $out = Myout->new(); ok($tt->process('header', undef, $out)); package Myout; use Template::Test; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless($self, $class); return $self; } sub print { my $output = shift; ok($output); } Template-Toolkit-3.102/t/plugins.t0000644000000000000000000001417713600243610015531 0ustar rootroot#============================================================= -*-perl-*- # # t/plugins.t # # Test the Template::Plugins module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( t/lib ./lib ../lib ../blib/arch ); use Template::Test; use Template::Plugins; use Template::Constants qw( :debug ); use Cwd qw( abs_path ); $^W = 1; my $DEBUG = grep(/^--?d(debug)?$/, @ARGV); #$Template::Test::DEBUG = 0; #$Template::Plugins::DEBUG = 0; my $dir = abs_path( -d 't' ? 't/test/plugin' : 'test/plugin' ); my $src = abs_path( -d 't' ? 't/test/lib' : 'test/lib' ); unshift(@INC, $dir); my $tt1 = Template->new({ PLUGIN_BASE => ['MyPlugs','Template::Plugin'], INCLUDE_PATH => $src, DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }) || die Template->error(); require "MyPlugs/Bar.pm"; my $bar = MyPlugs::Bar->new(4); my $tt2 = Template->new({ PLUGINS => { bar => 'MyPlugs::Bar', baz => 'MyPlugs::Foo', cgi => 'MyPlugs::Bar', }, DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }) || die Template->error(); my $tt3 = Template->new({ LOAD_PERL => 1, DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }) || die Template->error(); # we need to delete one of the standard plugins from the $STD_PLUGINS hash # for the purposes of testing delete $Template::Plugins::STD_PLUGINS->{ date }; # for these we don't want the default Template::Plugin added to the # PLUGIN_BASE search path $Template::Plugins::PLUGIN_BASE = ''; my $tt4 = Template->new({ PLUGIN_BASE => 'MyPlugs', DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }); my $tt5 = Template->new({ DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }); my $tt = [ def => Template->new(), tt1 => $tt1, tt2 => $tt2, tt3 => $tt3, tt4 => $tt4, tt5 => $tt5, ]; test_expect(\*DATA, $tt, &callsign()); __END__ #------------------------------------------------------------------------ # basic plugin loads #------------------------------------------------------------------------ -- test -- [% USE Table([2, 3, 5, 7, 11, 13], rows=2) -%] [% Table.row(0).join(', ') %] -- expect -- 2, 5, 11 -- test -- [% USE table([17, 19, 23, 29, 31, 37], rows=2) -%] [% table.row(0).join(', ') %] -- expect -- 17, 23, 31 -- test -- [% USE t = Table([41, 43, 47, 49, 53, 59], rows=2) -%] [% t.row(0).join(', ') %] -- expect -- 41, 47, 53 -- test -- [% USE t = table([61, 67, 71, 73, 79, 83], rows=2) -%] [% t.row(0).join(', ') %] -- expect -- 61, 71, 79 #------------------------------------------------------------------------ # load Foo plugin through custom PLUGIN_BASE #------------------------------------------------------------------------ -- test -- -- use tt1 -- -- test -- [% USE t = table([89, 97, 101, 103, 107, 109], rows=2) -%] [% t.row(0).join(', ') %] -- expect -- 89, 101, 107 -- test -- [% USE Foo(2) -%] [% Foo.output %] -- expect -- This is the Foo plugin, value is 2 -- test -- [% USE Bar(4) -%] [% Bar.output %] -- expect -- This is the Bar plugin, value is 4 #------------------------------------------------------------------------ # load Foo plugin through custom PLUGINS #------------------------------------------------------------------------ -- test -- -- use tt2 -- [% USE t = table([113, 127, 131, 137, 139, 149], rows=2) -%] [% t.row(0).join(', ') %] -- expect -- 113, 131, 139 -- test -- [% TRY -%] [% USE Foo(8) -%] [% Foo.output %] [% CATCH -%] ERROR: [% error.info %] [% END %] -- expect -- ERROR: Foo: plugin not found -- test -- [% USE bar(16) -%] [% bar.output %] -- expect -- This is the Bar plugin, value is 16 -- test -- [% USE qux = baz(32) -%] [% qux.output %] -- expect -- This is the Foo plugin, value is 32 -- test -- [% USE wiz = cgi(64) -%] [% wiz.output %] -- expect -- This is the Bar plugin, value is 64 #------------------------------------------------------------------------ # LOAD_PERL #------------------------------------------------------------------------ -- test -- -- use tt3 -- [% USE baz = MyPlugs.Baz(128) -%] [% baz.output %] -- expect -- This is the Baz module, value is 128 -- test -- [% USE boz = MyPlugs.Baz(256) -%] [% boz.output %] -- expect -- This is the Baz module, value is 256 #------------------------------------------------------------------------ # Test case insensitivity of plugin names. We first look for the plugin # using the name specified in its original case. From v2.15 we also look # for standard plugins using the lower case conversion of the plugin name # specified. #------------------------------------------------------------------------ -- test -- [% USE mycgi = url('/cgi-bin/bar.pl', debug=1); %][% mycgi %] -- expect -- /cgi-bin/bar.pl?debug=1 -- test -- [% USE mycgi = URL('/cgi-bin/bar.pl', debug=1); %][% mycgi %] -- expect -- /cgi-bin/bar.pl?debug=1 -- test -- [% USE mycgi = UrL('/cgi-bin/bar.pl', debug=1); %][% mycgi %] -- expect -- /cgi-bin/bar.pl?debug=1 #------------------------------------------------------------------------ # ADD_DEFAULT_PLUGIN_BASE = 0. # Template::Plugins::URL no longer works since Template::Plugins is not # added to the default plugin base. Same with others. However, url will # work since it is specified as a plugin in # Template::Plugins::STD_PLUGINS. #------------------------------------------------------------------------ # should find Foo as we've specified 'MyPlugs' in the PLUGIN_BASE -- test -- -- use tt4 -- [% USE Foo(20) -%] [% Foo.output %] -- expect -- This is the Foo plugin, value is 20 -- test -- -- use tt4 -- [% TRY -%] [% USE Date() -%] [% CATCH -%] ERROR: [% error.info %] [% END %] -- expect -- ERROR: Date: plugin not found -- test -- [% USE mycgi = url('/cgi-bin/bar.pl', debug=1); %][% mycgi %] -- expect -- /cgi-bin/bar.pl?debug=1 -- test -- -- use tt1 -- -- name Simple plugin filter -- [% USE Simple -%] test 1: [% 'hello' | simple %] [% INCLUDE simple2 %] test 3: [% 'world' | simple %] -- expect -- test 1: **hello** test 2: **badger** test 3: **world** Template-Toolkit-3.102/t/fileline.t0000644000000000000000000000624114232015000015620 0ustar rootroot#============================================================= -*-perl-*- # # t/fileline.t # # Test the reporting of template file and line number in errors. # # Written by Andy Wardley # # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== #BEGIN { # if ( $^O eq 'MSWin32' ) { # print "1..0 # Skip Temporarily skipping on Win32\n"; # exit(0); # } #} use strict; use warnings; use lib qw( ./lib ../lib ./blib/lib ../blib/lib ./blib/arch ../blib/arch ); use Template::Test; use Template::Parser; use Template::Directive; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $dir = -d 't' ? 't/test/lib' : 'test/lib'; my $warning; local $SIG{__WARN__} = sub { $warning = shift; }; my $vars = { warning => sub { return $warning }, file => sub { $warning =~ /at (.*?) line/; my $file = $1; # The error returned includes a reference to the eval string # e.g. ' ...at (eval 1) line 1'. On some platforms (notably # FreeBSD and variants like OSX), the (eval $n) part contains # a different number, presumably because it has previously # performed additional string evals. It's not important to # the success or failure of the test, so we delete it. # Thanks to Andreas Koenig for identifying the problem. # http://rt.cpan.org/Public/Bug/Display.html?id=20807 $file =~ s/eval\s+\d+/eval/; # handle backslashes on Win32 by converting them to forward slashes $file =~ s!\\!/!g if $^O eq 'MSWin32'; return $file; }, line => sub { $warning =~ /line (\d*)/; return $1; }, warn => sub { $warning =~ /(.*?) at /; return $1; }, }; my $tt2err = Template->new({ INCLUDE_PATH => $dir }) || die Template->error(); my $tt2not = Template->new({ INCLUDE_PATH => $dir, FILE_INFO => 0 }) || die Template->error(); test_expect(\*DATA, [ err => $tt2err, not => $tt2not ], $vars); __DATA__ -- test -- [% place = 'World' -%] Hello [% place %] [% a = a + 1 -%] file: [% file %] line: [% line %] warn: [% warn %] -- expect -- -- process -- Hello World file: input text line: 3 warn: Argument "" isn't numeric in addition (+) -- test -- [% INCLUDE warning -%] file: [% file.chunk(-16).last %] line: [% line %] warn: [% warn %] -- expect -- -- process -- Hello World file: test/lib/warning line: 2 warn: Argument "" isn't numeric in addition (+) -- test -- -- use not -- [% INCLUDE warning -%] file: [% file.chunk(-16).last %] line: [% line %] warn: [% warn %] -- expect -- Hello World file: (eval) line: 11 warn: Argument "" isn't numeric in addition (+) -- test -- [% TRY; INCLUDE chomp; CATCH; error; END %] -- expect -- file error - parse error - chomp line 6: unexpected token (END) [% END %] Template-Toolkit-3.102/t/proc.t0000644000000000000000000000154313600243610015004 0ustar rootroot#============================================================= -*-perl-*- # # t/proc.t # # Template script testing the procedural template plugin # # Written by Mark Fowler # # Copyright (C) 2002 Makr Fowler. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib t/lib ); use Template::Test; $^W = 1; my $ttcfg = {}; test_expect(\*DATA, $ttcfg, &callsign()); __DATA__ -- test -- [% USE ProcFoo -%] [% ProcFoo.foo %] [% ProcFoo.bar %] -- expect -- This is procfoofoo This is procfoobar -- test -- [% USE ProcBar -%] [% ProcBar.foo %] [% ProcBar.bar %] [% ProcBar.baz %] -- expect -- This is procfoofoo This is procbarbar This is procbarbaz Template-Toolkit-3.102/t/date.t0000644000000000000000000001535414232015000014753 0ustar rootroot#============================================================= -*-perl-*- # # t/date.t # # Tests the 'Date' plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Plugin::Date; use POSIX; use Config; $^W = 1; eval "use Date::Calc"; my $got_date_calc = 0; $got_date_calc++ unless $@; $Template::Test::DEBUG = 0; my $format = { 'default' => $Template::Plugin::Date::FORMAT, 'time' => '%H:%M:%S', 'date' => '%d-%b-%Y', 'timeday' => 'the time is %H:%M:%S on %A', }; my $time = time; my @ltime = localtime($time); my $params = { time => $time, format => $format, timestr => &POSIX::strftime($format->{ time }, @ltime), datestr => &POSIX::strftime($format->{ date }, @ltime), daystr => &POSIX::strftime($format->{ timeday }, @ltime), defstr => &POSIX::strftime($format->{ default }, @ltime), now => sub { &POSIX::strftime(shift || $format->{ default }, localtime(time)); }, time_locale => \&time_locale, date_locale => \&date_locale, date_calc => $got_date_calc, }; sub time_locale { my ($time, $format, $locale) = @_; my $old_locale = $Config{d_setlocale} ? &POSIX::setlocale(&POSIX::LC_ALL) : undef; # some systems expect locales to have a particular suffix for my $suffix ('', @Template::Plugin::Date::LOCALE_SUFFIX) { my $try_locale = $locale.$suffix; my $setlocale = $Config{d_setlocale} ? &POSIX::setlocale(&POSIX::LC_ALL, $try_locale) : undef; if (defined $setlocale && $try_locale eq $setlocale) { $locale = $try_locale; last; } } my $datestr = &POSIX::strftime($format, localtime($time)); &POSIX::setlocale(&POSIX::LC_ALL, $old_locale) if $Config{d_setlocale}; return $datestr; } sub date_locale { my ($time, $format, $locale) = @_; my @date = (split(/(?:\/| |:|-)/, $time))[2,1,0,3..5]; return (undef, Template::Exception->new('date', "bad time/date string: expects 'h:m:s d:m:y' got: '$time'")) unless @date >= 6 && defined $date[5]; $date[4] -= 1; # correct month number 1-12 to range 0-11 $date[5] -= 1900; # convert absolute year to years since 1900 $time = &POSIX::mktime(@date); return time_locale($time, $format, $locale); } # force second to rollover so that we reliably see any tests failing. # lesson learnt from 2.07b where I broke the Date plugin's handling of a # 'time' parameter, but which didn't immediately come to light because the # script could run before the second rolled over and not expose the bug sleep 1; test_expect(\*DATA, { POST_CHOMP => 1 }, $params); #------------------------------------------------------------------------ # test input # # NOTE: these tests check that the Date plugin is behaving as expected # but don't attempt to validate that the output returned from strftime() # is semantically correct. It's a closed loop (aka "vicious circle" :-) # in which we compare what date.format() returns to what we get by # calling strftime() directly. Despite this, we can rest assured that # the plugin is correctly parsing the various parameters and passing # them to strftime() as expected. #------------------------------------------------------------------------ __DATA__ -- test -- [% USE date %] Let's hope the year doesn't roll over in between calls to date.format() and now()... Year: [% date.format(format => '%Y') %] -- expect -- -- process -- Let's hope the year doesn't roll over in between calls to date.format() and now()... Year: [% now('%Y') %] -- test -- [% USE date(time => time) %] default: [% date.format %] -- expect -- -- process -- default: [% defstr %] -- test -- [% USE date(time => time) %] [% date.format(format => format.timeday) %] -- expect -- -- process -- [% daystr %] -- test -- [% USE date(time => time, format = format.date) %] Date: [% date.format %] -- expect -- -- process -- Date: [% datestr %] -- test -- [% USE date(format = format.date) %] Time: [% date.format(time, format.time) %] -- expect -- -- process -- Time: [% timestr %] -- test -- [% USE date(format = format.date) %] Time: [% date.format(time, format = format.time) %] -- expect -- -- process -- Time: [% timestr %] -- test -- [% USE date(format = format.date) %] Time: [% date.format(time = time, format = format.time) %] -- expect -- -- process -- Time: [% timestr %] -- test -- [% USE english = date(format => '%A', locale => 'en_GB') %] [% USE french = date(format => '%A', locale => 'fr_FR') %] In English, today's day is: [% english.format +%] In French, today's day is: [% french.format +%] -- expect -- -- process -- In English, today's day is: [% time_locale(time, '%A', 'en_GB') +%] In French, today's day is: [% time_locale(time, '%A', 'fr_FR') +%] -- test -- [% USE english = date(format => '%A') %] [% USE french = date() %] In English, today's day is: [%- english.format(locale => 'en_GB') +%] In French, today's day is: [%- french.format(format => '%A', locale => 'fr_FR') +%] -- expect -- -- process -- In English, today's day is: [% time_locale(time, '%A', 'en_GB') +%] In French, today's day is: [% time_locale(time, '%A', 'fr_FR') +%] -- test -- [% USE date %] [% date.format('4:20:00 13-6-2000', '%H') %] -- expect -- 04 -- test -- [% USE date %] [% date.format('2000-6-13 4:20:00', '%H') %] -- expect -- 04 -- test -- -- name September 13th 2000 -- [% USE day = date(format => '%A', locale => 'en_GB') %] [% day.format('4:20:00 13-9-2000') %] -- expect -- -- process -- [% date_locale('4:20:00 13-9-2000', '%A', 'en_GB') %] -- test -- [% TRY %] [% USE date %] [% date.format('some stupid date') %] [% CATCH date %] Bad date: [% e.info %] [% END %] -- expect -- Bad date: bad time/date string: expects 'h:m:s d:m:y' got: 'some stupid date' -- test -- [% USE date %] [% template.name %] [% date.format(template.modtime, format='%Y') %] -- expect -- -- process -- input text [% now('%Y') %] -- test -- [% IF date_calc -%] [% USE date; calc = date.calc; calc.Monday_of_Week(22, 2001).join('/') %] [% ELSE -%] not testing [% END -%] -- expect -- -- process -- [% IF date_calc -%] 2001/5/28 [% ELSE -%] not testing [% END -%] -- test -- [% USE date; date.format('12:59:00 30/09/2001', '%H:%M') -%] -- expect -- 12:59 -- test -- [% USE date; date.format('2001/09/30 12:59:00', '%H:%M') -%] -- expect -- 12:59 -- test -- [% USE date; date.format('2001/09/30T12:59:00', '%H:%M') -%] -- expect -- 12:59 Template-Toolkit-3.102/t/skel.t0000644000000000000000000000166313600243610015002 0ustar rootroot#============================================================= -*-perl-*- # # t/skel.t # # Skeleton test script. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; ok(1); my $config = { POST_CHOMP => 1, EVAL_PERL => 1, }; my $replace = { a => 'alpha', b => 'bravo', }; test_expect(\*DATA, $config, $replace); __DATA__ # this is the first test -- test -- [% a %] -- expect -- alpha # this is the second test -- test -- [% b %] -- expect -- bravo Template-Toolkit-3.102/t/stash-xs.t0000644000000000000000000002065514232015000015610 0ustar rootroot#============================================================= -*-perl-*- # # t/stash-xs.t # # Template script testing (some elements of) the XS version of # Template::Stash # # Written by Andy Wardley # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ./blib/lib ./blib/arch ); use Template::Constants qw( :status ); use Template; use Template::Test; use Template::Config; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; # only run the test when compiled with Template::Stash if ( $Template::Config::STASH ne 'Template::Stash::XS' ) { skip_all('Template::Config is not using Template::Stash::XS'); } require Template::Stash::XS; #------------------------------------------------------------------------ # define some simple objects for testing #------------------------------------------------------------------------ package Buggy; sub new { bless {}, shift } sub croak { my $self = shift; die @_ } package ListObject; package HashObject; sub hello { my $self = shift; return "Hello $self->{ planet }"; } sub goodbye { my $self = shift; return $self->no_such_method(); } sub now_is_the_time_to_test_a_very_long_method_to_see_what_happens { my $self = shift; return $self->this_method_does_not_exist(); } #----------------------------------------------------------------------- # another object without overloaded comparison. # http://rt.cpan.org/Ticket/Display.html?id=24044 #----------------------------------------------------------------------- package CmpOverloadObject; use overload ('cmp' => 'compare_overload', '<=>', 'compare_overload'); sub new { bless {}, shift }; sub hello { return "Hello"; } sub compare_overload { die "Mayhem!"; } package main; my $count = 20; my $data = { foo => 10, bar => { baz => 20, }, baz => sub { return { boz => ($count += 10), biz => (shift || ''), }; }, obj => bless({ name => 'an object', }, 'AnObject'), bop => sub { return ( bless ({ name => 'an object' }, 'AnObject') ) }, listobj => bless([10, 20, 30], 'ListObject'), hashobj => bless({ planet => 'World' }, 'HashObject'), cmp_ol => CmpOverloadObject->new(), clean => sub { my $error = shift; $error =~ s/(\s*\(.*?\))?\s+at.*$//; return $error; }, correct => sub { die @_ }, buggy => Buggy->new(), str_eval_die => sub { # This is to test bug RT#47929 eval "use No::Such::Module::Exists"; return "str_eval_die returned"; }, }; my $stash = Template::Stash::XS->new($data); match( $stash->get('foo'), 10 ); match( $stash->get([ 'bar', 0, 'baz', 0 ]), 20 ); match( $stash->get('bar.baz'), 20 ); match( $stash->get('bar(10).baz'), 20 ); match( $stash->get('baz.boz'), 30 ); match( $stash->get('baz.boz'), 40 ); match( $stash->get('baz.biz'), '' ); match( $stash->get('baz(50).biz'), '' ); # args are ignored #match( $stash->get('str_eval_die'), '' ); $stash->set( 'bar.buz' => 100 ); match( $stash->get('bar.buz'), 100 ); # test the dotop() method match( $stash->dotop({ foo => 10 }, 'foo'), 10 ); my $stash_dbg = Template::Stash::XS->new({ %$data, _DEBUG => 1 }); my $ttlist = [ 'default' => Template->new( STASH => $stash ), 'warn' => Template->new( STASH => $stash_dbg ), ]; test_expect(\*DATA, $ttlist, $data); __DATA__ -- test -- -- name scalar list method -- [% foo = 'bar'; foo.join %] -- expect -- bar -- test -- a: [% a %] -- expect -- a: -- test -- -- use warn -- [% TRY; a; CATCH; "ERROR: $error"; END %] -- expect -- ERROR: undef error - a is undefined -- test -- -- use default -- [% myitem = 'foo' -%] 1: [% myitem %] 2: [% myitem.item %] 3: [% myitem.item.item %] -- expect -- 1: foo 2: foo 3: foo -- test -- [% myitem = 'foo' -%] [% "* $item\n" FOREACH item = myitem -%] [% "+ $item\n" FOREACH item = myitem.list %] -- expect -- * foo + foo -- test -- [% myitem = 'foo' -%] [% myitem.hash.value %] -- expect -- foo -- test -- [% myitem = 'foo' mylist = [ 'one', myitem, 'three' ] global.mylist = mylist -%] [% mylist.item %] 0: [% mylist.item(0) %] 1: [% mylist.item(1) %] 2: [% mylist.item(2) %] -- expect -- one 0: one 1: foo 2: three -- test -- [% "* $item\n" FOREACH item = global.mylist -%] [% "+ $item\n" FOREACH item = global.mylist.list -%] -- expect -- * one * foo * three + one + foo + three -- test -- [% global.mylist.push('bar'); "* $item.key => $item.value\n" FOREACH item = global.mylist.hash -%] -- expect -- * one => foo * three => bar -- test -- [% myhash = { msg => 'Hello World', things => global.mylist, a => 'alpha' }; global.myhash = myhash -%] * [% myhash.item('msg') %] -- expect -- * Hello World -- test -- [% global.myhash.delete('things') -%] keys: [% global.myhash.keys.sort.join(', ') %] -- expect -- keys: a, msg -- test -- [% "* $item\n" FOREACH item IN global.myhash.items.sort -%] -- expect -- * a * alpha * Hello World * msg -- test -- [% items = [ 'foo', 'bar', 'baz' ]; take = [ 0, 2 ]; slice = items.$take; slice.join(', '); %] -- expect -- foo, baz -- test -- -- name slice of lemon -- [% items = { foo = 'one', bar = 'two', baz = 'three' } take = [ 'foo', 'baz' ]; slice = items.$take; slice.join(', '); %] -- expect -- one, three -- test -- -- name slice of toast -- [% items = { foo = 'one', bar = 'two', baz = 'three' } keys = items.keys.sort; items.${keys}.join(', '); %] -- expect -- two, three, one -- test -- [% i = 0 %] [%- a = [ 0, 1, 2 ] -%] [%- WHILE i < 3 -%] [%- i %][% a.$i -%] [%- i = i + 1 -%] [%- END %] -- expect -- 001122 -- test -- [%- a = [ "alpha", "beta", "gamma", "delta" ] -%] [%- b = "foo" -%] [%- a.$b -%] -- expect -- -- test -- [%- a = [ "alpha", "beta", "gamma", "delta" ] -%] [%- b = "2" -%] [%- a.$b -%] -- expect -- gamma -- test -- [% obj.name %] -- expect -- an object -- test -- [% obj.name.list.first %] -- expect -- an object -- test -- -- name bop -- [% bop.first.name %] -- expect -- an object -- test -- [% obj.items.first %] -- expect -- name -- test -- [% obj.items.1 %] -- expect -- an object -- test -- =[% size %]= -- expect -- == -- test -- [% USE Dumper; TRY; correct(["hello", "there"]); CATCH; error.info.join(', '); END; %] == [% TRY; buggy.croak(["hello", "there"]); CATCH; error.info.join(', '); END; %] -- expect -- hello, there == hello, there -- test -- [% hash = { } list = [ hash ] list.last.message = 'Hello World'; "message: $list.last.message\n" -%] -- expect -- message: Hello World # test Dave Howorth's patch (v2.15) which makes the stash more strict # about what it considers to be a missing method error -- test -- [% hashobj.hello %] -- expect -- Hello World -- test -- [% TRY; hashobj.goodbye; CATCH; "ERROR: "; clean(error); END %] -- expect -- ERROR: undef error - Can't locate object method "no_such_method" via package "HashObject" -- test -- [% TRY; hashobj.now_is_the_time_to_test_a_very_long_method_to_see_what_happens; CATCH; "ERROR: "; clean(error); END %] -- expect -- ERROR: undef error - Can't locate object method "this_method_does_not_exist" via package "HashObject" -- test -- [% foo = { "one" = "bar" "" = "empty" } -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} setting foo.one to baz [% fookey = "one" foo.$fookey = "baz" -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} setting foo."" to quux [% fookey = "" foo.$fookey = "full" -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} --expect -- foo is { "" = "empty" "one" = "bar" } setting foo.one to baz foo is { "" = "empty" "one" = "baz" } setting foo."" to quux foo is { "" = "full" "one" = "baz" } # Exercise the object with the funky overloaded comparison -- test -- [% cmp_ol.hello %] -- expect -- Hello -- test -- Before [% TRY; str_eval_die; CATCH; "caught error: $error"; END; %] After -- expect -- Before str_eval_die returned After -- test -- [% str_eval_die %] -- expect -- str_eval_die returned Template-Toolkit-3.102/t/blocks.t0000644000000000000000000000432013600243610015312 0ustar rootroot#============================================================= -*-perl-*- # # t/blocks.t # # Test ability to INCLUDE/PROCESS a block in a template. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Provider; use Cwd; $^W = 1; my $DEBUG = grep(/-d/, @ARGV); #$Template::Parser::DEBUG = $DEBUG; #$Template::Directive::PRETTY = $DEBUG; $Template::Provider::DEBUG = $DEBUG; #$Template::Context::DEBUG = $DEBUG; my $path = cwd; my $dir = -d 'test/lib' ? "$path/test/lib" : "$path/t/test/lib"; my $tt1 = Template->new({ INCLUDE_PATH => [ qw( t/test/lib test/lib ) ], ABSOLUTE => 1, }); my $tt2 = Template->new({ INCLUDE_PATH => [ qw( t/test/lib test/lib ) ], EXPOSE_BLOCKS => 1, ABSOLUTE => 1, }); my $vars = { a => 'alpha', b => 'bravo', dir => $dir, }; test_expect(\*DATA, [ off => $tt1, on => $tt2 ], $vars); __DATA__ -- test -- [% TRY; INCLUDE blockdef/block1; CATCH; error; END %] -- expect -- file error - blockdef/block1: not found -- test -- -- use on -- [% INCLUDE blockdef/block1 %] -- expect -- This is block 1, defined in blockdef, a is alpha -- test -- [% INCLUDE blockdef/block1 a='amazing' %] -- expect -- This is block 1, defined in blockdef, a is amazing -- test -- [% TRY; INCLUDE blockdef/none; CATCH; error; END %] -- expect -- file error - blockdef/none: not found -- test -- [% INCLUDE "$dir/blockdef/block1" a='abstract' %] -- expect -- This is block 1, defined in blockdef, a is abstract -- test -- [% BLOCK one -%] block one [% BLOCK two -%] this is block two, b is [% b %] [% END -%] two has been defined, let's now include it [% INCLUDE one/two b='brilliant' -%] end of block one [% END -%] [% INCLUDE one -%] = [% INCLUDE one/two b='brazen'-%] --expect -- block one two has been defined, let's now include it this is block two, b is brilliant end of block one = this is block two, b is brazen Template-Toolkit-3.102/t/string.t0000644000000000000000000001660513600243610015354 0ustar rootroot#!/usr/bin/perl -w #============================================================= -*-perl-*- # # t/string.t # # Test the String plugin # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Plugin::String; my $DEBUG = grep /-d/, @ARGV; #$Template::Parser::DEBUG = $DEBUG; #$Template::Directive::PRETTY = $DEBUG; test_expect(\*DATA); __DATA__ -- test -- [% USE String -%] string: [[% String.text %]] -- expect -- string: [] -- test -- [% USE String 'hello world' -%] string: [[% String.text %]] -- expect -- string: [hello world] -- test -- [% USE String text='hello world' -%] string: [[% String.text %]] -- expect -- string: [hello world] -- test -- [% USE String -%] string: [[% String %]] -- expect -- string: [] -- test -- [% USE String 'hello world' -%] string: [[% String %]] -- expect -- string: [hello world] -- test -- [% USE String text='hello world' -%] string: [[% String %]] -- expect -- string: [hello world] -- test -- [% USE String text='hello' -%] string: [[% String.append(' world') %]] string: [[% String %]] -- expect -- string: [hello world] string: [hello world] -- test -- [% USE String text='hello' -%] [% copy = String.copy -%] string: [[% String %]] string: [[% copy %]] -- expect -- string: [hello] string: [hello] -- test -- [% USE String -%] [% hi = String.new('hello') -%] [% lo = String.new('world') -%] [% hw = String.new(text="$hi $lo") -%] hi: [[% hi %]] lo: [[% lo %]] hw: [[% hw %]] -- expect -- hi: [hello] lo: [world] hw: [hello world] -- test -- [% USE hi = String 'hello' -%] [% lo = hi.new('world') -%] hi: [[% hi %]] lo: [[% lo %]] -- expect -- hi: [hello] lo: [world] -- test -- [% USE hi = String 'hello' -%] [% lo = hi.copy -%] hi: [[% hi %]] lo: [[% lo %]] -- expect -- hi: [hello] lo: [hello] -- test -- [% USE hi = String 'hello' -%] [% lo = hi.copy.append(' world') -%] hi: [[% hi %]] lo: [[% lo %]] -- expect -- hi: [hello] lo: [hello world] -- test -- [% USE hi = String 'hello' -%] [% lo = hi.new('hey').append(' world') -%] hi: [[% hi %]] lo: [[% lo %]] -- expect -- hi: [hello] lo: [hey world] -- test -- [% USE hi=String "hello world\n" -%] hi: [[% hi %]] [% lo = hi.chomp -%] hi: [[% hi %]] lo: [[% lo %]] -- expect -- hi: [hello world ] hi: [hello world] lo: [hello world] -- test -- [% USE foo=String "foop" -%] [[% foo.chop %]] [[% foo.chop %]] -- expect -- [foo] [fo] -- test -- [% USE hi=String "hello" -%] left: [[% hi.copy.left(11) %]] right: [[% hi.copy.right(11) %]] center: [[% hi.copy.center(11) %]] centre: [[% hi.copy.centre(12) %]] -- expect -- left: [hello ] right: [ hello] center: [ hello ] centre: [ hello ] -- test -- [% USE str=String('hello world') -%] hi: [[% str.upper %]] hi: [[% str %]] lo: [[% str.lower %]] cap: [[% str.capital %]] -- expect -- hi: [HELLO WORLD] hi: [HELLO WORLD] lo: [hello world] cap: [Hello world] -- test -- [% USE str=String('hello world') -%] len: [[% str.length %]] -- expect -- len: [11] -- test -- [% USE str=String(" \n\n\t\r hello\nworld\n\r \n \r") -%] [[% str.trim %]] -- expect -- [hello world] -- test -- [% USE str=String(" \n\n\t\r hello \n \n\r world\n\r \n \r") -%] [[% str.collapse %]] -- expect -- [hello world] -- test -- [% USE str=String("hello") -%] [[% str.append(' world') %]] [[% str.prepend('well, ') %]] -- expect -- [hello world] [well, hello world] -- test -- [% USE str=String("hello") -%] [[% str.push(' world') %]] [[% str.unshift('well, ') %]] -- expect -- [hello world] [well, hello world] -- test -- [% USE str=String('foo bar') -%] [[% str.copy.pop(' bar') %]] [[% str.copy.shift('foo ') %]] -- expect -- [foo] [bar] -- test -- [% USE str=String('Hello World') -%] [[% str.copy.truncate(5) %]] [[% str.copy.truncate(8, '...') %]] [[% str.copy.truncate(20, '...') %]] -- expect -- [Hello] [Hello...] [Hello World] -- test -- [% USE String('foo') -%] [[% String.append(' ').repeat(4) %]] -- expect -- [foo foo foo foo ] -- test -- [% USE String('foo') -%] [% String.format("[%s]") %] -- expect -- [foo] -- test -- [% USE String('foo bar foo baz') -%] [[% String.replace('foo', 'oof') %]] -- expect -- [oof bar oof baz] -- test -- [% USE String('foo bar foo baz') -%] [[% String.copy.remove('foo\s*') %]] [[% String.copy.remove('ba[rz]\s*') %]] -- expect -- [bar baz] [foo foo ] -- test -- [% USE String('foo bar foo baz') -%] [[% String.split.join(', ') %]] -- expect -- [foo, bar, foo, baz] -- test -- [% USE String('foo bar foo baz') -%] [[% String.split(' bar ').join(', ') %]] -- expect -- [foo, foo baz] -- test -- [% USE String('foo bar foo baz') -%] [[% String.split(' bar ').join(', ') %]] -- expect -- [foo, foo baz] -- test -- [% USE String('foo bar foo baz') -%] [[% String.split('\s+').join(', ') %]] -- expect -- [foo, bar, foo, baz] -- test -- [% USE String('foo bar foo baz') -%] [[% String.split('\s+', 2).join(', ') %]] -- expect -- [foo, bar foo baz] -- test -- [% USE String('foo bar foo baz') -%] [% String.search('foo') ? 'ok' : 'not ok' %] [% String.search('fooz') ? 'not ok' : 'ok' %] [% String.search('^foo') ? 'ok' : 'not ok' %] [% String.search('^bar') ? 'not ok' : 'ok' %] -- expect -- ok ok ok ok -- test -- [% USE String 'foo < bar' filter='html' -%] [% String %] -- expect -- foo < bar -- test -- [% USE String 'foo bar' filter='uri' -%] [% String %] -- expect -- foo%20bar -- test -- [% USE String 'foo bar' filters='uri' -%] [% String %] -- expect -- foo%20bar -- test -- [% USE String ' foo bar ' filters=['trim' 'uri'] -%] [[% String %]] -- expect -- [foo%20bar] -- test -- [% USE String ' foo bar ' filter='trim, uri' -%] [[% String %]] -- expect -- [foo%20bar] -- test -- [% USE String ' foo bar ' filters='trim, uri' -%] [[% String %]] -- expect -- [foo%20bar] -- test -- [% USE String 'foo bar' filters={ replace=['bar', 'baz'], trim='', uri='' } -%] [[% String %]] -- expect -- [foo%20baz] -- test -- [% USE String 'foo bar' filters=[ 'replace', ['bar', 'baz'], 'trim', 'uri' ] -%] [[% String %]] -- expect -- [foo%20baz] -- test -- [% USE String 'foo bar' -%] [% String %] [% String.filter('uri') %] [% String.filter('replace', 'bar', 'baz') %] [% String.output_filter('uri') -%] [% String %] [% String.output_filter({ repeat => [3] }) -%] [% String %] -- expect -- foo bar foo%20bar foo baz foo%20bar foo%20barfoo%20barfoo%20bar -- test -- [% USE String; a = 'HeLLo'; b = 'hEllO'; a == b ? "not ok 0\n" : "ok 0\n"; String.new(a) == String.new(b) ? "not ok 1\n" : "ok 1\n"; String.new(a).lower == String.new(b).lower ? "ok 2\n" : "not ok 2\n"; String.new(a).lower.equals(String.new(b).lower) ? "ok 3\n" : "not ok 3\n"; a.search("(?i)^$b\$") ? "ok 4\n" : "not ok 4\n"; -%] -- expect -- ok 0 ok 1 ok 2 ok 3 ok 4 -- test -- [% USE String('Hello World') -%] a: [% String.substr(6) %]! b: [% String.substr(0, 5) %]! c: [% String.substr(0, 5, 'Goodbye') %]! d: [% String %]! -- expect -- a: World! b: Hello! c: Hello! d: Goodbye World! -- test -- [% USE str = String('foo bar baz wiz waz woz') -%] a: [% str.substr(4, 3) %] b: [% str.substr(12) %] c: [% str.substr(0, 11, 'FOO') %] d: [% str %] -- expect -- a: bar b: wiz waz woz c: foo bar baz d: FOO wiz waz woz Template-Toolkit-3.102/t/plusfile.t0000644000000000000000000000364213600243610015666 0ustar rootroot#============================================================= -*-perl-*- # # t/plufile.t # # Test ability to specify INCLUDE/PROCESS/WRAPPER files in the # form "foo+bar+baz". # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Context; $^W = 1; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; $Template::Test::PRESERVE = 1; my $dir = -d 't' ? 't/test/src' : 'test/src'; test_expect(\*DATA, { INCLUDE_PATH => $dir }); __DATA__ -- test -- [% INCLUDE foo %] [% BLOCK foo; "This is foo!"; END %] -- expect -- This is foo! -- test -- [% INCLUDE foo+bar -%] [% BLOCK foo; "This is foo!\n"; END %] [% BLOCK bar; "This is bar!\n"; END %] -- expect -- This is foo! This is bar! -- test -- [% PROCESS foo+bar -%] [% BLOCK foo; "This is foo!\n"; END %] [% BLOCK bar; "This is bar!\n"; END %] -- expect -- This is foo! This is bar! -- test -- [% WRAPPER edge + box + indent title = "The Title" -%] My content [% END -%] [% BLOCK indent -%] [% content -%] [% END -%] [% BLOCK box -%] [% content -%] [% END -%] [% BLOCK edge -%] [% content -%] [% END -%] -- expect -- My content -- test -- [% INSERT foo+bar/baz %] -- expect -- This is the foo file, a is [% a -%][% DEFAULT word = 'qux' -%] This is file baz The word is '[% word %]' -- test -- [% file1 = 'foo' file2 = 'bar/baz' -%] [% INSERT "$file1" + "$file2" %] -- expect -- This is the foo file, a is [% a -%][% DEFAULT word = 'qux' -%] This is file baz The word is '[% word %]' Template-Toolkit-3.102/t/datafile.t0000644000000000000000000000350014635371175015626 0ustar rootroot#============================================================= -*-perl-*- # # t/datafile.t # # Template script testing datafile plugin. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ./blib/lib ./blib/arch ../lib ../blib/lib ../blib/arch ); use Template; use Template::Test; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; $^W = 1; $Template::Test::DEBUG = 0; my $base = -d 't' ? 't/test/lib' : 'test/lib'; my $params = { datafile => [ "$base/udata1", "$base/udata2" ], }; test_expect(\*DATA, { INTERPOLATE => 1, POST_CHOMP => 1 }, $params); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ [% USE userlist = datafile(datafile.0) %] Users: [% FOREACH user = userlist %] * $user.id: $user.name [% END %] -- expect -- Users: * way: Wendy Yardley * mop: Marty Proton * nellb: Nell Browser -- test -- [% USE userlist = datafile(datafile.1, delim = '|') %] Users: [% FOREACH user = userlist %] * $user.id: $user.name <$user.email> [% END %] -- expect -- Users: * way: Wendy Yardley * mop: Marty Proton * nellb: Nell Browser -- test -- [% USE userlist = datafile(datafile.1, delim = '|') -%] size: [% userlist.size %] -- expect -- size: 3 Template-Toolkit-3.102/t/date_offset.t0000644000000000000000000000425614232015000016320 0ustar rootroot#============================================================= -*-perl-*- # # t/date_offset.t # # Tests the 'Date' plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Plugin::Date; use POSIX; use Config; $^W = 1; eval "use Date::Calc"; my $got_date_calc = 0; $got_date_calc++ unless $@; local $ENV{TZ} = 'GMT'; #local $ENV{TZ} = 'Europe/London'; skip_all('TZ GMT not showing as +0000') unless check_tz(); sub check_tz { # '2001/09/30T12:59:00' used in DATA my $date = [ '00', '59', '12', '30', 8, 101 ]; my $time = POSIX::mktime(@$date); push @$date, (localtime($time))[6..8]; my $tz = POSIX::strftime("%z", @$date); return $tz eq '+0000'; } $Template::Test::DEBUG = 0; my $format = { 'default' => $Template::Plugin::Date::FORMAT, 'time' => '%H:%M:%S', 'date' => '%d-%b-%Y', 'timeday' => 'the time is %H:%M:%S on %A', }; my $time = time; my @ltime = localtime($time); my $params = { time => $time, format => $format, now => sub { &POSIX::strftime(shift || $format->{ default }, localtime(time)); }, date_calc => $got_date_calc, }; # force second to rollover so that we reliably see any tests failing. # lesson learnt from 2.07b where I broke the Date plugin's handling of a # 'time' parameter, but which didn't immediately come to light because the # script could run before the second rolled over and not expose the bug sleep 1; test_expect(\*DATA, { POST_CHOMP => 1 }, $params); __DATA__ -- test -- [% USE date( use_offset = 1 ); date.format( '2001/09/30T12:59:00', '%H:%M %z' ) -%] -- expect -- 12:59 +0000 -- test -- [% USE date( use_offset = 1 ); date.format( '2001/09/30T12:59:00', '%H:%M' ) -%] -- expect -- 12:59 -- test -- [% USE date; date.format( time = '2001/09/30T12:59:00', format = '%H:%M %z', use_offset = 1 ) -%] -- expect -- 12:59 +0000 Template-Toolkit-3.102/t/dumper.t0000644000000000000000000000274114232015000015326 0ustar rootroot#============================================================= -*-perl-*- # # t/dumper.t # # Test the Dumper plugin. # # Written by Simon Matthews # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); our $DEBUG; use Template::Test; $^W = 1; my $params = { 'baz' => 'boo', }; $DEBUG = 0; test_expect(\*DATA, undef, { params => $params }); #------------------------------------------------------------------------ __DATA__ [% USE Dumper -%] Dumper -- expect -- Dumper -- test -- [% USE Dumper -%] [% Dumper.dump({ foo = 'bar' }, 'hello' ) -%] -- expect -- $VAR1 = { 'foo' => 'bar' }; $VAR2 = 'hello'; -- test -- [% USE Dumper -%] [% Dumper.dump(params) -%] -- expect -- $VAR1 = { 'baz' => 'boo' }; -- test -- [% USE Dumper -%] [% Dumper.dump_html(params) -%] -- expect -- $VAR1 = {
'baz' => 'boo'
};
-- test -- [% USE dumper(indent=1, pad='> ', varname="frank") -%] [% dumper.dump(params) -%] -- expect -- > $frank1 = { > 'baz' => 'boo' > }; -- test -- [% USE dumper(Pad='>> ', Varname="bob") -%] [% dumper.dump(params) -%] -- expect -- >> $bob1 = { >> 'baz' => 'boo' >> }; -- test -- [% USE Dumper -%] [% Dumper.dump(params) -%] -- expect -- $VAR1 = { 'baz' => 'boo' }; Template-Toolkit-3.102/t/block_duplicate.t0000644000000000000000000000073413600243610017166 0ustar rootrootuse strict; use warnings; use Test::More tests => 1; use Template; my $warning_seen; local $SIG{__WARN__} = sub { my @warnings = @_; if ($warnings[0] =~ /Block redefined: b1/) { ++$warning_seen; } else { die "Unexpected warning: ", @warnings; } }; my $t = Template->new; $t->process(\ << '__TEMPLATE__', {}, \ my $ignore_output); [% BLOCK b1 %]first[% END %] [% BLOCK b1 %]second[% END %] __TEMPLATE__ is $warning_seen, 1, 'warning seen'; Template-Toolkit-3.102/t/strcat.t0000644000000000000000000000136613600243610015344 0ustar rootroot#============================================================= -*-perl-*- # # t/strcat.t # # Test the string concatenation operator ' _ '. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; test_expect(\*DATA); __DATA__ -- test -- [% foo = 'the foo string' bar = 'the bar string' baz = foo _ ' and ' _ bar -%] baz: [% baz %] -- expect -- baz: the foo string and the bar string Template-Toolkit-3.102/t/while.t0000644000000000000000000000627214232015000015145 0ustar rootroot#============================================================= -*-perl-*- # # t/while.t # # Test the WHILE directive # # Written by Andy Wardley # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use Template::Parser; use Template::Directive; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; # set low limit on WHILE's maximum iteration count $Template::Directive::WHILE_MAX = 100; my $config = { INTERPOLATE => 1, POST_CHOMP => 1, }; my @list = ( 'x-ray', 'yankee', 'zulu', ); my @pending; my $replace = { 'a' => 'alpha', 'b' => 'bravo', 'c' => 'charlie', 'd' => 'delta', 'dec' => sub { --$_[0] }, 'inc' => sub { ++$_[0] }, 'reset' => sub { @pending = @list; "Reset list\n" }, 'next' => sub { shift @pending }, 'true' => 1, }; test_expect(\*DATA, $config, $replace); __DATA__ before [% WHILE bollocks %] do nothing [% END %] after -- expect -- before after -- test -- Commence countdown... [% a = 10 %] [% WHILE a %] [% a %]..[% a = dec(a) %] [% END +%] The end -- expect -- Commence countdown... 10..9..8..7..6..5..4..3..2..1.. The end -- test -- [% reset %] [% WHILE (item = next) %] item: [% item +%] [% END %] -- expect -- Reset list item: x-ray item: yankee item: zulu -- test -- [% reset %] [% WHILE (item = next) %] item: [% item +%] [% BREAK IF item == 'yankee' %] [% END %] Finis -- expect -- Reset list item: x-ray item: yankee Finis -- test -- [% reset %] [% "* $item\n" WHILE (item = next) %] -- expect -- Reset list * x-ray * yankee * zulu -- test -- [% TRY %] [% WHILE true %].[% END %] [% CATCH +%] error: [% error.info %] [% END %] -- expect -- .................................................................................................... error: WHILE loop terminated (> 100 iterations) -- test -- [% reset %] [% WHILE (item = next) %] [% NEXT IF item == 'yankee' -%] * [% item +%] [% END %] -- expect -- Reset list * x-ray * zulu -- test -- [% i = 1; WHILE i <= 10; SWITCH i; CASE 5; i = i + 1; NEXT; CASE 8; LAST; END; "$i\n"; i = i + 1; END; -%] -- expect -- 1 2 3 4 6 7 -- test -- [% i = 1; WHILE i <= 10; IF 1; IF i == 5; i = i + 1; NEXT; END; IF i == 8; LAST; END; END; "$i\n"; i = i + 1; END; -%] -- expect -- 1 2 3 4 6 7 -- test -- [% i = 1; WHILE i <= 4; j = 1; WHILE j <= 4; k = 1; SWITCH j; CASE 2; WHILE k == 1; LAST; END; CASE 3; IF j == 3; j = j + 1; NEXT; END; END; "$i,$j,$k\n"; j = j + 1; END; i = i + 1; END; -%] -- expect -- 1,1,1 1,2,1 1,4,1 2,1,1 2,2,1 2,4,1 3,1,1 3,2,1 3,4,1 4,1,1 4,2,1 4,4,1 -- test -- [% k = 1; LAST WHILE k == 1; "$k\n"; -%] -- expect -- 1 Template-Toolkit-3.102/t/parser.t0000644000000000000000000001136313600243610015336 0ustar rootroot#============================================================= -*-perl-*- # # t/parser.t # # Test the Template::Parser module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( . ../lib ); use Template::Test; use Template::Config; use Template::Parser; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Test::PRESERVE = 1; #$Template::Stash::DEBUG = 1; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $p2 = Template::Parser->new({ START_TAG => '\[\*', END_TAG => '\*\]', ANYCASE => 1, PRE_CHOMP => 1, V1DOLLAR => 1, }); # test new/old styles my $s1 = $p2->new_style( { TAG_STYLE => 'metatext', PRE_CHOMP => 0, POST_CHOMP => 1 } ) || die $p2->error(); ok( $s1 ); match( $s1->{ START_TAG }, '%%' ); match( $s1->{ PRE_CHOMP }, '0' ); match( $s1->{ POST_CHOMP }, '1' ); #print STDERR "style: { ", join(', ', map { "$_ => $s1->{ $_ }" } keys %$s1), " }\n"; my $s2 = $p2->old_style() || die $p2->error(); ok( $s2 ); match( $s2->{ START_TAG }, '\[\*' ); match( $s2->{ PRE_CHOMP }, '1' ); match( $s2->{ POST_CHOMP }, '0' ); #print STDERR "style: { ", join(', ', map { "$_ => $s2->{ $_ }" } keys %$s2), " }\n"; my $p3 = Template::Config->parser({ TAG_STYLE => 'html', POST_CHOMP => 1, ANYCASE => 1, INTERPOLATE => 1, }); my $p4 = Template::Config->parser({ ANYCASE => 0, }); my $tt = [ tt1 => Template->new(ANYCASE => 1), tt2 => Template->new(PARSER => $p2), tt3 => Template->new(PARSER => $p3), tt4 => Template->new(PARSER => $p4), ]; my $replace = &callsign; $replace->{ alist } = [ 'foo', 0, 'bar', 0 ]; $replace->{ wintxt } = "foo\r\n\r\nbar\r\n\r\nbaz"; $replace->{ data } = { first => 11, last => 42 }; test_expect(\*DATA, $tt, $replace); __DATA__ #------------------------------------------------------------------------ # tt1 #------------------------------------------------------------------------ -- test -- start $a [% BLOCK a %] this is a [% END %] =[% INCLUDE a %]= =[% include a %]= end -- expect -- start $a = this is a = = this is a = end -- test -- [% data.first; ' to '; data.last %] -- expect -- 11 to 42 #------------------------------------------------------------------------ # tt2 #------------------------------------------------------------------------ -- test -- -- use tt2 -- begin [% this will be ignored %] [* a *] end -- expect -- begin [% this will be ignored %]alpha end -- test -- $b does nothing: [* c = 'b'; 'hello' *] stuff: [* $c *] -- expect -- $b does nothing: hello stuff: b #------------------------------------------------------------------------ # tt3 #------------------------------------------------------------------------ -- test -- -- use tt3 -- begin [% this will be ignored %] end -- expect -- begin [% this will be ignored %] alphaend -- test -- $b does something: stuff: end -- expect -- bravo does something: hellostuff: bravoend #------------------------------------------------------------------------ # tt4 #------------------------------------------------------------------------ -- test -- -- use tt4 -- start $a[% 'include' = 'hello world' %] [% BLOCK a -%] this is a [%- END %] =[% INCLUDE a %]= =[% include %]= end -- expect -- start $a =this is a= =hello world= end #------------------------------------------------------------------------ -- test -- [% sql = " SELECT * FROM table" -%] SQL: [% sql %] -- expect -- SQL: SELECT * FROM table -- test -- [% a = "\a\b\c\ndef" -%] a: [% a %] -- expect -- a: abc def -- test -- [% a = "\f\o\o" b = "a is '$a'" c = "b is \$100" -%] a: [% a %] b: [% b %] c: [% c %] -- expect -- a: foo b: a is 'foo' c: b is $100 -- test -- [% tag = { a => "[\%" z => "%\]" } quoted = "[\% INSERT foo %\]" -%] A directive looks like: [% tag.a %] INCLUDE foo [% tag.z %] The quoted value is [% quoted %] -- expect -- A directive looks like: [% INCLUDE foo %] The quoted value is [% INSERT foo %] -- test -- =[% wintxt | replace("(\r\n){2,}", "\n\n") %] -- expect -- =foo bar baz -- test -- [% nl = "\n" tab = "\t" -%] blah blah[% nl %][% tab %]x[% nl; tab %]y[% nl %]end -- expect -- blah blah x y end #------------------------------------------------------------------------ # STOP RIGHT HERE! #------------------------------------------------------------------------ -- stop -- -- test -- alist: [% $alist %] -- expect -- alist: ?? -- test -- [% foo.bar.baz %] Template-Toolkit-3.102/t/math_rand.t0000644000000000000000000000073413600243610015777 0ustar rootrootuse strict; use Test::More; use Template; plan tests => 1; my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; my $t = Template->new; my $out; $t->process(\<error; [% USE Math -%] rand with arg: [% Math.rand(1000000) %] rand without arg: [% Math.rand %] srand with arg: [% Math.srand(1000000) %] srand without arg: [% Math.srand %] EOF #diag $out; is_deeply \@warnings, [], 'No warnings when calling rand/srand without arg'; Template-Toolkit-3.102/t/date_utf8.t0000644000000000000000000000252714232015000015717 0ustar rootroot#============================================================= -*-perl-*- # # t/date_utf8.t # # Tests the 'Date' plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use utf8; use strict; use warnings; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Plugin::Date; use POSIX qw{ setlocale LC_ALL }; use Config; # this test fails on CI workflow probably due to missing locale skip_all( "Need to set env variable AUTHOR_TESTING=1" ) unless $ENV{AUTHOR_TESTING} && !$ENV{AUTOMATED_TESTING}; skip_all( "d_setlocale unset" ) unless $Config::Config{d_setlocale}; #$Template::Test::DEBUG = 0; my $russian_locale = 'ru_RU.UTF-8'; my $loc = setlocale( LC_ALL, $russian_locale ); skip_all("no russian locale $russian_locale available") unless $loc && $loc eq $russian_locale; setlocale( LC_ALL, 'C' ); my $params = {}; test_expect(\*DATA, { POST_CHOMP => 1 }, $params); __DATA__ -- test -- [% USE russian = date(format => '%A, %e %B %Y', locale => 'ru_RU.UTF-8') %] In Russian with UTF8: [% russian.format(1245) +%] -- expect -- In Russian with UTF8: Ñреда, 31 Ð´ÐµÐºÐ°Ð±Ñ€Ñ 1969 Template-Toolkit-3.102/t/filter.t0000644000000000000000000004337214635371175015355 0ustar rootroot#============================================================= -*-perl-*- # # t/filter.t # # Template script testing FILTER directive. # # Written by Andy Wardley # # Copyright (C) 1996-2020 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. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Filters; use Template; use Template::Parser; use Template::Test; use Template::Constants qw( :debug ); 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'), widetext => "wide:\x{65e5}\x{672c}\x{8a9e}", use_rfc2732 => sub { Template::Filters->use_rfc2732; }, use_rfc3986 => sub { Template::Filters->use_rfc3986; } }; 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) || die Template->error(); my $tt2 = Template->new($config2) || die Template->error(); $tt2->context->define_filter('another', \&another, 1); tie(*STDERR, "Tie::File2Str", \$stderr); 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 should be escaped & protected [% END %] -- expect -- This is some html text All the <tags> should be escaped & protected -- test -- [% text = "The sat on the " %] [% FILTER html %] text: $text [% END %] -- expect -- text: The <cat> sat on the <mat> -- test -- [% text = "The sat on the " %] [% 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 xml %] "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('') %] Hello World! [% END +%] [% "Goodbye, cruel World" FILTER comment %] -- expect -- -- 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('%s') %] This is bold [% END +%] [% FILTER italic = format('%s') %] This is italic [% END +%] [% 'This is both' FILTER bold FILTER italic %] -- expect -- This is bold This is italic This is both -- 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 --

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_break %] -- 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_break %] -- 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_line_break %] -- 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 truncate(10) %] -- expect -- The cat... -- test -- [% global.blocktext FILTER truncate %] -- expect -- The cat sat on the mat Mary ... -- test -- [% 'Hello World' | truncate(2) +%] [% 'Hello World' | truncate(8) +%] [% 'Hello World' | truncate(10) +%] [% 'Hello World' | truncate(11) +%] [% 'Hello World' | truncate(20) +%] -- expect -- .. Hello... Hello W... Hello World 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 || ''; $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 || ''; $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 -%] [% 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 -- <> -- test -- <<[% FILTER collapse %] The cat sat on the mat [% END %]>> -- expect -- <> -- 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 -- [% "myfile.html" FILTER uri %] -- expect -- my%3Cfile%20%26%20your%3Efile.html -- test -- [% "foo@bar" FILTER uri %] -- expect -- foo%40bar -- test -- [% "foo@bar" FILTER url %] -- expect -- foo@bar -- test -- [% "myfile.html" | uri | html %] -- expect -- my%3Cfile%20%26%20your%3Efile.html -- test -- [% widetext | uri %] -- expect -- wide%3A%E6%97%A5%E6%9C%AC%E8%AA%9E -- test -- [% 'foobar' | ucfirst %] -- expect -- Foobar -- test -- [% 'FOOBAR' | lcfirst %] -- expect -- fOOBAR -- test -- [% "foo(bar)" | uri %] -- expect -- foo%28bar%29 -- test -- [% "foo(bar)" | url %] -- expect -- foo%28bar%29 -- test -- [% use_rfc3986; "foo(bar)" | url; %] -- expect -- foo%28bar%29 -- test -- [% "foo(bar)" | uri %] -- expect -- foo%28bar%29 -- test -- [% use_rfc2732; "foo(bar)" | url; %] -- expect -- foo(bar) -- test -- [% "foo(bar)" | uri %] -- expect -- foo(bar) Template-Toolkit-3.102/t/compile3.t0000644000000000000000000000740414232015000015546 0ustar rootroot#============================================================= -*-perl-*- # # t/compile3.t # # Third test in the compile.t trilogy. Checks that modifications # to a source template result in a re-compilation of the template. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use File::Copy; use File::Spec; #ntests(13); # declare extra test to follow test_expect(); $Template::Test::EXTRA = 1; #$Template::Parser::DEBUG = 1; # script may be being run in distribution root or 't' directory my @dir = -d 't' ? qw(t test src) : qw(test src); my $dir = File::Spec->catfile(@dir); my $ttcfg = { POST_CHOMP => 1, INCLUDE_PATH => $dir, COMPILE_EXT => '.ttc', }; # test process fails when EVAL_PERL not set my $tt = Template->new($ttcfg); my $out; ok( ! $tt->process("evalperl", { }, \$out) ); match( $tt->error->type, 'perl' ); match( $tt->error->info, 'EVAL_PERL not set' ); # ensure we can run compiled templates without loading parser # (fix for "Can't locate object method "TIEHANDLE" via package # Template::String..." bug) $ttcfg->{ EVAL_PERL } = 1; $tt = Template->new($ttcfg); ok( $tt->process("evalperl", { }, \$out) ) || match( $tt->error(), "" ); my $file = "$dir/complex"; # check compiled template file exists and grab modification time ok( -f "$file.ttc" ); my $mod = (stat(_))[9]; # save copy of the source file because we're going to try to break it copy($file, "$file.org") || die "failed to copy $file to $file.org\n"; # sleep for a couple of seconds to ensure clock has ticked sleep(2); # append a harmless newline to the end of the source file to change # its modification time append_file("\n"); # define 'bust_it' to append a lone "[% TRY %]" onto the end of the # source file to cause re-compilation to fail my $replace = { bust_it => sub { append_file('[% TRY %]') }, near_line => sub { my ($warning, $n) = @_; if ($warning =~ s/line (\d+)/line ${n}ish/) { my $diff = abs($1 - $n); if ($diff < 4) { # That's close enough for rock'n'roll. The line # number reported appears to vary from one version of # Perl to another return $warning; } else { return $warning . " (where 'ish' means $diff!)"; } } else { return "no idea what line number that is\n"; } } }; test_expect(\*DATA, $ttcfg, $replace ); ok( (stat($file))[9] > $mod ); # restore original source file copy("$file.org", $file) || die "failed to copy $file.org to $file\n"; #------------------------------------------------------------------------ sub append_file { local *FP; sleep(2); # ensure file time stamps are different open(FP, ">>", $file) || die "$file: $!\n"; print FP @_; close(FP); } #------------------------------------------------------------------------ __DATA__ -- test -- [% META author => 'albert' version => 'emc2' %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: albert, version: emc2 - 3 - 2 - 1 -- test -- [%# we want to break 'compile' to check that errors get reported -%] [% CALL bust_it -%] [% TRY; INCLUDE complex; CATCH; near_line("$error", 18); END %] -- expect -- file error - parse error - complex line 18ish: unexpected end of input Template-Toolkit-3.102/t/process.t0000644000000000000000000000361213600243610015516 0ustar rootroot#============================================================= -*-perl-*- # # t/process.t # # Test the PROCESS option. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Service; my $dir = -d 't' ? 't/test' : 'test'; my $config = { INCLUDE_PATH => "$dir/src:$dir/lib", PROCESS => 'content', TRIM => 1, }; my $tt1 = Template->new($config); $config->{ PRE_PROCESS } = 'config'; $config->{ PROCESS } = 'header:content'; $config->{ POST_PROCESS } = 'footer'; $config->{ TRIM } = 0; my $tt2 = Template->new($config); $config->{ PRE_PROCESS } = 'config:header.tt2'; $config->{ PROCESS } = ''; my $tt3 = Template->new($config); my $replace = { title => 'Joe Random Title', }; test_expect(\*DATA, [ tt1 => $tt1, tt2 => $tt2, tt3 => $tt3 ], $replace); __END__ -- test -- This is the first test -- expect -- This is the main content wrapper for "untitled" This is the first test This is the end. -- test -- [% META title = 'Test 2' -%] This is the second test -- expect -- This is the main content wrapper for "Test 2" This is the second test This is the end. -- test -- -- use tt2 -- [% META title = 'Test 3' -%] This is the third test -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' This is the main content wrapper for "Test 3" This is the third test This is the end. footer -- test -- -- use tt3 -- [% META title = 'Test 3' -%] This is the third test -- expect -- header.tt2: title: Joe Random Title menu: This is the menu, defined in 'config' footer Template-Toolkit-3.102/t/debug.t0000644000000000000000000000756013600243610015134 0ustar rootroot#============================================================= -*-perl-*- # # t/debug.t # # Test the Debug plugin module. # # Written by Andy Wardley # # Copyright (C) 2002 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test qw( :all ); use Template::Parser; use Template::Directive; use Template::Constants qw( :debug ); my $DEBUG = grep(/-d/, @ARGV); #$Template::Parser::DEBUG = 1; #$DEBUG; #$Template::Directive::Pretty = $DEBUG; $Template::Test::PRESERVE = 1; my $dir = -d 't' ? 't/test' : 'test'; my $vars = { foo => 10, bar => 20, baz => { ping => 100, pong => 200, }, }; my $dummy = Template::Base->new() || die Template::Base->error(); ok( $dummy, 'created a dummy object' ); my $flags = Template::Constants::debug_flags($dummy, 'dirs, stash'); ok( $flags, 'created flags' ); is( $flags, DEBUG_DIRS | DEBUG_STASH, "flags value is $flags" ); $flags = Template::Constants::debug_flags($dummy, $flags) || die $dummy->error(); ok( $flags, 'got more flags back' ); is( $flags, 'dirs, stash', 'dirs, stash' ); $flags = Template::Constants::debug_flags($dummy, 'bad stupid'); ok( ! $flags, 'bad flags' ); is( $dummy->error(), 'unknown debug flag: bad', 'error correct' ); my $tt = Template->new( { DEBUG => 0, INCLUDE_PATH => "$dir/src:$dir/lib", DEBUG_FORMAT => "", } ) || die Template->error(); my $tt2 = Template->new( { DEBUG => DEBUG_DIRS, INCLUDE_PATH => "$dir/src:$dir/lib", } ) || die Template->error(); my $ttd = Template->new( { DEBUG => 'dirs, vars', INCLUDE_PATH => "$dir/src:$dir/lib", DEBUG_FORMAT => "", } ) || die Template->error(); test_expect(\*DATA, [ default => $tt, debug => $ttd, debug2 => $tt2 ], $vars); #$tt->process(\*DATA, $vars) || die $tt->error(); #print $tt->context->_dump(); __DATA__ -- test -- Hello World foo: [% foo %] -- expect -- Hello World foo: 10 -- test -- -- use debug -- Hello World foo: [% foo %] -- expect -- Hello World foo: 10 -- test -- -- use default -- Hello World foo: [% foo %] [% DEBUG on -%] Debugging enabled foo: [% foo %] -- expect -- Hello World foo: 10 Debugging enabled foo: 10 -- test -- -- use debug -- [% DEBUG off %] Hello World foo: [% foo %] [% DEBUG on -%] Debugging enabled foo: [% foo %] -- expect -- Hello World foo: 10 Debugging enabled foo: 10 -- test -- -- name ping pong -- foo: [% foo %] hello [% "$baz.ping/$baz.pong" %] world [% DEBUG off %] bar: [% bar %][% DEBUG on %] -- expect -- foo: 10 hello 100/200 world bar: 20 -- test -- -- use debug -- foo: [% foo %] [% INCLUDE foo a=10 %] [% DEBUG off -%] foo: [% foo %] [% INCLUDE foo a=20 %] -- expect -- foo: 10 This is the foo file, a is 10 foo: 10 This is the foo file, a is 20 -- stop -- -- test -- -- use default -- [% DEBUG on -%] [% DEBUG format '[ $file line $line ]' %] [% foo %] -- expect -- [ input text line 3 ]10 -- test -- -- use default -- [% DEBUG on + format '[ $file line $line ]' -%] [% foo %] -- expect -- [ input text line 2 ]10 -- test -- [% DEBUG on; DEBUG format '$text at line $line of $file'; DEBUG msg line='3.14' file='this file' text='hello world' %] -- expect -- hello world at line 3.14 of this file Template-Toolkit-3.102/t/compile4.t0000644000000000000000000000460513600243610015557 0ustar rootroot#============================================================= -*-perl-*- # # t/compile4.t # # Test the facility for the Template::Provider to maintain a persistance # cache of compiled templates by writing generated Perl code to files. # This is similar to compile1.t but defines COMPILE_DIR as well as # COMPILE_EXT. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Cwd qw( abs_path ); use File::Path; $^W = 1; # declare extra tests to follow test_expect(); #$Template::Test::EXTRA = 2; # script may be being run in distribution root or 't' directory my @dir = -d 't' ? qw(t test) : qw(test); my $dir = abs_path( File::Spec->catfile(@dir) ); my $tdir = abs_path( File::Spec->catfile(@dir, 'tmp')); my $cdir = File::Spec->catfile($tdir, 'cache'); my $zero = File::Spec->catfile($dir, qw(src divisionbyzero)); my $ttcfg = { POST_CHOMP => 1, INCLUDE_PATH => "$dir/src", COMPILE_DIR => $cdir, COMPILE_EXT => '.ttc', ABSOLUTE => 1, CONSTANTS => { dir => $dir, zero => $zero, }, }; # delete any existing cache files rmtree($cdir) if -d $cdir; mkpath($cdir); test_expect(\*DATA, $ttcfg, { root => abs_path($dir) } ); __DATA__ -- test -- [% TRY %] [% INCLUDE foo %] [% CATCH file %] Error: [% error.type %] - [% error.info %] [% END %] -- expect -- This is the foo file, a is -- test -- [% META author => 'abw' version => 3.14 %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: abw, version: 3.14 - 3 - 2 - 1 -- test -- [% TRY %] [% INCLUDE bar/baz word = 'wibble' %] [% CATCH file %] Error: [% error.type %] - [% error.info %] [% END %] -- expect -- This is file baz The word is 'wibble' -- test -- [% INCLUDE "$root/src/blam" %] -- expect -- This is the blam file -- test -- [%- # first pass, writes the compiled code to cache -%] [% INCLUDE divisionbyzero -%] -- expect -- -- process -- undef error - Illegal division by zero at [% constants.zero %] line 1. Template-Toolkit-3.102/t/process-relative.t0000644000000000000000000000406713600243610017334 0ustar rootroot#============================================================= -*-perl-*- # # t/process-relative.t # # Test template process with . in INCLUDE_PATH # # Written by Nicolas R. # # Copyright (C) 2018 cPanel Inc. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; #use Template::Test; use Test::More tests => 8; #$Template::Test::DEBUG = 0; #$Template::Context::DEBUG = 1; my $template_file = q[t/test/dir/file1]; plan( skip_all => "File $template_file missing" ) unless -e $template_file; foreach my $f ( $template_file, "./$template_file" ) { note "processing $f with INCLUDE_PATH='.' ; RELATIVE => 1"; my $out; Template->new( { INCLUDE_PATH => ".", RELATIVE => 1 } )->process( $f, undef, \$out ); is $out => q[This is file 1], "process file $f"; } foreach my $f ( $template_file, "./$template_file" ) { note "processing $f with RELATIVE => 1"; my $out; Template->new( { RELATIVE => 1 } )->process( $f, undef, \$out ); is $out => q[This is file 1], "process file $f"; } { my $f = $template_file; note "processing $f with INCLUDE_PATH='.'"; my $out; Template->new( { INCLUDE_PATH => "." } )->process( $f, undef, \$out ); is $out => q[This is file 1], "process file $f"; } { my $f = "./$template_file"; note "processing $f with INCLUDE_PATH='.'"; my $out; Template->new( { INCLUDE_PATH => "." } )->process( $f, undef, \$out ); is $out => undef, "process file $f fails without setting RELATIVE"; } { my $out; my $f = $template_file; note "processing $f without INCLUDE_PATH set"; Template->new()->process( $f, undef, \$out ); is $out => q[This is file 1], "process file $f"; } { my $out; my $f = "./$template_file"; note "processing $f without INCLUDE_PATH set"; Template->new()->process( $f, undef, \$out ); is $out => undef, "process file $f"; } Template-Toolkit-3.102/t/lib/0000755000000000000000000000000014635373376014445 5ustar rootrootTemplate-Toolkit-3.102/t/lib/Template/0000755000000000000000000000000014635373376016220 5ustar rootrootTemplate-Toolkit-3.102/t/lib/Template/Plugin/0000755000000000000000000000000014635373376017456 5ustar rootrootTemplate-Toolkit-3.102/t/lib/Template/Plugin/ProcFoo.pm0000644000000000000000000000026513600243610021340 0ustar rootrootpackage Template::Plugin::ProcFoo; use Template::Plugin::Procedural; @ISA = qw(Template::Plugin::Procedural); sub foo { "This is procfoofoo" } sub bar { "This is procfoobar" } 1; Template-Toolkit-3.102/t/lib/Template/Plugin/Simple.pm0000644000000000000000000000052313600243610021217 0ustar rootrootpackage Template::Plugin::Simple; use base 'Template::Plugin::Filter'; sub init { my $self = shift; $self->{ _DYNAMIC } = 1; my $name = $self->{ _CONFIG }->{ name } || 'simple'; $self->install_filter($name); return $self; } sub filter { my ($self, $text, $args, $conf) = @_; return '**' . $text . '**'; } 1; Template-Toolkit-3.102/t/lib/Template/Plugin/ProcBar.pm0000644000000000000000000000025713600243610021322 0ustar rootrootpackage Template::Plugin::ProcBar; use Template::Plugin::ProcFoo; @ISA = qw(Template::Plugin::ProcFoo); sub bar { "This is procbarbar" } sub baz { "This is procbarbaz" } 1; Template-Toolkit-3.102/t/iterator.t0000644000000000000000000000725513600243610015700 0ustar rootroot#============================================================= -*-perl-*- # # t/iterator.t # # Template script testing Template::Iterator and # Template::Plugin::Iterator. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Iterator; $^W = 1; #$Template::Parser::DEBUG = 0; #$Template::Test::DEBUG = 0; my $data = [ qw( foo bar baz qux wiz woz waz ) ]; my $vars = { data => $data, # iterator => Template::Iterator->new($data), }; my $i1 = Template::Iterator->new($data); ok( $i1->get_first() eq 'foo' ); ok( $i1->get_next() eq 'bar' ); ok( $i1->get_next() eq 'baz' ); my $rest = $i1->get_all(); ok( scalar @$rest == 4 ); ok( $rest->[0] eq 'qux' ); ok( $rest->[3] eq 'waz' ); my ($val, $err) = $i1->get_next(); ok( ! $val ); ok( $err == Template::Constants::STATUS_DONE ); ($val, $err) = $i1->get_all(); ok( ! $val ); ok( $err == Template::Constants::STATUS_DONE ); ($val, $err) = $i1->get_first(); ok( $i1->get_first() eq 'foo' ); ok( $i1->get_next() eq 'bar' ); $rest = $i1->get_all(); ok( scalar @$rest == 5 ); # get_all with a few values in the iterator my $i2 = Template::Iterator->new($data); ($rest, $err) = $i2->get_all(); is( scalar @$rest, 7 ); ok( ! $err); ($val, $err) = $i2->get_all(); ok( ! $val); is( $err, Template::Constants::STATUS_DONE ); # get_all with a single value. my $i3 = Template::Iterator->new(['foo']); ($rest, $err) = $i3->get_all(); is( scalar @$rest, 1 ); is( pop @$rest, 'foo' ); ok( ! $err); ($val, $err) = $i3->get_all(); ok( ! $val); is( $err, Template::Constants::STATUS_DONE ); # get_all with an empty array my $i4 = Template::Iterator->new([]); ($val, $err) = $i4->get_all(); ok( ! $val); is( $err, Template::Constants::STATUS_DONE ); test_expect(\*DATA, { POST_CHOMP => 1 }, $vars); __DATA__ -- test -- [% items = [ 'foo' 'bar' 'baz' 'qux' ] %] [% FOREACH i = items %] * [% i +%] [% END %] -- expect -- * foo * bar * baz * qux -- test -- [% items = [ 'foo' 'bar' 'baz' 'qux' ] %] [% FOREACH i = items %] #[% loop.index %]/[% loop.max %] [% i +%] [% END %] -- expect -- #0/3 foo #1/3 bar #2/3 baz #3/3 qux -- test -- [% items = [ 'foo' 'bar' 'baz' 'qux' ] %] [% FOREACH i = items %] #[% loop.count %]/[% loop.size %] [% i +%] [% END %] -- expect -- #1/4 foo #2/4 bar #3/4 baz #4/4 qux -- test -- # test that 'number' is supported as an alias to 'count', for backwards # compatability [% items = [ 'foo' 'bar' 'baz' 'qux' ] %] [% FOREACH i = items %] #[% loop.number %]/[% loop.size %] [% i +%] [% END %] -- expect -- #1/4 foo #2/4 bar #3/4 baz #4/4 qux -- test -- [% USE iterator(data) %] [% FOREACH i = iterator %] [% IF iterator.first %] List of items: [% END %] * [% i +%] [% IF iterator.last %] End of list [% END %] [% END %] -- expect -- List of items: * foo * bar * baz * qux * wiz * woz * waz End of list -- test -- [% FOREACH i = [ 'foo' 'bar' 'baz' 'qux' ] %] [% "$loop.prev<-" IF loop.prev -%][[% i -%]][% "->$loop.next" IF loop.next +%] [% END %] -- expect -- [foo]->bar foo<-[bar]->baz bar<-[baz]->qux baz<-[qux] -- test -- -- name test even/odd/parity -- [% FOREACH item IN [1..10] -%] * [% loop.count %] [% loop.odd %] [% loop.even %] [% loop.parity +%] [% END -%] -- expect -- * 1 1 0 odd * 2 0 1 even * 3 1 0 odd * 4 0 1 even * 5 1 0 odd * 6 0 1 even * 7 1 0 odd * 8 0 1 even * 9 1 0 odd * 10 0 1 even Template-Toolkit-3.102/t/load_order_vmethods_stash.t0000644000000000000000000000030014232015000021244 0ustar rootrootuse strict; use Test::More tests => 1; require Template::VMethods; require Template::Stash; require Template; my $ok = !!eval { Template->new({}); 1 }; my $err = $@; ok($ok) or diag $err; Template-Toolkit-3.102/t/provider.t0000644000000000000000000002612014232015000015661 0ustar rootroot#============================================================= -*-perl-*- # # t/provider.t # # Test the Template::Provider module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Config; use Template::Provider; use Cwd 'abs_path'; $^W = 1; my $DEBUG = grep(/-d/, @ARGV); $Template::Test::DEBUG = 0; use Template::Constants qw( :debug ); $Template::Provider::DEBUG = $DEBUG ? DEBUG_PROVIDER | DEBUG_CALLER : 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; # uncommenting the next line should cause test 43 to fail because # the provider doesn't stat the file. # $Template::Provider::STAT_TTL = 10; my $factory = 'Template::Config'; # script may be being run in distribution root or 't' directory my $dir = -d 't' ? 't/test/src' : 'test/src'; my $lib = -d 't' ? 't/test/lib' : 'test/lib'; my $file = 'foo'; my $relfile = "./$dir/$file"; my $absfile = abs_path($dir) . '/' . $file; my $newfile = "$dir/foobar"; my $vars = { file => $file, relfile => $relfile, absfile => $absfile, fixfile => \&update_file, }; #------------------------------------------------------------------------ # This is used to test that source files are automatically reloaded # when updated on disk. we call it first to write a template file, # which is then included in one of the -- test -- sections below. # Then we call update_file() (via the 'fixfile' variable) and # include it again to see if the new file contents were loaded. #------------------------------------------------------------------------ sub update_file { local *FP; sleep(2); # ensure file time stamps are different open(FP, ">", $newfile) || die "$newfile: $!\n"; print(FP @_) || die "failed to write $newfile: $!\n"; close(FP); } update_file('This is the old content'); #------------------------------------------------------------------------ # instantiate a bunch of providers, using various different techniques, # with different load options but sharing the same parser; then set them # to work fetching some files and check they respond as expected #------------------------------------------------------------------------ my $parser = $factory->parser(POST_CHOMP => 1) || die $factory->error(); ok( $parser ); my $provinc = $factory->provider( INCLUDE_PATH => $dir, PARSER => $parser, TOLERANT => 1 ) || die $factory->error(); ok( $provinc ); my $provabs = $factory->provider({ ABSOLUTE => 1, PARSER => $parser, }) || die $factory->error(); ok( $provabs ); my $provrel = Template::Provider->new({ RELATIVE => 1, PARSER => $parser, }) || die $Template::Provider::ERROR; ok( $provrel ); ok( $provinc->{ PARSER } == $provabs->{ PARSER } ); ok( $provabs->{ PARSER } == $provrel->{ PARSER } ); banner('matrix'); ok( delivered( $provinc, $file ) ); ok( declined( $provinc, $absfile ) ); ok( declined( $provinc, $relfile ) ); ok( declined( $provabs, $file ) ); ok( delivered( $provabs, $absfile ) ); ok( denied( $provabs, $relfile ) ); ok( declined( $provrel, $file ) ); ok( denied( $provrel, $absfile ) ); ok( delivered( $provrel, $relfile ) ); sub delivered { my ($provider, $file) = @_; my ($result, $error) = $provider->fetch($file); my $nice_result = defined $result ? $result : ''; my $nice_error = defined $error ? $error : ''; # print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n" # if $DEBUG; return ! $error; } sub declined { my ($provider, $file) = @_; my ($result, $error) = $provider->fetch($file); my $nice_result = defined $result ? $result : ''; my $nice_error = defined $error ? $error : ''; # print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n" # if $DEBUG; return ($error == Template::Constants::STATUS_DECLINED); } sub denied { my ($provider, $file) = @_; my ($result, $error) = $provider->fetch($file); # print STDERR "$provider->fetch($file) -> [$result] [$error]\n" # if $DEBUG; return ($error == Template::Constants::STATUS_ERROR); } #------------------------------------------------------------------------ # Test if can fetch from a file handle #------------------------------------------------------------------------ my $ttglob = Template->new || die "$Template::ERROR\n"; ok( $ttglob, 'Created template for glob test' ); # Make sure we have a multi-line template file so $/ is tested. my $glob_file = abs_path($dir) . '/baz'; open GLOBFILE, '<', $glob_file or die "Failed to open '$absfile': $!"; my $outstr = ''; $ttglob->process( \*GLOBFILE, { a => 'globtest' }, \$outstr ) || die $ttglob->error; close GLOBFILE; my $glob_expect = "This is the baz file, a: globtest\n"; my $ok = $glob_expect eq $outstr; ok( $ok, $ok ? 'Fetch template from file handle' : <new( LOAD_TEMPLATES => [ $provinc ] ) || die "$Template::ERROR\n"; ok( $ttinc ); my $ttabs = Template->new( LOAD_TEMPLATES => [ $provabs ] ) || die "$Template::ERROR\n"; ok( $ttabs ); my $ttrel = Template->new( LOAD_TEMPLATES => [ $provrel ] ) || die "$Template::ERROR\n"; ok( $ttrel ); #------------------------------------------------------------------------ # here's a test of the dynamic path capability. we'll define a handler # sub and an object to return a dynamic list of paths #------------------------------------------------------------------------ package My::DPaths; sub new { my ($class, @paths) = @_; bless \@paths, $class; } sub paths { my $self = shift; return [ @$self ]; } package main; sub dpaths { return [ "$lib/one", "$lib/two" ], } # this one is designed to test the $MAX_DIRS runaway limit $Template::Provider::MAX_DIRS = 42; sub badpaths { return [ \&badpaths ], } my $dpaths = My::DPaths->new("$lib/two", "$lib/one"); my $ttd1 = Template->new({ INCLUDE_PATH => [ \&dpaths, $dir ], PARSER => $parser, }) || die "$Template::ERROR\n"; ok( $ttd1, 'dynamic path (sub) template object created' ); my $ttd2 = Template->new({ INCLUDE_PATH => [ $dpaths, $dir ], PARSER => $parser, }) || die "$Template::ERROR\n"; ok( $ttd1, 'dynamic path (obj) template object created' ); my $ttd3 = Template->new({ INCLUDE_PATH => [ \&badpaths ], PARSER => $parser, }) || die "$Template::ERROR\n"; ok( $ttd3, 'dynamic path (bad) template object created' ); my $uselist = [ ttinc => $ttinc, ttabs => $ttabs, ttrel => $ttrel, ttd1 => $ttd1, ttd2 => $ttd2, ttdbad => $ttd3 ]; test_expect(\*DATA, $uselist, $vars); __DATA__ -- test -- -- use ttinc -- [% TRY %] [% INCLUDE foo %] [% INCLUDE $relfile %] [% CATCH file %] Error: [% error.type %] - [% error.info.split(': ').1 %] [% END %] -- expect -- This is the foo file, a is Error: file - not found -- test -- [% TRY %] [% INCLUDE foo %] [% INCLUDE $absfile %] [% CATCH file %] Error: [% error.type %] - [% error.info.split(': ').1 %] [% END %] -- expect -- This is the foo file, a is Error: file - not found -- test -- [% TRY %] [% INSERT foo +%] [% INSERT $absfile %] [% CATCH file %] Error: [% error %] [% END %] -- expect -- -- process -- [% TAGS [* *] %] This is the foo file, a is [% a -%] Error: file error - [* absfile *]: not found #------------------------------------------------------------------------ -- test -- -- use ttrel -- [% TRY %] [% INCLUDE $relfile %] [% INCLUDE foo %] [% CATCH file -%] Error: [% error.type %] - [% error.info %] [% END %] -- expect -- This is the foo file, a is Error: file - foo: not found -- test -- [% TRY %] [% INCLUDE $relfile -%] [% INCLUDE $absfile %] [% CATCH file %] Error: [% error.type %] - [% error.info.split(': ').1 %] [% END %] -- expect -- This is the foo file, a is Error: file - absolute paths are not allowed (set ABSOLUTE option) -- test -- foo: [% TRY; INSERT foo; CATCH; "$error\n"; END %] rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END +%] abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %] -- expect -- -- process -- [% TAGS [* *] %] foo: file error - foo: not found rel: This is the foo file, a is [% a -%] abs: file error - [* absfile *]: absolute paths are not allowed (set ABSOLUTE option) #------------------------------------------------------------------------ -- test -- -- use ttabs -- [% TRY %] [% INCLUDE $absfile %] [% INCLUDE foo %] [% CATCH file %] Error: [% error.type %] - [% error.info %] [% END %] -- expect -- This is the foo file, a is Error: file - foo: not found -- test -- [% TRY %] [% INCLUDE $absfile %] [% INCLUDE $relfile %] [% CATCH file %] Error: [% error.type %] - [% error.info.split(': ').1 %] [% END %] -- expect -- This is the foo file, a is Error: file - relative paths are not allowed (set RELATIVE option) -- test -- foo: [% TRY; INSERT foo; CATCH; "$error\n"; END %] rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END %] abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %] -- expect -- -- process -- [% TAGS [* *] %] foo: file error - foo: not found rel: file error - [* relfile *]: relative paths are not allowed (set RELATIVE option) abs: This is the foo file, a is [% a -%] #------------------------------------------------------------------------ # test that files updated on disk are automatically reloaded. #------------------------------------------------------------------------ -- test -- -- use ttinc -- [% INCLUDE foobar %] -- expect -- This is the old content -- test -- [% CALL fixfile('This is the new content') %] [% INCLUDE foobar %] -- expect -- This is the new content #------------------------------------------------------------------------ # dynamic path tests #------------------------------------------------------------------------ -- test -- -- use ttd1 -- foo: [% PROCESS foo | trim +%] bar: [% PROCESS bar | trim +%] baz: [% PROCESS baz a='alpha' | trim %] -- expect -- foo: This is one/foo bar: This is two/bar baz: This is the baz file, a: alpha -- test -- foo: [% INSERT foo | trim +%] bar: [% INSERT bar | trim +%] -- expect -- foo: This is one/foo bar: This is two/bar -- test -- -- use ttd2 -- foo: [% PROCESS foo | trim +%] bar: [% PROCESS bar | trim +%] baz: [% PROCESS baz a='alpha' | trim %] -- expect -- foo: This is two/foo bar: This is two/bar baz: This is the baz file, a: alpha -- test -- foo: [% INSERT foo | trim +%] bar: [% INSERT bar | trim +%] -- expect -- foo: This is two/foo bar: This is two/bar -- test -- -- use ttdbad -- [% TRY; INCLUDE foo; CATCH; e; END %] -- expect -- file error - INCLUDE_PATH exceeds 42 directories Template-Toolkit-3.102/t/capture.t0000644000000000000000000000314013600243610015477 0ustar rootroot#============================================================= -*-perl-*- # # t/capture.t # # Test that the output from a directive block can be assigned to a # variable. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; my $config = { POST_CHOMP => 1, }; my $replace = { a => 'alpha', b => 'bravo', }; test_expect(\*DATA, $config, $replace); __DATA__ -- test -- [% BLOCK foo %] This is block foo, a is [% a %] [% END %] [% b = INCLUDE foo %] [% c = INCLUDE foo a = 'ammended' %] b: <[% b %]> c: <[% c %]> -- expect -- b: c: -- test -- [% d = BLOCK %] This is the block, a is [% a %] [% END %] [% a = 'charlie' %] a: [% a %] d: [% d %] -- expect -- a: charlie d: This is the block, a is alpha -- test -- [% e = IF a == 'alpha' %] a is [% a %] [% ELSE %] that was unexpected [% END %] e: [% e %] -- expect -- e: a is alpha -- test -- [% a = FOREACH b = [1 2 3] %] [% b %], [%- END %] a is [% a %] -- expect -- a is 1,2,3, -- test -- [% BLOCK userinfo %] name: [% user +%] [% END %] [% out = PROCESS userinfo FOREACH user = [ 'tom', 'dick', 'larry' ] %] Output: [% out %] -- expect -- Output: name: tom name: dick name: larry Template-Toolkit-3.102/t/include.t0000644000000000000000000001405513600243610015466 0ustar rootroot#============================================================= -*-perl-*- # # t/include.t # # Template script testing the INCLUDE and PROCESS directives. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Constants qw( :status ); use Template; use Template::Test; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Context::DEBUG = 0; # sample data my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z) = qw( alpha bravo charlie delta echo foxtrot golf hotel india juliet kilo lima mike november oscar papa quebec romeo sierra tango umbrella victor whisky x-ray yankee zulu ); my $replace = { 'a' => $a, 'b' => $b, 'c' => { 'd' => $d, 'e' => $e, 'f' => { 'g' => $g, 'h' => $h, }, }, 'r' => $r, 's' => $s, 't' => $t, }; # script may be being run in distribution root or 't' directory my $dir = -d 't' ? 't/test' : 'test'; my $tproc = Template->new({ INTERPOLATE => 1, INCLUDE_PATH => "$dir/src:$dir/lib", TRIM => 1, AUTO_RESET => 0, DEFAULT => 'default', }); my $incpath = [ "$dir/src", '/nowhere' ]; my $tt_reset = Template->new({ INTERPOLATE => 1, INCLUDE_PATH => $incpath, TRIM => 1, RECURSION => 1, DEFAULT => 'bad_default', }); $incpath->[1] = "$dir/lib"; # we want to process 'metadata' directly so that the correct top-level # 'template' reference is set instead of 'input text' my $output; $tproc->process('metadata', $replace, \$output); $replace->{ metaout } = $output; $replace->{ metamod } = (stat("$dir/src/metadata"))[9]; test_expect(\*DATA, [ default => $tproc, reset => $tt_reset ], $replace); __DATA__ -- test -- [% a %] [% PROCESS incblock -%] [% b %] [% INCLUDE first_block %] -- expect -- alpha bravo this is my first block, a is set to 'alpha' -- test -- [% INCLUDE first_block %] -- expect -- this is my first block, a is set to 'alpha' -- test -- [% INCLUDE first_block a = 'abstract' %] [% a %] -- expect -- this is my first block, a is set to 'abstract' alpha -- test -- [% INCLUDE 'first_block' a = t %] [% a %] -- expect -- this is my first block, a is set to 'tango' alpha -- test -- [% INCLUDE 'second_block' %] -- expect -- this is my second block, a is initially set to 'alpha' and then set to 'sierra' b is bravo m is 98 -- test -- [% INCLUDE second_block a = r, b = c.f.g, m = 97 %] [% a %] -- expect -- this is my second block, a is initially set to 'romeo' and then set to 'sierra' b is golf m is 97 alpha -- test -- FOO: [% INCLUDE foo +%] FOO: [% INCLUDE foo a = b -%] -- expect -- FOO: This is the foo file, a is alpha FOO: This is the foo file, a is bravo -- test -- GOLF: [% INCLUDE $c.f.g %] GOLF: [% INCLUDE $c.f.g g = c.f.h %] [% DEFAULT g = "a new $c.f.g" -%] [% g %] -- expect -- GOLF: This is the golf file, g is golf GOLF: This is the golf file, g is hotel a new golf -- test -- BAZ: [% INCLUDE bar/baz %] BAZ: [% INCLUDE bar/baz word='wizzle' %] BAZ: [% INCLUDE "bar/baz" %] -- expect -- BAZ: This is file baz The word is 'qux' BAZ: This is file baz The word is 'wizzle' BAZ: This is file baz The word is 'qux' -- test -- BAZ: [% INCLUDE bar/baz.txt %] BAZ: [% INCLUDE bar/baz.txt time = 'nigh' %] -- expect -- BAZ: This is file baz The word is 'qux' The time is now BAZ: This is file baz The word is 'qux' The time is nigh -- test -- [% BLOCK bamboozle -%] This is bamboozle [%- END -%] Block defined... [% blockname = 'bamboozle' -%] [% INCLUDE $blockname %] End -- expect -- Block defined... This is bamboozle End # test that BLOCK definitions get AUTO_RESET (i.e. cleared) by default -- test -- -- use reset -- [% a %] [% PROCESS incblock -%] [% INCLUDE first_block %] [% INCLUDE second_block %] [% b %] -- expect -- alpha this is my first block, a is set to 'alpha' this is my second block, a is initially set to 'alpha' and then set to 'sierra' b is bravo m is 98 bravo -- test -- [% TRY %] [% INCLUDE first_block %] [% CATCH file %] ERROR: [% error.info %] [% END %] -- expect -- ERROR: first_block: not found -- test -- -- use default -- [% metaout %] -- expect -- -- process -- TITLE: The cat sat on the mat metadata last modified [% metamod %] -- test -- [% TRY %] [% PROCESS recurse counter = 1 %] [% CATCH file -%] [% error.info %] [% END %] -- expect -- recursion count: 1 recursion into 'my file' -- test -- [% INCLUDE nosuchfile %] -- expect -- This is the default file -- test -- -- use reset -- [% TRY %] [% PROCESS recurse counter = 1 %] [% CATCH file %] [% error.info %] [% END %] -- expect -- recursion count: 1 recursion count: 2 recursion count: 3 -- test -- [% TRY; INCLUDE nosuchfile; CATCH; "ERROR: $error"; END %] -- expect -- ERROR: file error - nosuchfile: not found -- test -- [% INCLUDE src:foo %] [% BLOCK src:foo; "This is foo!"; END %] -- expect -- This is foo! -- test -- [% a = ''; b = ''; d = ''; e = 0 %] [% INCLUDE foo name = a or b or 'c' item = d or e or 'f' -%] [% BLOCK foo; "name: $name item: $item\n"; END %] -- expect -- name: c item: f -- test -- [% style = 'light'; your_title="Hello World" -%] [% INCLUDE foo title = my_title or your_title or default_title bgcol = (style == 'dark' ? '#000000' : '#ffffff') %] [% BLOCK foo; "title: $title\nbgcol: $bgcol\n"; END %] -- expect -- title: Hello World bgcol: #ffffff -- test -- [% myhash = { name = 'Tom' item = 'teacup' } -%] [% INCLUDE myblock name = 'Fred' item = 'fish' %] [% INCLUDE myblock import=myhash %] import([% import %]) [% PROCESS myblock import={ name = 'Tim', item = 'teapot' } %] import([% import %]) [% BLOCK myblock %][% name %] has a [% item %][% END %] -- expect -- Fred has a fish Tom has a teacup import() Tim has a teapot import() -- test -- Template-Toolkit-3.102/t/case.t0000644000000000000000000000273113600243610014754 0ustar rootroot#============================================================= -*-perl-*- # # t/case.t # # Test the CASE sensitivity option. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; ok(1); my $ttdef = Template->new({ POST_CHOMP => 1, }); my $ttanycase = Template->new({ ANYCASE => 1, POST_CHOMP => 1, }); my $tts = [ default => $ttdef, anycase => $ttanycase ]; test_expect(\*DATA, $tts, callsign()); __DATA__ -- test -- [% include = a %] [% for = b %] i([% include %]) f([% for %]) -- expect -- i(alpha) f(bravo) -- test -- [% IF a AND b %] good [% ELSE %] bad [% END %] -- expect -- good -- test -- # 'and', 'or' and 'not' can ALWAYS be expressed in lower case, regardless # of CASE sensitivity option. [% IF a and b %] good [% ELSE %] bad [% END %] -- expect -- good -- test -- [% include = a %] [% include %] -- expect -- alpha -- test -- -- use anycase -- [% include foo bar='baz' %] [% BLOCK foo %]this is foo, bar = [% bar %][% END %] -- expect -- this is foo, bar = baz -- test -- [% 10 div 3 %] [% 10 DIV 3 +%] [% 10 mod 3 %] [% 10 MOD 3 %] -- expect -- 3 3 1 1 Template-Toolkit-3.102/t/meta.t0000644000000000000000000000156114635371175015010 0ustar rootroot#============================================================= -*-perl-*- # # t/meta.t # # Test the meta() method in Template::Document. # # Written by Andy Wardley # # Copyright (C) 2022 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; $^W = 1; my $tt = Template->new || die Template->error; my $template = $tt->template(\*DATA); my $meta = $template->meta; is( $meta->{ author }, 'Andy Wardley', 'fetched META author' ); is( $meta->{ animal }, 'Badger', 'fetched META animal' ); is( scalar(keys %$meta), 2, 'two items in meta' ); __END__ [% META author = 'Andy Wardley' animal = 'Badger' %] Hello world!Template-Toolkit-3.102/t/list.t0000644000000000000000000001064113600243610015013 0ustar rootroot#============================================================= -*-perl-*- # # t/list.t # # Tests list references as variables, including pseudo-methods such # as first(), last(), etc. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Constants qw( :status ); $^W = 1; use Template::Parser; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; # sample data my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z) = qw( alpha bravo charlie delta echo foxtrot golf hotel india juliet kilo lima mike november oscar papa quebec romeo sierra tango umbrella victor whisky x-ray yankee zulu ); my $data = [ $r, $j, $s, $t, $y, $e, $f, $z ]; my $vars = { 'a' => $a, 'b' => $b, 'c' => $c, 'd' => $d, 'e' => $e, data => $data, days => [ qw( Mon Tue Wed Thu Fri Sat Sun ) ], wxyz => [ { id => $z, name => 'Zebedee', rank => 'aa' }, { id => $y, name => 'Yinyang', rank => 'ba' }, { id => $x, name => 'Xeexeez', rank => 'ab' }, { id => $w, name => 'Warlock', rank => 'bb' }, ], inst => [ { name => 'piano', url => '/roses.html' }, { name => 'flute', url => '/blow.html' }, { name => 'organ', url => '/tulips.html' }, ], nest => [ [ 3, 1, 4 ], [ 2, [ 7, 1, 8 ] ] ], }; my $config = {}; test_expect(\*DATA, $config, $vars); __DATA__ #------------------------------------------------------------------------ # GET #------------------------------------------------------------------------ -- test -- [% data.0 %] and [% data.1 %] -- expect -- romeo and juliet -- test -- [% data.first %] - [% data.last %] -- expect -- romeo - zulu -- test -- [% data.size %] [% data.max %] -- expect -- 8 7 -- test -- [% data.join(', ') %] -- expect -- romeo, juliet, sierra, tango, yankee, echo, foxtrot, zulu -- test -- [% data.reverse.join(', ') %] -- expect -- zulu, foxtrot, echo, yankee, tango, sierra, juliet, romeo -- test -- [% data.sort.reverse.join(' - ') %] -- expect -- zulu - yankee - tango - sierra - romeo - juliet - foxtrot - echo -- test -- [% FOREACH item = wxyz.sort('id') -%] * [% item.name %] [% END %] -- expect -- * Warlock * Xeexeez * Yinyang * Zebedee -- test -- [% FOREACH item = wxyz.sort('rank') -%] * [% item.name %] [% END %] -- expect -- * Zebedee * Xeexeez * Yinyang * Warlock -- test -- [% FOREACH n = [0..6] -%] [% days.$n +%] [% END -%] -- expect -- Mon Tue Wed Thu Fri Sat Sun -- test -- [% data = [ 'one', 'two', data.first ] -%] [% data.join(', ') %] -- expect -- one, two, romeo -- test -- [% data = [ 90, 8, 70, 6, 1, 11, 10, 2, 5, 50, 52 ] -%] sort: [% data.sort.join(', ') %] nsort: [% data.nsort.join(', ') %] -- expect -- sort: 1, 10, 11, 2, 5, 50, 52, 6, 70, 8, 90 nsort: 1, 2, 5, 6, 8, 10, 11, 50, 52, 70, 90 -- test -- [% ilist = [] -%] [% ilist.push("$i.name") FOREACH i = inst -%] [% ilist.join(",\n") -%] [% global.ilist = ilist -%] -- expect -- piano, flute, organ -- test -- [% global.ilist.pop %] -- expect -- organ -- test -- [% global.ilist.shift %] -- expect -- piano -- test -- [% global.ilist.unshift('another') -%] [% global.ilist.join(', ') %] -- expect -- another, flute -- test -- [% nest.0.0 %].[% nest.0.1 %][% nest.0.2 +%] [% nest.1.shift %].[% nest.1.0.join('') %] -- expect -- 3.14 2.718 -- test -- [% # define some initial data people => [ { id => 'tom', name => 'Tom' }, { id => 'dick', name => 'Richard' }, { id => 'larry', name => 'Larry' }, ] -%] [% folk = [] -%] [% folk.push("$person.name") FOREACH person = people.sort('name') -%] [% folk.join(",\n") -%] -- expect -- Larry, Richard, Tom -- test -- [% data.grep('r').join(', ') %] -- expect -- romeo, sierra, foxtrot -- test -- [% data.grep('^r').join(', ') %] -- expect -- romeo Template-Toolkit-3.102/t/scalar.t0000644000000000000000000000510113600243610015300 0ustar rootroot#============================================================= -*-perl-*- # # t/scalar.t # # Test the Scalar plugin which allows object methods to be called in # scalar context. # # Written by Andy Wardley # # Copyright (C) 1996-2008 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ); use Template::Test; #------------------------------------------------------------------------ # definition of test object class #------------------------------------------------------------------------ package Template::Test::HashObject; sub new { bless {}, shift; } sub bar { return wantarray ? qw( hash object method called in array context ) : 'hash object method called in scalar context'; } package Template::Test::ListObject; sub new { bless [], shift; } sub bar { return wantarray ? qw( list object method called in array context ) : 'list object method called in scalar context'; } #----------------------------------------------------------------------- # main #----------------------------------------------------------------------- package main; my $vars = { hashobj => Template::Test::HashObject->new, listobj => Template::Test::ListObject->new, subref => sub { return wantarray ? (qw( subroutine called in array context ), @_) : 'subroutine called in scalar context ' . join(' ', @_); } }; test_expect(\*DATA, undef, $vars); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- [% hashobj.bar.join %] -- expect -- hash object method called in array context -- test -- [% USE scalar -%] [% hashobj.scalar.bar %] -- expect -- hash object method called in scalar context -- test -- [% listobj.bar.join %] -- expect -- list object method called in array context -- test -- [% USE scalar -%] [% listobj.scalar.bar %] -- expect -- list object method called in scalar context -- test -- [% hash = { a = 10 }; TRY; hash.scalar.a; CATCH; error; END; %] -- expect -- scalar error - invalid object method: a -- test -- [% subref(10, 20).join %] -- expect -- subroutine called in array context 10 20 -- test -- [% USE scalar; scalar.subref(30, 40) %] -- expect -- subroutine called in scalar context 30 40 Template-Toolkit-3.102/t/prefix.t0000644000000000000000000000273013600243610015335 0ustar rootroot#============================================================= -*-perl-*- # # t/prefix.t # # Test template prefixes within INCLUDE, etc., directives. # # Written by Andy Wardley # # Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; use Template::Config; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Context::DEBUG = 0; # script may be being run in distribution root or 't' directory my $dir = -d 't' ? 't/test' : 'test'; my $src_prov = Template::Config->provider( INCLUDE_PATH => "$dir/src" ); my $lib_prov = Template::Config->provider( INCLUDE_PATH => "$dir/lib" ); my $config = { LOAD_TEMPLATES => [ $src_prov, $lib_prov ], PREFIX_MAP => { src => '0', lib => '1', all => '0, 1', }, }; test_expect(\*DATA, $config); __DATA__ -- test -- [% INCLUDE foo a=10 %] -- expect -- This is the foo file, a is 10 -- test -- [% INCLUDE src:foo a=20 %] -- expect -- This is the foo file, a is 20 -- test -- [% INCLUDE all:foo a=30 %] -- expect -- This is the foo file, a is 30 -- test -- [% TRY; INCLUDE lib:foo a=30 ; CATCH; error; END %] -- expect -- file error - lib:foo: not found -- test -- [% INSERT src:foo %] -- expect -- This is the foo file, a is [% a -%] Template-Toolkit-3.102/t/macro.t0000644000000000000000000000567413600243610015153 0ustar rootroot#============================================================= -*-perl-*- # # t/macro.t # # Template script testing the MACRO directives. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Test; $^W = 1; my $config = { INCLUDE_PATH => -d 't' ? 't/test/src' : 'test/src', EVAL_PERL => 1, TRIM => 1, }; test_expect(\*DATA, $config, &callsign); __DATA__ -- test -- [% MACRO foo INCLUDE foo -%] foo: [% foo %] foo(b): [% foo(a = b) %] -- expect -- foo: This is the foo file, a is alpha foo(b): This is the foo file, a is bravo -- test -- foo: [% foo %]. -- expect -- foo: . -- test -- [% MACRO foo(a) INCLUDE foo -%] foo: [% foo %] foo(c): [% foo(c) %] -- expect -- foo: This is the foo file, a is foo(c): This is the foo file, a is charlie -- test -- [% BLOCK mypage %] Header [% content %] Footer [% END %] [%- MACRO content BLOCK -%] This is a macro which encapsulates a template block. a: [% a -%] [% END -%] begin [% INCLUDE mypage %] mid [% INCLUDE mypage a = 'New Alpha' %] end -- expect -- begin Header This is a macro which encapsulates a template block. a: alpha Footer mid Header This is a macro which encapsulates a template block. a: New Alpha Footer end -- test -- [% BLOCK table %]
[% rows %]
[% END -%] [% # define some dummy data udata = [ { id => 'foo', name => 'Fubar' }, { id => 'bar', name => 'Babar' } ] -%] [% # define a macro to print each row of user data MACRO user_summary INCLUDE user_row FOREACH user = udata %] [% # here's the block for each row BLOCK user_row %] [% user.id %] [% user.name %] [% END -%] [% # now we can call the main table template, and alias our macro to 'rows' INCLUDE table rows = user_summary %] -- expect --
foo Fubar
bar Babar
-- test -- [% MACRO one BLOCK -%] one: [% title %] [% END -%] [% saveone = one %] [% MACRO two BLOCK; title="2[$title]" -%] two: [% title %] -> [% saveone %] [% END -%] [% two(title="The Title") %] -- expect -- two: 2[The Title] -> one: -- test -- [% MACRO one BLOCK -%] one: [% title %] [% END -%] [% saveone = \one %] [% MACRO two BLOCK; title="2[$title]" -%] two: [% title %] -> [% saveone %] [% END -%] [% two(title="The Title") %] -- expect -- two: 2[The Title] -> one: 2[The Title] -- test -- -- name number macro -- [% MACRO number(n) GET n.chunk(-3).join(',') -%] [% number(1234567) %] -- expect -- 1,234,567 -- test -- -- name perl macro -- [% MACRO triple(n) PERL %] my $n = $stash->get('n'); print $n * 3; [% END -%] [% triple(10) %] -- expect -- 30 Template-Toolkit-3.102/t/factory.t0000644000000000000000000000263613600243610015514 0ustar rootroot#============================================================= -*-perl-*- # # t/factory.t # # Test use of a modified directive factory, based on something that # pudge suggested on #perl. # # Written by Andy Wardley # # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; # uncomment these lines to see how generate Perl code # for constant.* is expanded at parse time #Template::Parser::DEBUG = 1; #Template::Directive::PRETTY = 1; package My::Directive; use base qw( Template::Directive ); my $constants = { pi => 3.14, e => 2.718, }; sub ident { my ($class, $ident) = @_; # note single quoting of 'constant' if (ref $ident eq 'ARRAY' && $ident->[0] eq "'constant'") { my $key = $ident->[2]; $key =~ s/'//g; return $constants->{ $key } || ''; } return $class->SUPER::ident($ident); } package main; my $cfg = { FACTORY => 'My::Directive', }; my $vars = { foo => { bar => 'Place to purchase drinks', baz => 'Short form of "Basil"', }, }; test_expect(\*DATA, $cfg, $vars); __DATA__ -- test -- [% foo.bar %] -- expect -- Place to purchase drinks -- test -- [% constant.pi %] -- expect -- 3.14 Template-Toolkit-3.102/t/evalperl.t0000644000000000000000000000735613600243610015663 0ustar rootroot#============================================================= -*-perl-*- # # t/evalperl.t # # Test the evaluation of PERL and RAWPERL blocks. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; #$Template::Context::DEBUG = 0; my $tt_no_perl = Template->new({ INTERPOLATE => 1, POST_CHOMP => 1, EVAL_PERL => 0, INCLUDE_PATH => -d 't' ? 't/test/lib' : 'test/lib', }); my $tt_do_perl = Template->new({ INTERPOLATE => 1, POST_CHOMP => 1, EVAL_PERL => 1, INCLUDE_PATH => -d 't' ? 't/test/lib' : 'test/lib', }); my $ttprocs = [ no_perl => $tt_no_perl, do_perl => $tt_do_perl, ]; test_expect(\*DATA, $ttprocs, &callsign); __DATA__ -- test -- [% META author = 'Andy Wardley' title = 'Test Template $foo #6' version = 1.23 %] [% TRY %] [% PERL %] my $output = "author: [% template.author %]\n"; $stash->set('a', 'The cat sat on the mat'); $output .= "more perl generated output\n"; print $output; [% END %] [% CATCH %] Not allowed: [% error +%] [% END %] a: [% a +%] a: $a [% TRY %] [% RAWPERL %] $output .= "The cat sat on the mouse mat\n"; $stash->set('b', 'The cat sat where?'); [% END %] [% CATCH %] Still not allowed: [% error +%] [% END %] b: [% b +%] b: $b -- expect -- Not allowed: perl error - EVAL_PERL not set a: alpha a: alpha Still not allowed: perl error - EVAL_PERL not set b: bravo b: bravo -- test -- [% TRY %] nothing [% PERL %] We don't care about correct syntax within PERL blocks if EVAL_PERL isn't set. They're simply ignored. [% END %] [% CATCH %] ERROR: [% error.type %]: [% error.info %] [% END %] -- expect -- nothing ERROR: perl: EVAL_PERL not set -- test -- some stuff [% TRY %] [% INCLUDE badrawperl %] [% CATCH %] ERROR: [[% error.type %]] [% error.info %] [% END %] -- expect -- some stuff This is some text ERROR: [perl] EVAL_PERL not set -- test -- -- use do_perl -- some stuff [% TRY %] [% INCLUDE badrawperl %] [% CATCH +%] ERROR: [[% error.type %]] [% END %] -- expect -- some stuff This is some text more stuff goes here ERROR: [undef] -- test -- -- use do_perl -- [% META author = 'Andy Wardley' %] [% PERL %] my $output = "author: [% template.author %]\n"; $stash->set('a', 'The cat sat on the mat'); $output .= "more perl generated output\n"; print $output; [% END %] -- expect -- author: Andy Wardley more perl generated output -- test -- -- use do_perl -- [% META author = 'Andy Wardley' title = 'Test Template $foo #6' version = 3.14 %] [% PERL %] my $output = "author: [% template.author %]\n"; $stash->set('a', 'The cat sat on the mat'); $output .= "more perl generated output\n"; print $output; [% END %] a: [% a +%] a: $a [% RAWPERL %] $output .= "The cat sat on the mouse mat\n"; $stash->set('b', 'The cat sat where?'); [% END %] b: [% b +%] b: $b -- expect -- author: Andy Wardley more perl generated output a: The cat sat on the mat a: The cat sat on the mat The cat sat on the mouse mat b: The cat sat where? b: The cat sat where? -- test -- [% BLOCK foo %]This is block foo[% END %] [% PERL %] print $context->include('foo'); print PERLOUT "\nbar\n"; [% END %] The end -- expect -- This is block foo bar The end -- test -- [% TRY %] [%- PERL %] die "nothing to live for\n" [% END %] [% CATCH %] error: [% error %] [% END %] -- expect -- error: undef error - nothing to live for Template-Toolkit-3.102/t/tags.t0000644000000000000000000000720114232015000014764 0ustar rootroot#============================================================= -*-perl-*- # # t/tags.t # # Template script testing TAGS parse-time directive to switch the # tokens that mark start and end of directive tags. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ./blib/lib ./blib/arch ); use Template::Test; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; $^W = 1; $Template::Test::DEBUG = 0; my $params = { 'a' => 'alpha', 'b' => 'bravo', 'c' => 'charlie', 'd' => 'delta', 'e' => 'echo', tags => 'my tags', flags => 'my flags', }; my $tt = [ basic => Template->new(INTERPOLATE => 1), htags => Template->new(TAG_STYLE => 'html'), stags => Template->new(START_TAG => '\[\*', END_TAG => '\*\]'), ]; test_expect(\*DATA, $tt, $params); __DATA__ [%a%] [% a %] [% a %] -- expect -- alpha alpha alpha -- test -- Redefining tags [% TAGS (+ +) %] [% a %] [% b %] (+ c +) -- expect -- Redefining tags [% a %] [% b %] charlie -- test -- [% a %] [% TAGS (+ +) %] [% a %] %% b %% (+ c +) (+ TAGS <* *> +) (+ d +) <* e *> -- expect -- alpha [% a %] %% b %% charlie (+ d +) echo -- test -- [% TAGS default -%] [% a %] %% b %% (+ c +) -- expect -- alpha %% b %% (+ c +) -- test -- # same as 'default' [% TAGS template -%] [% a %] %% b %% (+ c +) -- expect -- alpha %% b %% (+ c +) -- test -- [% TAGS metatext -%] [% a %] %% b %% <* c *> -- expect -- [% a %] bravo <* c *> -- test -- [% TAGS template1 -%] [% a %] %% b %% (+ c +) -- expect -- alpha bravo (+ c +) -- test -- [% TAGS html -%] [% a %] %% b %% -- expect -- [% a %] %% b %% charlie -- test -- [% TAGS asp -%] [% a %] %% b %% <% d %> -- expect -- [% a %] %% b %% delta -- test -- [% TAGS php -%] [% a %] %% b %% <% d %> -- expect -- [% a %] %% b %% <% d %> echo #------------------------------------------------------------------------ # test processor with pre-defined TAG_STYLE #------------------------------------------------------------------------ -- test -- -- use htags -- [% TAGS ignored -%] [% a %] more stuff -- expect -- [% TAGS ignored -%] [% a %] charlie more stuff #------------------------------------------------------------------------ # test processor with pre-defined START_TAG and END_TAG #------------------------------------------------------------------------ -- test -- -- use stags -- [% TAGS ignored -%] [* a *] blah [* b *] blah -- expect -- [% TAGS ignored -%] alpha blah bravo blah #------------------------------------------------------------------------ # XML style tags #------------------------------------------------------------------------ -- test -- -- use basic -- [% TAGS -%] a: -- expect -- a: 10 1 3 5 7 -- test -- [% TAGS star -%] [* a = 10 -*] a is [* a *] -- expect -- a is 10 -- test -- [% tags; flags %] [* a = 10 -*] a is [* a *] -- expect -- my tagsmy flags [* a = 10 -*] a is [* a *] -- test -- flags: [% flags | html %] tags: [% tags | html %] -- expect -- flags: my flags tags: my tags Template-Toolkit-3.102/t/tiedhash.t0000644000000000000000000001244314232015000015623 0ustar rootroot#============================================================= -*-perl-*- # # t/tiedhash.t # # Template script testing variable via a tied hash. # # Written by Andy Wardley # # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2001 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$ # #======================================================================== use strict; use warnings; # should not prove be responsible for this? use lib qw( blib/lib blib/arch lib ../blib/lib ../blib/arch ../lib ); use Template::Test; use Template::Stash; use Template::Config; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; our $DEBUG = grep(/-d/, @ARGV); our $STORE_PREFIX = ''; our $FETCH_PREFIX = ''; # only run the test when compiled with Template::Stash if ( $Template::Config::STASH ne 'Template::Stash::XS' ) { skip_all('Template::Config is not using Template::Stash::XS'); } require Template::Stash::XS; #------------------------------------------------------------------------ package My::Tied::Hash; use Tie::Hash; use base 'Tie::StdHash'; sub FETCH { my ($hash, $key) = @_; print STDERR "FETCH($key)\n" if $main::DEBUG; my $val = $hash->{ $key }; return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef; } sub STORE { my ($hash, $key, $val) = @_; print STDERR "STORE($key, $val)\n" if $main::DEBUG; $hash->{ $key } = ref $val ? $val : "$main::STORE_PREFIX$val"; } #------------------------------------------------------------------------ package My::Tied::List; use Tie::Array; use base 'Tie::StdArray'; sub FETCH { my ($list, $n) = @_; print STDERR "FETCH from list [$n]\n" if $main::DEBUG; my $val = $list->[ $n ]; return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef; } sub STORE { my ($list, $n, $val) = @_; print STDERR "STORE to list [$n => $val]\n" if $main::DEBUG; $list->[$n] = ref $val ? $val : "$main::STORE_PREFIX$val"; } #------------------------------------------------------------------------ package main; # setup a tied hash and a tied list my @list; tie @list, 'My::Tied::List'; push(@list, 10, 20, 30); my %hash = (a => 'alpha'); tie %hash, 'My::Tied::Hash'; $hash{ a } = 'alpha'; $hash{ b } = 'bravo'; $hash{ zero } = 0; $hash{ one } = 1; # now turn on the prefixes so we can track items going in # and out of the tied hash/list $FETCH_PREFIX = 'FETCH:'; $STORE_PREFIX = 'STORE:'; my $data = { hash => \%hash, list => \@list, }; my $stash_perl = Template::Stash->new($data); my $stash_xs = Template::Stash::XS->new($data); my $tt = [ perl => Template->new( STASH => $stash_perl ), xs => Template->new( STASH => $stash_xs ), ]; test_expect(\*DATA, $tt); __DATA__ #------------------------------------------------------------------------ # first try with the Perl stash #------------------------------------------------------------------------ # hash tests -- test -- [% hash.a %] -- expect -- FETCH:alpha -- test -- [% hash.b %] -- expect -- FETCH:bravo -- test -- ready set:[% hash.c = 'cosmos' %] go:[% hash.c %] -- expect -- ready set: go:FETCH:STORE:cosmos -- test -- [% hash.foo.bar = 'one' -%] [% hash.foo.bar %] -- expect -- one # list tests -- test -- [% list.0 %] -- expect -- FETCH:10 -- test -- [% list.first %]-[% list.last %] -- expect -- FETCH:10-FETCH:30 -- test -- [% list.push(40); list.last %] -- expect -- FETCH:40 -- test -- [% list.4 = 50; list.4 %] -- expect -- FETCH:STORE:50 #------------------------------------------------------------------------ # now try using the XS stash #------------------------------------------------------------------------ # hash tests -- test -- -- use xs -- [% hash.a %] -- expect -- FETCH:alpha -- test -- [% hash.b %] -- expect -- FETCH:bravo -- test -- [% hash.c = 'crazy'; hash.c %] -- expect -- FETCH:STORE:crazy -- test -- [% DEFAULT hash.c = 'more crazy'; hash.c %] -- expect -- FETCH:STORE:crazy -- test -- [% hash.wiz = 'woz' -%] [% hash.wiz %] -- expect -- FETCH:STORE:woz -- test -- [% DEFAULT hash.zero = 'nothing'; hash.zero %] -- expect -- FETCH:STORE:nothing -- test -- before: [% hash.one %] after: [% DEFAULT hash.one = 'solitude'; hash.one %] -- expect -- before: FETCH:1 after: FETCH:1 -- test -- [% hash.foo = 10; hash.foo = 20; hash.foo %] -- expect -- FETCH:STORE:20 # this test should create an intermediate hash -- test -- [% DEFAULT hash.person = { }; hash.person.name = 'Arthur Dent'; hash.person.email = 'dent@tt2.org'; -%] name: [% hash.person.name %] email: [% hash.person.email %] -- expect -- name: Arthur Dent email: dent@tt2.org # list tests -- test -- [% list.0 %] -- expect -- FETCH:10 -- test -- [% list.first %]-[% list.last %] -- expect -- FETCH:10-FETCH:STORE:50 -- test -- [% list.push(60); list.last %] -- expect -- FETCH:60 -- test -- [% list.5 = 70; list.5 %] -- expect -- FETCH:STORE:70 -- test -- [% DEFAULT list.5 = 80; list.5 %] -- expect -- FETCH:STORE:70 -- test -- [% list.10 = 100; list.10 %] -- expect -- FETCH:STORE:100 -- test -- [% stuff = [ ]; stuff.0 = 'some stuff'; stuff.0 -%] -- expect -- some stuff Template-Toolkit-3.102/t/wrapper.t0000644000000000000000000000771613600243610015531 0ustar rootroot#============================================================= -*-perl-*- # # t/wrapper.t # # Template script testing the WRAPPER directive. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ./lib ); use Template::Constants qw( :status ); use Template; use Template::Test; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Context::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $dir = -d 't' ? 't/test' : 'test'; my $tproc = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", TRIM => 1, # WRAPPER => 'wrapper', }); test_expect(\*DATA, $tproc, &callsign()); __DATA__ -- test -- [% BLOCK mypage %] This is the header [% content %] This is the footer [% END -%] [% WRAPPER mypage -%] This is the content [%- END %] -- expect -- This is the header This is the content This is the footer -- test -- [% WRAPPER mywrap title = 'Another Test' -%] This is some more content [%- END %] -- expect -- Wrapper Header Title: Another Test This is some more content Wrapper Footer -- test -- [% WRAPPER mywrap title = 'Another Test' -%] This is some content [%- END %] -- expect -- Wrapper Header Title: Another Test This is some content Wrapper Footer -- test -- [% WRAPPER page title = 'My Interesting Page' %] [% WRAPPER section title = 'Quantum Mechanics' -%] Quantum mechanics is a very interesting subject wish should prove easy for the layman to fully comprehend. [%- END %] [% WRAPPER section title = 'Desktop Nuclear Fusion for under $50' -%] This describes a simple device which generates significant sustainable electrical power from common tap water by process of nuclear fusion. [%- END %] [% END %] [% BLOCK page -%]

[% title %]

[% content %]
[% END %] [% BLOCK section -%]

[% title %]

[% content %]

[% END %] -- expect --

My Interesting Page

Quantum Mechanics

Quantum mechanics is a very interesting subject wish should prove easy for the layman to fully comprehend.

Desktop Nuclear Fusion for under $50

This describes a simple device which generates significant sustainable electrical power from common tap water by process of nuclear fusion.

-- test -- [%# FOREACH s = [ 'one' 'two' ]; WRAPPER section; PROCESS $s; END; END %] [% PROCESS $s WRAPPER section FOREACH s = [ 'one' 'two' ] %] [% BLOCK one; title = 'Block One' %]This is one[% END %] [% BLOCK two; title = 'Block Two' %]This is two[% END %] [% BLOCK section %]

[% title %]

[% content %]

[% END %] -- expect --

Block One

This is one

Block Two

This is two

-- test -- [% BLOCK one; title = 'Block One' %]This is one[% END %] [% BLOCK section %]

[% title %]

[% content %]

[% END %] [% WRAPPER section -%] [% PROCESS one %] [%- END %] title: [% title %] -- expect --

Block One

This is one

title: Block One -- test -- [% title = "foo" %] [% WRAPPER outer title="bar" -%] The title is [% title %] [%- END -%] [% BLOCK outer -%] outer [[% title %]]: [% content %] [%- END %] -- expect -- outer [bar]: The title is foo -- test-- [% BLOCK a; "$content"; END; BLOCK b; "$content"; END; BLOCK c; "$content"; END; WRAPPER a + b + c; 'FOO'; END; %] -- expect -- FOO -- stop -- # This next text demonstrates a limitation in the parser # http://tt2.org/pipermail/templates/2006-January/008197.html -- test-- [% BLOCK a; "$content"; END; BLOCK b; "$content"; END; BLOCK c; "$content"; END; A='a'; B='b'; C='c'; WRAPPER $A + $B + $C; 'BAR'; END; %] -- expect -- BAR Template-Toolkit-3.102/t/mtime-zero.t0000644000000000000000000000204513600243610016127 0ustar rootroot#============================================================= -*-perl-*- # # t/mtime-zero.t # # Test template process with . in INCLUDE_PATH # # Written by Nicolas R. # # Copyright (C) 2018 cPanel Inc. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use Template; use File::Temp qw(tempfile tempdir); use Test::More tests => 4; my $content = "hello, world\n"; my ( $tmpfh, $tmpfile ) = tempfile( UNLINK => 1 ); print $tmpfh $content; close $tmpfh or die $!; { my $out; ok( Template->new( { ABSOLUTE => 1 } )->process( $tmpfile, {}, \$out ), "process tmpfile" ); is( $out, $content, "content as expected" ); } { utime 0, 0, $tmpfile or die $!; my $out; ok( Template->new( { ABSOLUTE => 1 } )->process( $tmpfile, {}, \$out ), "process tmpfile [utime=0]" ); is( $out, $content, "content as expected [utime=0]" ); } Template-Toolkit-3.102/t/directry.t0000644000000000000000000001275513600243610015675 0ustar rootroot#============================================================= -*-perl-*- # # t/directory.t # # Tests the Directory plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Cwd; $^W = 1; if ($^O eq 'MSWin32') { skip_all('skipping tests on MS Win 32 platform'); } #$Template::Test::PRESERVE = 1; my $cwd = getcwd(); my $dir = -d 't' ? 't/test/dir' : 'test/dir'; my $dot = $dir; $dot =~ s/[^\/]+/../g; my $vars = { cwd => $cwd, dir => $dir, dot => $dot, }; test_expect(\*DATA, undef, $vars); __DATA__ -- test -- [% TRY ; USE Directory ; CATCH ; error ; END -%] -- expect -- Directory error - no directory specified -- test -- [% TRY ; USE Directory('/no/such/place') ; CATCH ; error.type ; ' error on ' ; error.info.split(':').0 ; END -%] -- expect -- Directory error on /no/such/place -- test -- [% USE d = Directory(dir, nostat=1) -%] [% d.path %] -- expect -- -- process -- [% dir %] -- test -- [% USE d = Directory(dir) -%] [% d.path %] -- expect -- -- process -- [% dir %] -- test -- [% USE directory(dir) -%] [% directory.path %] -- expect -- -- process -- [% dir %] -- test -- [% USE d = Directory(dir) -%] [% FOREACH f = d.files -%] - [% f.name %] [% END -%] [% FOREACH f = d.dirs; NEXT IF f.name == 'CVS'; -%] * [% f.name %] [% END %] -- expect -- - file1 - file2 - xyzfile * sub_one * sub_two -- test -- [% USE dir = Directory(dir) -%] [% INCLUDE dir %] [% BLOCK dir -%] * [% dir.name %] [% FOREACH f = dir.files -%] - [% f.name %] [% END -%] [% FOREACH f = dir.dirs; NEXT IF f.name == 'CVS'; -%] [% f.scan -%] [% INCLUDE dir dir=f FILTER indent(4) -%] [% END -%] [% END -%] -- expect -- * dir - file1 - file2 - xyzfile * sub_one - bar - foo * sub_two - waz.html - wiz.html -- test -- [% USE dir = Directory(dir) -%] * [% dir.path %] [% INCLUDE dir %] [% BLOCK dir; FOREACH f = dir.list ; NEXT IF f.name == 'CVS'; IF f.isdir ; -%] * [% f.name %] [% f.scan ; INCLUDE dir dir=f FILTER indent(4) ; ELSE -%] - [% f.name %] [% END ; END ; END -%] -- expect -- -- process -- * [% dir %] - file1 - file2 * sub_one - bar - foo * sub_two - waz.html - wiz.html - xyzfile -- test -- [% USE d = Directory(dir, recurse=1) -%] [% FOREACH f = d.files -%] - [% f.name %] [% END -%] [% FOREACH f = d.dirs; NEXT IF f.name == 'CVS'; -%] * [% f.name %] [% END %] -- expect -- - file1 - file2 - xyzfile * sub_one * sub_two -- test -- [% USE dir = Directory(dir, recurse=1, root=cwd) -%] * [% dir.path %] [% INCLUDE dir %] [% BLOCK dir; FOREACH f = dir.list ; NEXT IF f.name == 'CVS'; IF f.isdir ; -%] * [% f.name %] => [% f.path %] => [% f.abs %] [% INCLUDE dir dir=f FILTER indent(4) ; ELSE -%] - [% f.name %] => [% f.path %] => [% f.abs %] [% END ; END ; END -%] -- expect -- -- process -- * [% dir %] - file1 => [% dir %]/file1 => [% cwd %]/[% dir %]/file1 - file2 => [% dir %]/file2 => [% cwd %]/[% dir %]/file2 * sub_one => [% dir %]/sub_one => [% cwd %]/[% dir %]/sub_one - bar => [% dir %]/sub_one/bar => [% cwd %]/[% dir %]/sub_one/bar - foo => [% dir %]/sub_one/foo => [% cwd %]/[% dir %]/sub_one/foo * sub_two => [% dir %]/sub_two => [% cwd %]/[% dir %]/sub_two - waz.html => [% dir %]/sub_two/waz.html => [% cwd %]/[% dir %]/sub_two/waz.html - wiz.html => [% dir %]/sub_two/wiz.html => [% cwd %]/[% dir %]/sub_two/wiz.html - xyzfile => [% dir %]/xyzfile => [% cwd %]/[% dir %]/xyzfile -- test -- [% USE dir = Directory(dir, recurse=1, root=cwd) -%] * [% dir.path %] [% INCLUDE dir %] [% BLOCK dir; FOREACH f = dir.list ; NEXT IF f.name == 'CVS'; IF f.isdir ; -%] * [% f.name %] => [% f.home %] [% INCLUDE dir dir=f FILTER indent(4) ; ELSE -%] - [% f.name %] => [% f.home %] [% END ; END ; END -%] -- expect -- -- process -- * [% dir %] - file1 => [% dot %] - file2 => [% dot %] * sub_one => [% dot %] - bar => [% dot %]/.. - foo => [% dot %]/.. * sub_two => [% dot %] - waz.html => [% dot %]/.. - wiz.html => [% dot %]/.. - xyzfile => [% dot %] -- test -- [% USE dir = Directory(dir) -%] [% file = dir.file('xyzfile') -%] [% file.name %] -- expect -- xyzfile -- test -- [% USE dir = Directory('.', root=dir) -%] [% dir.name %] [% FOREACH f = dir.files -%] - [% f.name %] [% END -%] -- expect -- . - file1 - file2 - xyzfile -- test -- [% VIEW filelist -%] [% BLOCK file -%] f [% item.name %] => [% item.path %] [% END -%] [% BLOCK directory; NEXT IF item.name == 'CVS'; -%] d [% item.name %] => [% item.path %] [% item.content(view) | indent -%] [% END -%] [% END -%] [% USE dir = Directory(dir, recurse=1) -%] [% filelist.print(dir) %] -- expect -- -- process -- d dir => [% dir %] f file1 => [% dir %]/file1 f file2 => [% dir %]/file2 d sub_one => [% dir %]/sub_one f bar => [% dir %]/sub_one/bar f foo => [% dir %]/sub_one/foo d sub_two => [% dir %]/sub_two f waz.html => [% dir %]/sub_two/waz.html f wiz.html => [% dir %]/sub_two/wiz.html f xyzfile => [% dir %]/xyzfile Template-Toolkit-3.102/t/stashc.t0000644000000000000000000000314213600243610015323 0ustar rootroot#============================================================= -*-perl-*- # # t/stashc.t # # Template script testing the Template::Stash::Context module. # Currently only partially complete. # # Written by Andy Wardley # # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2001 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Constants qw( :status ); use Template::Stash::Context; use Template::Test; $^W = 1; my $count = 20; my $data = { foo => 10, bar => { baz => 20, }, baz => sub { return { boz => ($count += 10), biz => (shift || ''), }; }, numbers => sub { return wantarray ? (1, 2, 3) : "one two three"; } }; my $stash = Template::Stash::Context->new($data); match( $stash->get('foo'), 10 ); match( $stash->get([ 'bar', 0, 'baz', 0 ]), 20 ); match( $stash->get('bar.baz'), 20 ); match( $stash->get('bar(10).baz'), 20 ); match( $stash->get('baz.boz'), 30 ); match( $stash->get('baz.boz'), 40 ); match( $stash->get('baz.biz'), '' ); match( $stash->get('baz(50).biz'), '' ); # args are ignored $stash->set( 'bar.buz' => 100 ); match( $stash->get('bar.buz'), 100 ); test_expect(\*DATA, { STASH => $stash }); __DATA__ -- test -- [% numbers.join(', ') %] -- expect -- 1, 2, 3 -- test -- [% numbers.scalar %] -- expect -- one two three -- test -- [% numbers.ref %] -- expect -- CODE Template-Toolkit-3.102/t/table.t0000644000000000000000000000527013600243610015131 0ustar rootroot#============================================================= -*-perl-*- # # t/table.t # # Tests the 'Table' plugin. # # Written by Andy Wardley # # Copyright (C) 2000-2006 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ../lib ); use Template::Test; $Template::Test::DEBUG = 0; my $params = { alphabet => [ 'a'..'z' ], empty => [ ], }; test_expect(\*DATA, { POST_CHOMP => 1 }, $params); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- [% USE table(alphabet, rows=5) %] [% FOREACH letter = table.col(0) %] [% letter %].. [%- END +%] [% FOREACH letter = table.col(1) %] [% letter %].. [%- END %] -- expect -- a..b..c..d..e.. f..g..h..i..j.. -- test -- [% USE table(alphabet, rows=5) %] [% FOREACH letter = table.row(0) %] [% letter %].. [%- END +%] [% FOREACH letter = table.row(1) %] [% letter %].. [%- END %] -- expect -- a..f..k..p..u..z.. b..g..l..q..v.... -- test -- [% USE table(alphabet, rows=3) %] [% FOREACH col = table.cols %] [% col.0 %] [% col.1 %] [% col.2 +%] [% END %] -- expect -- a b c d e f g h i j k l m n o p q r s t u v w x y z -- test -- [% USE alpha = table(alphabet, cols=3, pad=0) %] [% FOREACH group = alpha.col %] [ [% group.first %] - [% group.last %] ([% group.size %] letters) ] [% END %] -- expect -- [ a - i (9 letters) ] [ j - r (9 letters) ] [ s - z (8 letters) ] -- test -- [% USE alpha = table(alphabet, rows=5, pad=0, overlap=1) %] [% FOREACH group = alpha.col %] [ [% group.first %] - [% group.last %] ([% group.size %] letters) ] [% END %] -- expect -- [ a - e (5 letters) ] [ e - i (5 letters) ] [ i - m (5 letters) ] [ m - q (5 letters) ] [ q - u (5 letters) ] [ u - y (5 letters) ] [ y - z (2 letters) ] -- test -- [% USE table(alphabet, rows=5, pad=0) %] [% FOREACH col = table.cols %] [% col.join('-') +%] [% END %] -- expect -- a-b-c-d-e f-g-h-i-j k-l-m-n-o p-q-r-s-t u-v-w-x-y z -- test -- [% USE table(alphabet, rows=8, overlap=1 pad=0) %] [% FOREACH col = table.cols %] [% FOREACH item = col %][% item %] [% END +%] [% END %] -- expect -- a b c d e f g h h i j k l m n o o p q r s t u v v w x y z -- test -- [% USE table([1,3,5], cols=5) %] [% FOREACH t = table.rows %] [% t.join(', ') %] [% END %] -- expect -- 1, 3, 5 -- test -- > [% USE table(empty, rows=3) -%] [% FOREACH col = table.cols -%] col [% FOREACH item = col -%] item: [% item -%] [% END -%] [% END -%] < -- expect -- > < Template-Toolkit-3.102/t/exception.t0000644000000000000000000000302113600243610016030 0ustar rootroot#============================================================= -*-perl-*- # # t/except.t # # Test the Template::Exception module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Exception; my $text = 'the current output buffer'; my $e1 = Template::Exception->new('e1.type', 'e1.info'); my $e2 = Template::Exception->new('e2.type', 'e2.info', \$text); ok( $e1 ); ok( $e2 ); ok( $e1->type() eq 'e1.type' ); ok( $e2->info() eq 'e2.info' ); my @ti = $e1->type_info(); ok( $ti[0] eq 'e1.type' ); ok( $ti[1] eq 'e1.info' ); ok( $e2->as_string() eq 'e2.type error - e2.info' ); ok( $e2->text() eq 'the current output buffer' ); my $prepend = 'text to prepend '; $e2->text(\$prepend); ok( $e2->text() eq 'text to prepend the current output buffer' ); my @handlers = ('something', 'e2', 'e1.type'); ok( $e1->select_handler(@handlers) eq 'e1.type' ); ok( $e2->select_handler(@handlers) eq 'e2' ); my $e3 = Template::Exception->new('e3.type', 'e3.info', undef); ok( $e3 ); ok( $e3->text() eq ''); ok( $e3->as_string() eq 'e3.type error - e3.info' ); # test to check that overloading fallback works properly # by using a non explicitly defined op ok( $e3 ne "fish"); Template-Toolkit-3.102/t/compile5.t0000644000000000000000000000643514232015000015553 0ustar rootroot#============================================================= -*-perl-*- # # t/compile5.t # # Test that the compiled template files written by compile4.t can be # loaded and used. Similar to compile2.t but using COMPILE_DIR as well # as COMPILE_EXT. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use Cwd qw( abs_path ); use File::Path; my @dir = -d 't' ? qw(t test) : qw(test); my $dir = abs_path( File::Spec->catfile(@dir) ); my $tdir = abs_path( File::Spec->catfile(@dir, 'tmp')); my $cdir = File::Spec->catfile($tdir, 'cache'); my $zero = File::Spec->catfile($dir, qw(src divisionbyzero)); print "zero: $zero\n"; #my $dir = abs_path( -d 't' ? 't/test' : 'test' ); #my $cdir = abs_path("$dir/tmp") . "/cache"; #my $zero = "$cdir/src/divisionbyzero"; my $ttcfg = { POST_CHOMP => 1, INCLUDE_PATH => "$dir/src", COMPILE_DIR => "$cdir/", # note trailing slash - should be handled OK COMPILE_EXT => '.ttc', ABSOLUTE => 1, CONSTANTS => { dir => $dir, zero => $zero, }, }; #print " # check compiled template files exist my $fixdir = $dir; $fixdir =~ s[:][]g if $^O eq 'MSWin32'; my ($foo, $bar, $blam) = map { "$cdir/$fixdir/src/$_.ttc" } qw( foo complex blam ); $blam =~ s[/+][/]g; ok( -f $foo, 'cached foo' ); ok( -f $bar, 'cached bar' ); ok( -f $blam, 'cached blam' ); # we're going to hack on the compiled 'foo' file to change some key text. # this way we can tell that the template was loaded from the compiled # version and not the source. my @foo_times = (stat $foo)[8,9]; open(FOO, '<', $foo) || die "$foo: $!\n"; local $/ = undef; my $content = ; close(FOO); $content =~ s/the foo file/the newly hacked foo file/; open(FOO, ">", $foo) || die "$foo: $!\n"; print FOO $content; close(FOO); # and set back utime( @foo_times, $foo ); # same again for 'blam' my @blam_times = (stat $blam)[8,9]; open(BLAM, '<', $blam) || die "$blam: $!\n"; local $/ = undef; $content = ; close(BLAM); $content =~ s/blam/wam-bam/g; open(BLAM, ">", $blam) || die "$blam: $!\n"; print BLAM $content; close(BLAM); # and set back utime( @blam_times, $blam ); test_expect(\*DATA, $ttcfg, { root => abs_path($dir) } ); exit; # cleanup cache directory rmtree($cdir) if -d $cdir; __DATA__ -- test -- [% INCLUDE foo a = 'any value' %] -- expect -- This is the newly hacked foo file, a is any value -- test -- [% META author => 'billg' version => 6.66 %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: billg, version: 6.66 - 3 - 2 - 1 -- test -- [% INCLUDE "$root/src/blam" %] -- expect -- This is the wam-bam file -- test -- [%- # second pass, reads the compiled code from cache -%] [% INCLUDE divisionbyzero -%] -- expect -- -- process -- undef error - Illegal division by zero at [% constants.zero %] line 1, chunk 1. Template-Toolkit-3.102/t/block.t0000644000000000000000000000532313600243610015133 0ustar rootroot#============================================================= -*-perl-*- # # t/block.t # # Template script testing BLOCK definitions. A BLOCK defined in a # template incorporated via INCLUDE should not be visible (i.e. # exported) to the calling template. In the same case for PROCESS, # the block should become visible. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $ttcfg = { INCLUDE_PATH => [ qw( t/test/lib test/lib ) ], POST_CHOMP => 1, BLOCKS => { header => '[% title %]', footer => '', block_a => sub { return 'this is block a' }, block_b => sub { return 'this is block b' }, }, }; test_expect(\*DATA, $ttcfg, &callsign); __DATA__ -- test -- [% BLOCK block1 %] This is the original block1 [% END %] [% INCLUDE block1 %] [% INCLUDE blockdef %] [% INCLUDE block1 %] -- expect -- This is the original block1 start of blockdef end of blockdef This is the original block1 -- test -- [% BLOCK block1 %] This is the original block1 [% END %] [% INCLUDE block1 %] [% PROCESS blockdef %] [% INCLUDE block1 %] -- expect -- This is the original block1 start of blockdef end of blockdef This is block 1, defined in blockdef, a is alpha -- test -- [% INCLUDE block_a +%] [% INCLUDE block_b %] -- expect -- this is block a this is block b -- test -- [% INCLUDE header title = 'A New Beginning' +%] A long time ago in a galaxy far, far away... [% PROCESS footer %] -- expect -- A New Beginning A long time ago in a galaxy far, far away... -- test -- [% BLOCK foo:bar %] blah [% END %] [% PROCESS foo:bar %] -- expect -- blah -- test -- [% BLOCK 'hello html' -%] Hello World! [% END -%] [% PROCESS 'hello html' %] -- expect -- Hello World! -- test -- <[% INCLUDE foo %]> [% BLOCK foo %][% END %] -- expect -- <> -- stop -- # these test the experimental BLOCK args feature which will hopefully allow # parser/eval options to be set for different blocks -- test -- [% BLOCK foo eval_perl=0 tags="star" -%] This is the foo block [% END -%] foo: [% INCLUDE foo %] -- expect -- foo: This is the foo block -- test -- [% BLOCK eval_perl=0 tags="star" -%] This is an anonymous block [% END -%] -- expect -- This is an anonymous block Template-Toolkit-3.102/t/output.t0000644000000000000000000000524614232015000015375 0ustar rootroot#============================================================= -*-perl-*- # # t/output.t # # Test the OUTPUT and OUTPUT_PATH options of the Template.pm module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; ntests(14); my $dir = -d 't' ? 't/test' : 'test'; my $f1 = 'foo.bar'; my $f2 = 'foo.baz'; my $file1 = "$dir/tmp/$f1"; my $file2 = "$dir/tmp/$f2"; #------------------------------------------------------------------------ my $tt = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", OUTPUT_PATH => "$dir/tmp", }) || die Template->error(); unlink($file1) if -f $file1; ok( $tt->process('foo', &callsign, $f1) ); ok( -f $file1 ); open(FP, '<', $file1) || die "$file1: $!\n"; local $/ = undef; my $out = ; close(FP); ok( 1 ); match( $out, "This is the foo file, a is alpha" ); unlink($file1); #------------------------------------------------------------------------ $tt = Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", OUTPUT_PATH => "$dir/tmp", OUTPUT => $f2, }) || die Template->error(); unlink($file2) if -f $file2; ok( $tt->process('foo', &callsign) ); ok( -f $file2 ); open(FP, '<', $file2) || die "$file2: $!\n"; local $/ = undef; $out = ; close(FP); ok( 1 ); match( $out, "This is the foo file, a is alpha" ); unlink($file2); #------------------------------------------------------------------------ # test passing options like 'binmode' to Template process() method to # ensure they get passed onto _output() subroutine. #------------------------------------------------------------------------ package My::Template; use Template; use base qw( Template ); our $MESSAGE; sub DEBUG { my $self = shift; $MESSAGE = join('', @_); } package main; $tt = My::Template->new({ INCLUDE_PATH => "$dir/src:$dir/lib", OUTPUT_PATH => "$dir/tmp", OUTPUT => $f2, }) || die Template->error(); $Template::DEBUG = 1; ok( $tt->process('foo', &callsign, undef, { binmode => 1 }), 'processed' ); ok( -f $file2, 'output file exists' ); is( $My::Template::MESSAGE, "set binmode\n", 'set binmode via hashref' ); $My::Template::MESSAGE = 'reset'; ok( $tt->process('foo', &callsign, $f2, binmode => 1), 'processed again' ); ok( -f $file2, 'output file exists' ); is( $My::Template::MESSAGE, "set binmode\n", 'set binmode via arglist' ); unlink($file2); Template-Toolkit-3.102/t/foreach.t0000644000000000000000000002447414635371175015501 0ustar rootroot#============================================================= -*-perl-*- # # t/foreach.t # # Template script testing the FOREACH directive. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template; use Template::Test; #$Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my ($a, $b, $c, $d, $l, $o, $r, $u, $w ) = qw( alpha bravo charlie delta lima oscar romeo uncle whisky ); my $day = -1; my @days = qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday ); my @months = qw( jan feb mar apr may jun jul aug sep oct nov dec ); my @people = ( { 'id' => 'abw', 'name' => 'Andy Wardley' }, { 'id' => 'sam', 'name' => 'Simon Matthews' } ); my @seta = ( $a, $b, $w ); my @setb = ( $c, $l, $o, $u, $d ); my $params = { 'a' => $a, 'b' => $b, 'c' => $c, 'C' => uc $c, 'd' => $d, 'l' => $l, 'o' => $o, 'r' => $r, 'u' => $u, 'w' => $w, 'seta' => \@seta, 'setb' => \@setb, 'users' => \@people, 'item' => 'foo', 'items' => [ 'foo', 'bar' ], 'days' => \@days, 'months' => sub { return \@months }, 'format' => \&format, 'people' => [ { id => 'abw', code => 'abw', name => 'Andy Wardley' }, { id => 'aaz', code => 'zaz', name => 'Azbaz Azbaz Zazbazzer' }, { id => 'bcd', code => 'dec', name => 'Binary Coded Decimal' }, { id => 'efg', code => 'zzz', name => 'Extra Fine Grass' }, ], 'sections' => { one => 'Section One', two => 'Section Two', three => 'Section Three', four => 'Section Four', }, nested => [ [ qw( a b c ) ], [ qw( x y z ) ], ], }; sub format { my $format = shift; $format = '%s' unless defined $format; return sub { sprintf($format, shift); } } my $template = Template->new({ INTERPOLATE => 1, POST_CHOMP => 1, ANYCASE => 0 }); my $ttdebug = Template->new({ DEBUG => 1, DEBUG_FORMAT => '', }); test_expect(\*DATA, [ default => $template, debug => $ttdebug ], $params); __DATA__ -- test -- [% FOREACH a = [ 1, 2, 3 ] %] [% a +%] [% END %] [% FOREACH foo.bar %] [% a %] [% END %] -- expect -- 1 2 3 -- test -- Commence countdown... [% FOREACH count = [ 'five' 'four' 'three' 'two' 'one' ] %] [% count +%] [% END %] Fire! -- expect -- Commence countdown... five four three two one Fire! -- test -- [% FOR count = [ 1 2 3 ] %]${count}..[% END %] -- expect -- 1..2..3.. -- test -- people: [% bloke = r %] [% people = [ c, bloke, o, 'frank' ] %] [% FOREACH person = people %] [ [% person %] ] [% END %] -- expect -- people: [ charlie ] [ romeo ] [ oscar ] [ frank ] -- test -- [% FOREACH name = setb %] [% name %], [% END %] -- expect -- charlie, lima, oscar, uncle, delta, -- test -- [% FOREACH name = r %] [% name %], $name, wherefore art thou, $name? [% END %] -- expect -- romeo, romeo, wherefore art thou, romeo? -- test -- [% user = 'fred' %] [% FOREACH user = users %] $user.name ([% user.id %]) [% END %] [% user.name %] -- expect -- Andy Wardley (abw) Simon Matthews (sam) Simon Matthews -- test -- [% name = 'Joe Random Hacker' id = 'jrh' %] [% FOREACH users %] $name ([% id %]) [% END %] $name ($id) -- expect -- Andy Wardley (abw) Simon Matthews (sam) Joe Random Hacker (jrh) -- test -- [% FOREACH i = [1..4] %] [% i +%] [% END %] -- expect -- 1 2 3 4 -- test -- [% first = 4 last = 8 %] [% FOREACH i = [first..last] %] [% i +%] [% END %] -- expect -- 4 5 6 7 8 -- test -- [% list = [ 'one' 'two' 'three' 'four' ] %] [% list.0 %] [% list.3 %] [% FOREACH n = [0..3] %] [% list.${n} %], [%- END %] -- expect -- one four one, two, three, four, -- test -- [% "$i, " FOREACH i = [-2..2] %] -- expect -- -2, -1, 0, 1, 2, -- test -- [% FOREACH i = item -%] - [% i %] [% END %] -- expect -- - foo -- test -- [% FOREACH i = items -%] - [% i +%] [% END %] -- expect -- - foo - bar -- test -- [% FOREACH item = [ a b c d ] %] $item [% END %] -- expect -- alpha bravo charlie delta -- test -- [% items = [ d C a c b ] %] [% FOREACH item = items.sort %] $item [% END %] -- expect -- alpha bravo CHARLIE charlie delta -- test -- [% items = [ d a c b ] %] [% FOREACH item = items.sort.reverse %] $item [% END %] -- expect -- delta charlie bravo alpha -- test -- [% userlist = [ b c d a C 'Andy' 'tom' 'dick' 'harry' ] %] [% FOREACH u = userlist.sort %] $u [% END %] -- expect -- alpha Andy bravo charlie CHARLIE delta dick harry tom -- test -- [% ulist = [ b c d a 'Andy' ] %] [% USE f = format("[- %-7s -]\n") %] [% f(item) FOREACH item = ulist.sort %] -- expect -- [- alpha -] [- Andy -] [- bravo -] [- charlie -] [- delta -] -- test -- [% FOREACH item = [ a b c d ] %] [% "List of $loop.size items:\n" IF loop.first %] #[% loop.number %]/[% loop.size %]: [% item +%] [% "That's all folks\n" IF loop.last %] [% END %] -- expect -- List of 4 items: #1/4: alpha #2/4: bravo #3/4: charlie #4/4: delta That's all folks -- test -- [% items = [ d b c a ] %] [% FOREACH item = items.sort %] [% "List of $loop.size items:\n----------------\n" IF loop.first %] * [% item +%] [% "----------------\n" IF loop.last %] [% END %] -- expect -- List of 4 items: ---------------- * alpha * bravo * charlie * delta ---------------- -- test -- [% list = [ a b c d ] %] [% i = 1 %] [% FOREACH item = list %] #[% i %]/[% list.size %]: [% item +%] [% i = inc(i) %] [% END %] -- expect -- #1/4: alpha #2/4: bravo #3/4: charlie #4/4: delta -- test -- [% FOREACH a = ['foo', 'bar', 'baz'] %] * [% loop.index %] [% a +%] [% FOREACH b = ['wiz', 'woz', 'waz'] %] - [% loop.index %] [% b +%] [% END %] [% END %] -- expect -- * 0 foo - 0 wiz - 1 woz - 2 waz * 1 bar - 0 wiz - 1 woz - 2 waz * 2 baz - 0 wiz - 1 woz - 2 waz -- test -- [% id = 12345 name = 'Original' user1 = { id => 'tom', name => 'Thomas' } user2 = { id => 'reg', name => 'Reginald' } %] [% FOREACH [ user1 ] %] id: [% id +%] name: [% name +%] [% FOREACH [ user2 ] %] - id: [% id +%] - name: [% name +%] [% END %] [% END %] id: [% id +%] name: [% name +%] -- expect -- id: tom name: Thomas - id: reg - name: Reginald id: 12345 name: Original -- test -- [% them = [ people.1 people.2 ] %] [% "$p.id($p.code): $p.name\n" FOREACH p = them.sort('id') %] -- expect -- aaz(zaz): Azbaz Azbaz Zazbazzer bcd(dec): Binary Coded Decimal -- test -- [% "$p.id($p.code): $p.name\n" FOREACH p = people.sort('code') %] -- expect -- abw(abw): Andy Wardley bcd(dec): Binary Coded Decimal aaz(zaz): Azbaz Azbaz Zazbazzer efg(zzz): Extra Fine Grass -- test -- [% "$p.id($p.code): $p.name\n" FOREACH p = people.sort('code').reverse %] -- expect -- efg(zzz): Extra Fine Grass aaz(zaz): Azbaz Azbaz Zazbazzer bcd(dec): Binary Coded Decimal abw(abw): Andy Wardley -- test -- [% "$p.id($p.code): $p.name\n" FOREACH p = people.sort('code') %] -- expect -- abw(abw): Andy Wardley bcd(dec): Binary Coded Decimal aaz(zaz): Azbaz Azbaz Zazbazzer efg(zzz): Extra Fine Grass -- test -- Section List: [% FOREACH item = sections %] [% item.key %] - [% item.value +%] [% END %] -- expect -- Section List: four - Section Four one - Section One three - Section Three two - Section Two -- test -- [% FOREACH a = [ 2..6 ] %] before [% a %] [% NEXT IF a == 5 +%] after [% a +%] [% END %] -- expect -- before 2 after 2 before 3 after 3 before 4 after 4 before 5before 6 after 6 -- test -- [% count = 1; WHILE (count < 10) %] [% count = count + 1 %] [% NEXT IF count < 5 %] count: [% count +%] [% END %] -- expect -- count: 5 count: 6 count: 7 count: 8 count: 9 count: 10 -- test -- [% FOR count = [ 1 2 3 ] %]${count}..[% END %] -- expect -- 1..2..3.. -- test -- [% FOREACH count = [ 1 2 3 ] %]${count}..[% END %] -- expect -- 1..2..3.. -- test -- [% FOR [ 1 2 3 ] %]..[% END %] -- expect -- ...... -- test -- [% FOREACH [ 1 2 3 ] %]..[% END %] -- expect -- ...... -- test -- [% FOREACH outer = nested -%] outer start [% FOREACH inner = outer -%] inner [% inner +%] [% "last inner\n" IF loop.last -%] [% END %] [% "last outer\n" IF loop.last -%] [% END %] -- expect -- outer start inner a inner b inner c last inner outer start inner x inner y inner z last inner last outer -- test -- [% FOREACH n = [ 1 2 3 4 5 ] -%] [% LAST IF loop.last -%] [% n %], [%- END %] -- expect -- 1, 2, 3, 4, -- test -- [% FOREACH n = [ 1 2 3 4 5 ] -%] [% BREAK IF loop.last -%] [% n %], [%- END %] -- expect -- 1, 2, 3, 4, -- test -- -- use debug -- [% FOREACH a = [ 1, 2, 3 ] -%] * [% a %] [% END -%] -- expect -- * 1 * 2 * 3 -- test -- [% FOREACH i = [1 .. 10]; SWITCH i; CASE 5; NEXT; CASE 8; LAST; END; "$i\n"; END; -%] -- expect -- 1 2 3 4 6 7 -- test -- [% FOREACH i = [1 .. 10]; IF 1; IF i == 5; NEXT; END; IF i == 8; LAST; END; END; "$i\n"; END; -%] -- expect -- 1 2 3 4 6 7 -- test -- [% FOREACH i = [1 .. 4]; FOREACH j = [1 .. 4]; k = 1; SWITCH j; CASE 2; FOREACH k IN [ 1 .. 2 ]; LAST; END; CASE 3; NEXT IF j == 3; END; "$i,$j,$k\n"; END; END; -%] -- expect -- 1,1,1 1,2,1 1,4,1 2,1,1 2,2,1 2,4,1 3,1,1 3,2,1 3,4,1 4,1,1 4,2,1 4,4,1 -- test -- [% LAST FOREACH k = [ 1 .. 4]; "$k\n"; # Should finish loop with k = 4. Instead this is an infinite loop!! #NEXT FOREACH k = [ 1 .. 4]; #"$k\n"; -%] -- expect -- 1 -- test -- [% FOREACH prime IN [2, 3, 5, 7, 11, 13]; "$prime\n"; END -%] -- expect -- 2 3 5 7 11 13 -- test -- -- name FOR/WHILE/NEXT -- [% FOREACH i IN [ 1..6 ]; "${i}: "; j = 0; WHILE j < i; j = j + 1; NEXT IF j > 3; "${j} "; END; "\n"; END; %] -- expect -- 1: 1 2: 1 2 3: 1 2 3 4: 1 2 3 5: 1 2 3 6: 1 2 3 Template-Toolkit-3.102/t/try.t0000644000000000000000000002352413600243610014662 0ustar rootroot#============================================================= -*-perl-*- # # t/try.t # # Template script testing TRY / THROW / CATCH / FINAL blocks. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $ttcfg = { INCLUDE_PATH => [ qw( t/test/lib test/lib ) ], POST_CHOMP => 1, }; my $replace = &callsign(); $replace->{ throw_egg } = sub { die (Template::Exception->new('egg', 'scrambled')); }; $replace->{ throw_any } = sub { die "undefined error\n"; }; test_expect(\*DATA, $ttcfg, $replace); __DATA__ #------------------------------------------------------------------------ # throw default type #------------------------------------------------------------------------ -- test -- [% TRY %] [% THROW foxtrot %] [% CATCH %] [[% error.type%]] [% error.info %] [% END %] -- expect -- [undef] foxtrot -- test -- [% TRY %] [% THROW $f %] [% CATCH %] [[% error.type%]] [% error.info %] [% END %] -- expect -- [undef] foxtrot #------------------------------------------------------------------------ # throw simple types #------------------------------------------------------------------------ -- test -- before try [% TRY %] try this [% THROW barf "Feeling sick" %] don't try this [% CATCH barf %] caught barf: [% error.info +%] [% END %] after try -- expect -- before try try this caught barf: Feeling sick after try -- test -- before [% TRY %] some content [% THROW up 'more malaise' %] afterthought [% CATCH barf %] no barf [% CATCH up %] caught up: [% error.info +%] [% CATCH %] no default [% END %] after -- expect -- before some content caught up: more malaise after -- test -- before [% TRY %] some content [% THROW up b %] afterthought [% CATCH barf %] no barf [% CATCH up %] caught up: [% error.info +%] [% CATCH %] no default [% END %] after -- expect -- before some content caught up: bravo after -- test -- before [% TRY %] some content [% THROW $a b %] afterthought [% CATCH barf %] no barf [% CATCH up %] caught up: [% error.info +%] [% CATCH alpha %] caught up: [% error.info +%] [% CATCH %] no default [% END %] after -- expect -- before some content caught up: bravo after #------------------------------------------------------------------------ # throw complex (hierarchical) exception types #------------------------------------------------------------------------ -- test -- before [% TRY %] some content [% THROW alpha.bravo c %] afterthought [% CATCH alpha.charlie %] WRONG: [% error.info +%] [% CATCH alpha.bravo %] RIGHT: [% error.info +%] [% CATCH alpha %] WRONG: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: charlie after -- test -- before [% TRY %] some content [% THROW alpha.bravo c %] afterthought [% CATCH delta.charlie %] WRONG: [% error.info +%] [% CATCH delta.bravo %] WRONG: [% error.info +%] [% CATCH alpha %] RIGHT: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: charlie after -- test -- before [% TRY %] some content [% THROW "alpha.$b" c %] afterthought [% CATCH delta.charlie %] WRONG: [% error.info +%] [% CATCH alpha.bravo %] RIGHT: [% error.info +%] [% CATCH alpha.charlie %] WRONG: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: charlie after -- test -- before [% TRY %] some content [% THROW alpha.bravo c %] afterthought [% CATCH delta.charlie %] WRONG: [% error.info +%] [% CATCH delta.bravo %] WRONG: [% error.info +%] [% CATCH alpha.charlie %] WRONG: [% error.info +%] [% CATCH %] RIGHT: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: charlie after -- test -- before [% TRY %] some content [% THROW alpha.bravo.charlie d %] afterthought [% CATCH alpha.bravo.charlie %] RIGHT: [% error.info +%] [% CATCH alpha.bravo %] WRONG: [% error.info +%] [% CATCH alpha %] WRONG: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: delta after -- test -- before [% TRY %] some content [% THROW alpha.bravo.charlie d %] afterthought [% CATCH alpha.bravo.foxtrot %] WRONG: [% error.info +%] [% CATCH alpha.bravo %] RIGHT: [% error.info +%] [% CATCH alpha %] WRONG: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: delta after -- test -- before [% TRY %] some content [% THROW alpha.bravo.charlie d %] afterthought [% CATCH alpha.bravo.foxtrot %] WRONG: [% error.info +%] [% CATCH alpha.echo %] WRONG: [% error.info +%] [% CATCH alpha %] RIGHT: [% error.info +%] [% CATCH %] WRONG: [% error.info +%] [% END %] after -- expect -- before some content RIGHT: delta after #------------------------------------------------------------------------ # test FINAL block #------------------------------------------------------------------------ -- test -- [% TRY %] foo [% CATCH %] bar [% FINAL %] baz [% END %] -- expect -- foo baz -- test -- [% TRY %] foo [% THROW anything %] [% CATCH %] bar [% FINAL %] baz [% END %] -- expect -- foo bar baz #------------------------------------------------------------------------ # use CLEAR to clear output from TRY block #------------------------------------------------------------------------ -- test -- before [% TRY %] foo [% THROW anything %] [% CATCH %] [% CLEAR %] bar [% FINAL %] baz [% END %] -- expect -- before bar baz -- test -- before [% TRY %] foo [% CATCH %] bar [% FINAL %] [% CLEAR %] baz [% END %] -- expect -- before baz #------------------------------------------------------------------------ # nested TRY blocks #------------------------------------------------------------------------ -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH %] caught inner [% END %] more outer [% CATCH %] caught outer [% END %] after -- expect -- before outer inner caught inner more outer after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH foo %] caught inner foo [% CATCH %] caught inner [% END %] more outer [% CATCH foo %] caught outer [% END %] after -- expect -- before outer inner caught inner foo more outer after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH foo %] caught inner foo [% THROW $error %] [% CATCH %] caught inner [% END %] more outer [% CATCH foo %] caught outer foo [% error.info +%] [% CATCH %] caught outer [[% error.type %]] [% error.info +%] [% END %] after -- expect -- before outer inner caught inner foo caught outer foo golf after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH foo %] caught inner foo [% THROW bar error.info %] [% CATCH %] caught inner [% END %] more outer [% CATCH foo %] WRONG: caught outer foo [% error.info +%] [% CATCH bar %] RIGHT: caught outer bar [% error.info +%] [% CATCH %] caught outer [[% error.type %]] [% error.info +%] [% END %] after -- expect -- before outer inner caught inner foo RIGHT: caught outer bar golf after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH foo %] [% CLEAR %] caught inner foo [% THROW bar error.info %] [% CATCH %] caught inner [% END %] more outer [% CATCH foo %] WRONG: caught outer foo [% error.info +%] [% CATCH bar %] RIGHT: caught outer bar [% error.info +%] [% CATCH %] caught outer [[% error.type %]] [% error.info +%] [% END %] after -- expect -- before outer caught inner foo RIGHT: caught outer bar golf after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH foo %] caught inner foo [% THROW bar error.info %] [% CATCH %] caught inner [% END %] more outer [% CATCH foo %] WRONG: caught outer foo [% error.info +%] [% CATCH bar %] [% CLEAR %] RIGHT: caught outer bar [% error.info +%] [% CATCH %] caught outer [[% error.type %]] [% error.info +%] [% END %] after -- expect -- before RIGHT: caught outer bar golf after -- test -- before [% TRY %] outer [% TRY %] inner [% THROW foo g %] more inner [% CATCH bar %] caught inner bar [% END %] more outer [% CATCH foo %] RIGHT: caught outer foo [% error.info +%] [% CATCH bar %] WRONG: caught outer bar [% error.info +%] [% CATCH %] caught outer [[% error.type %]] [% error.info +%] [% END %] after -- expect -- before outer inner RIGHT: caught outer foo golf after #------------------------------------------------------------------------ # test throwing from Perl code via die() #------------------------------------------------------------------------ -- test -- [% TRY %] before [% throw_egg %] after [% CATCH egg %] caught egg: [% error.info +%] [% END %] after -- expect -- before caught egg: scrambled after -- test -- [% TRY %] before [% throw_any %] after [% CATCH egg %] caught egg: [% error.info +%] [% CATCH %] caught any: [[% error.type %]] [% error.info %] [% END %] after -- expect -- before caught any: [undef] undefined error after -- test -- [% TRY %] [% THROW up 'feeling sick' %] [% CATCH %] [% error %] [% END %] -- expect -- up error - feeling sick -- test -- [% TRY %] [% THROW up 'feeling sick' %] [% CATCH %] [% e %] [% END %] -- expect -- up error - feeling sick -- test -- [% TRY; THROW food 'cabbage'; CATCH DEFAULT; "caught $e.info"; END %] -- expect -- caught cabbage -- test -- [% TRY; THROW food 'cabbage'; CATCH food; "caught food: $e.info\n"; CATCH DEFAULT; "caught default: $e.info"; END %] -- expect -- caught food: cabbage -- test -- [% TRY; PROCESS no_such_file; CATCH; "error: $error\n"; END; %] -- expect -- error: file error - no_such_file: not found Template-Toolkit-3.102/t/zz-pod-coverage.t0000644000000000000000000000321713600243610017055 0ustar rootroot#============================================================= -*-perl-*- # # t/pod_coverage.t # # Use Test::Pod::Coverage (if available) to test the POD documentation. # # Written by Andy Wardley # # Copyright (C) 2008-2013 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Test::More; plan( skip_all => "Author tests not required for installation" ) unless $ENV{ RELEASE_TESTING } or $ENV{ AUTHOR_TESTING }; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; plan tests => 11; # still got some work to do on getting all modules full documented pod_coverage_ok('Template'); pod_coverage_ok('Template::Base'); pod_coverage_ok('Template::Config'); pod_coverage_ok('Template::Context'); pod_coverage_ok('Template::Document'); #pod_coverage_ok('Template::Exception'); #pod_coverage_ok('Template::Filters'); pod_coverage_ok('Template::Iterator'); #pod_coverage_ok('Template::Parser'); #pod_coverage_ok('Template::Plugin'); pod_coverage_ok('Template::Plugins'); pod_coverage_ok('Template::Provider'); pod_coverage_ok('Template::Service'); pod_coverage_ok('Template::Stash'); #pod_coverage_ok('Template::Test'); #pod_coverage_ok('Template::View'); #pod_coverage_ok('Template::VMethods'); pod_coverage_ok('Template::Namespace::Constants'); #pod_coverage_ok('Template::Stash::Context'); #pod_coverage_ok('Template::Stash::XS'); #all_pod_coverage_ok(); Template-Toolkit-3.102/t/assert.t0000644000000000000000000000504313600243610015341 0ustar rootroot#============================================================= -*-perl-*- # # t/assert.t # # Test the assert plugin which throws error if undefined values are # returned. # # Written by Andy Wardley # # Copyright (C) 1996-2008 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ); use Template::Test; #------------------------------------------------------------------------ # definition of test object class #------------------------------------------------------------------------ package Template::Test::Object; sub new { bless {}, shift; } sub nil { return undef; } #----------------------------------------------------------------------- # main #----------------------------------------------------------------------- package main; my $vars = { object => Template::Test::Object->new, hash => { foo => 10, bar => undef }, list => [ undef ], subref => sub { return undef }, nothing => undef, }; test_expect(\*DATA, undef, $vars); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ -- test -- ([% object.nil %]) -- expect -- () -- test -- [% USE assert; TRY; object.assert.nil; CATCH; error; END; "\n"; TRY; object.assert.zip; CATCH; error; END; %] -- expect -- assert error - undefined value for nil assert error - undefined value for zip -- test -- [% USE assert; TRY; hash.assert.bar; CATCH; error; END; "\n"; TRY; hash.assert.bam; CATCH; error; END; %] -- expect -- assert error - undefined value for bar assert error - undefined value for bam -- test -- [% USE assert; TRY; list.assert.0; CATCH; error; END; "\n"; TRY; list.assert.first; CATCH; error; END; %] -- expect -- assert error - undefined value for 0 assert error - undefined value for first -- test -- [% USE assert; TRY; list.assert.0; CATCH; error; END; "\n"; TRY; list.assert.first; CATCH; error; END; %] -- expect -- assert error - undefined value for 0 assert error - undefined value for first -- test -- [% USE assert; TRY; assert.nothing; CATCH; error; END; %] -- expect -- assert error - undefined value for nothing -- test -- [% USE assert; TRY; assert.subref; CATCH; error; END; %] -- expect -- assert error - undefined value for subref Template-Toolkit-3.102/t/document.t0000644000000000000000000000712514635371175015702 0ustar rootroot#============================================================= -*-perl-*- # # t/document.t # # Test the Template::Document module. # # Written by Andy Wardley # # Copyright (C) 1996-2022 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. # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Config; use Template::Document; $^W = 1; $Template::Test::DEBUG = 0; $Template::Document::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $DEBUG = 0; #------------------------------------------------------------------------ # define a dummy context object for runtime processing #------------------------------------------------------------------------ package Template::DummyContext; sub new { bless { }, shift } sub visit { } sub leave { } package main; #------------------------------------------------------------------------ # create a document and check accessor methods for blocks and metadata #------------------------------------------------------------------------ my $doc = Template::Document->new({ BLOCK => sub { my $c = shift; return "some output" }, DEFBLOCKS => { foo => sub { return 'the foo block' }, bar => sub { return 'the bar block' }, }, METADATA => { author => 'Andy Wardley', version => 3.14, }, }); my $c = Template::DummyContext->new(); ok( $doc ); ok( $doc->author() eq 'Andy Wardley' ); ok( $doc->version() == 3.14 ); ok( $doc->process($c) eq 'some output' ); ok( ref($doc->block()) eq 'CODE' ); ok( ref($doc->blocks->{ foo }) eq 'CODE' ); ok( ref($doc->blocks->{ bar }) eq 'CODE' ); ok( &{ $doc->block } eq 'some output' ); ok( &{ $doc->blocks->{ foo } } eq 'the foo block' ); ok( &{ $doc->blocks->{ bar } } eq 'the bar block' ); my $dir = -d 't' ? 't/test' : 'test'; my $tproc = Template->new({ INCLUDE_PATH => "$dir/src", }); test_expect(\*DATA, $tproc, { mydoc => $doc }); __END__ -- test -- # test metadata [% META author = 'Tom Smith' version = 1.23 -%] version [% template.version %] by [% template.author %] -- expect -- version 1.23 by Tom Smith # test local block definitions are accessible -- test -- [% BLOCK foo -%] This is block foo [% INCLUDE bar -%] This is the end of block foo [% END -%] [% BLOCK bar -%] This is block bar [% END -%] [% PROCESS foo %] -- expect -- This is block foo This is block bar This is the end of block foo -- test -- [% META title = 'My Template Title' -%] [% BLOCK header -%] title: [% template.title or title %] [% END -%] [% INCLUDE header %] -- expect -- title: My Template Title -- test -- [% BLOCK header -%] HEADER component title: [% component.name %] template title: [% template.name %] [% END -%] component title: [% component.name %] template title: [% template.name %] [% PROCESS header %] -- expect -- component title: input text template title: input text HEADER component title: header template title: input text -- test -- [% META title = 'My Template Title' -%] [% BLOCK header -%] title: [% title or template.title %] [% END -%] [% INCLUDE header title = 'A New Title' %] [% INCLUDE header %] -- expect -- title: A New Title title: My Template Title -- test -- [% INCLUDE $mydoc %] -- expect -- some output -- stop -- # test for component.caller and component.callers patch -- test -- [% INCLUDE one; INCLUDE two; INCLUDE three; %] -- expect -- one, three two, three Template-Toolkit-3.102/t/zz-pmv.t0000644000000000000000000000222713600243610015304 0ustar rootroot#!/usr/bin/perl # Test that our declared minimum Perl version matches our syntax use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Perl::MinimumVersion 1.20', 'Test::MinimumVersion 0.008', ); # Don't run tests for installs use Test::More; # NOTE: Perl::MinimumVersion / PPI can't parse hash definitions with utf8 # values or keys. That means that t/stash-xs-unicode.t always fails. We # have no option but to disable this test until PPI can handle this case # or Test::MinimumVersion gives us a way to specify files to skip. plan( skip_all => "These aren't the tests you're looking for... move along" ); # NOTHING RUN PAST THIS POINT unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } #all_minimum_version_ok(5.006); minimum_version_ok('t/stash-xs-unicode.t', 5.006); Template-Toolkit-3.102/t/stop.t0000644000000000000000000000534414232015000015021 0ustar rootroot#============================================================= -*-perl-*- # # t/stop.t # # Test the [% STOP %] directive. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ../blib/lib ../blib/arch ./blib/lib ./blib/arch ); our $DEBUG; use Template::Test; use Template::Parser; use Template::Exception; use File::Spec; # MacOS Catalina won't allow Dynaloader to load from relative paths # Error: file system relative paths not allowed in hardened program @INC = map { File::Spec->rel2abs($_) } @INC; #$Template::Parser::DEBUG = 1; $DEBUG = 1; my $ttblocks = { header => sub { "This is the header\n" }, footer => sub { "This is the footer\n" }, halt1 => sub { die Template::Exception->new('stop', 'big error') }, }; my $ttvars = { halt => sub { die Template::Exception->new('stop', 'big error') }, }; my $ttbare = Template->new(BLOCKS => $ttblocks); my $ttwrap = Template->new({ PRE_PROCESS => 'header', POST_PROCESS => 'footer', BLOCKS => $ttblocks, }); test_expect(\*DATA, [ bare => $ttbare, wrapped => $ttwrap ], $ttvars); __END__ -- test -- This is some text [% STOP %] More text -- expect -- This is some text -- test -- This is some text [% halt %] More text -- expect -- This is some text -- test -- This is some text [% INCLUDE halt1 %] More text -- expect -- This is some text -- test -- This is some text [% INCLUDE myblock1 %] More text [% BLOCK myblock1 -%] This is myblock1 [% STOP %] more of myblock1 [% END %] -- expect -- This is some text This is myblock1 -- test -- This is some text [% INCLUDE myblock2 %] More text [% BLOCK myblock2 -%] This is myblock2 [% halt %] more of myblock2 [% END %] -- expect -- This is some text This is myblock2 #------------------------------------------------------------------------ # ensure 'stop' exceptions get ignored by TRY...END blocks #------------------------------------------------------------------------ -- test -- before [% TRY -%] trying [% STOP -%] tried [% CATCH -%] caught [[% error.type %]] - [% error.info %] [% END %] after -- expect -- before trying #------------------------------------------------------------------------ # ensure PRE_PROCESS and POST_PROCESS templates get added with STOP #------------------------------------------------------------------------ -- test -- -- use wrapped -- This is some text [% STOP %] More text -- expect -- This is the header This is some text This is the footer Template-Toolkit-3.102/t/config.t0000644000000000000000000001473313600243620015314 0ustar rootroot#============================================================= -*-perl-*- # # t/config.t # # Test the Template::Config module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); our $DEBUG; use Template::Test; use Template::Config; ntests(44); $DEBUG = 0; $Template::Config::DEBUG = 0; my $factory = 'Template::Config'; #------------------------------------------------------------------------ # parser #------------------------------------------------------------------------ print STDERR "Testing parser...\n" if $DEBUG; my $parser; $parser = $factory->parser(PRE_CHOMP => 1, INTERPOLATE => 1) || print STDERR $factory->error(), "\n"; ok( $parser ); ok( $parser->{ PRE_CHOMP } == 1); ok( $parser->{ INTERPOLATE } == 1); $parser = $factory->parser({ POST_CHOMP => 1 }) || print STDERR $factory->error(), "\n"; ok( $parser ); ok( $parser->{ POST_CHOMP } == 1); #------------------------------------------------------------------------ # provider #------------------------------------------------------------------------ print STDERR "Testing provider...\n" if $DEBUG; my $provider; $provider = $factory->provider(INCLUDE_PATH => 'here:there', PARSER => $parser) || print STDERR $factory->error(), "\n"; ok( $provider ); ok( join('...', @{ $provider->{ INCLUDE_PATH } }) eq 'here...there' ); ok( $provider->{ PARSER }->{ POST_CHOMP } == 1); $provider = $factory->provider({ INCLUDE_PATH => 'cat:mat', ANYCASE => 1, INTERPOLATE => 1 }) || print STDERR $factory->error(), "\n"; ok( $provider ); ok( join('...', @{ $provider->{ INCLUDE_PATH } }) eq 'cat...mat' ); # force provider to instantiate a parser and check it uses the correct # parameters. my $text = 'The cat sat on the mat'; ok( $provider->fetch(\$text) ); ok( $provider->{ PARSER }->{ ANYCASE } == 1); ok( $provider->{ PARSER }->{ INTERPOLATE } == 1); #------------------------------------------------------------------------ # plugins #------------------------------------------------------------------------ print STDERR "Testing plugins...\n" if $DEBUG; my $plugins; $plugins = $factory->plugins(PLUGIN_BASE => 'MyPlugins') || print STDERR $factory->error(), "\n"; ok( $plugins ); ok( join('+', @{$plugins->{ PLUGIN_BASE }}) eq 'MyPlugins+Template::Plugin' ); $plugins = $factory->plugins({ LOAD_PERL => 1, PLUGIN_BASE => 'NewPlugins', }) || print STDERR $factory->error(), "\n"; ok( $plugins ); ok( $plugins->{ LOAD_PERL } == 1 ); ok( join('+', @{$plugins->{ PLUGIN_BASE }}) eq 'NewPlugins+Template::Plugin' ); #------------------------------------------------------------------------ # filters #------------------------------------------------------------------------ print STDERR "Testing filters...\n" if $DEBUG; my $filters; $filters = $factory->filters(TOLERANT => 1) || print STDERR $factory->error(), "\n"; ok( $filters ); ok( $filters->{ TOLERANT } == 1); $filters = $factory->filters({ TOLERANT => 1 }) || print STDERR $factory->error(), "\n"; ok( $filters ); ok( $filters->{ TOLERANT } == 1); #------------------------------------------------------------------------ # stash #------------------------------------------------------------------------ print STDERR "Testing stash...\n" if $DEBUG; my $stash; $stash = $factory->stash(foo => 10, bar => 20) || print STDERR $factory->error(), "\n"; ok( $stash ); ok( $stash->get('foo') == 10); ok( $stash->get('bar') == 20); $stash = $factory->stash({ foo => 30, bar => sub { 'forty' }, }) || print STDERR $factory->error(), "\n"; ok( $stash ); ok( $stash->get('foo') == 30); ok( $stash->get('bar') eq 'forty' ); #------------------------------------------------------------------------ # context #------------------------------------------------------------------------ print STDERR "Testing context...\n" if $DEBUG; my $context; $context = $factory->context() || print STDERR $factory->error(), "\n"; ok( $context ); $context = $factory->context(INCLUDE_PATH => 'anywhere') || print STDERR $factory->error(), "\n"; ok( $context ); ok( $context->{ LOAD_TEMPLATES }->[0]->{ INCLUDE_PATH }->[0] eq 'anywhere' ); $context = $factory->context({ LOAD_TEMPLATES => [ $provider ], LOAD_PLUGINS => [ $plugins ], LOAD_FILTERS => [ $filters ], STASH => $stash, }) || print STDERR $factory->error(), "\n"; ok( $context ); ok( $context->stash->get('foo') == 30 ); ok( $context->{ LOAD_TEMPLATES }->[0]->{ PARSER }->{ INTERPOLATE } == 1); ok( $context->{ LOAD_PLUGINS }->[0]->{ LOAD_PERL } == 1 ); ok( $context->{ LOAD_FILTERS }->[0]->{ TOLERANT } == 1 ); #------------------------------------------------------------------------ # service #------------------------------------------------------------------------ print STDERR "Testing service...\n" if $DEBUG; my $service; $service = $factory->service(INCLUDE_PATH => 'amsterdam') || print STDERR $factory->error(), "\n"; ok( $service ); ok( $service->{ CONTEXT }->{ LOAD_TEMPLATES }->[0]->{ INCLUDE_PATH }->[0] eq 'amsterdam' ); #------------------------------------------------------------------------ # iterator #------------------------------------------------------------------------ print STDERR "Testing iterator...\n" if $DEBUG; my ($iterator, $value, $error); $iterator = $factory->iterator([qw(foo bar baz)]) || print STDERR $factory->error(), "\n"; ok( $iterator ); ($value, $error) = $iterator->get_first(); ok( $value eq 'foo' ); ($value, $error) = $iterator->get_next(); ok( $value eq 'bar' ); ($value, $error) = $iterator->get_next(); ok( $value eq 'baz' ); #------------------------------------------------------------------------ # instdir #------------------------------------------------------------------------ my $idir = Template::Config->instdir(); if ($Template::Config::INSTDIR) { ok( $idir eq $Template::Config::INSTDIR ); } else { ok( ! defined($idir) && $Template::Config::ERROR eq 'no installation directory' ); } my $tdir = Template::Config->instdir('templates'); if ($Template::Config::INSTDIR) { ok( $tdir eq "$Template::Config::INSTDIR/templates" ); } else { ok( ! defined($tdir) && $Template::Config::ERROR eq 'no installation directory' ); } Template-Toolkit-3.102/t/file.t0000644000000000000000000000557413600243610014770 0ustar rootroot#============================================================= -*-perl-*- # # t/file.t # # Tests the File plugin. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Plugin::File; $^W = 1; if ($^O eq 'MSWin32') { skip_all('skipping tests on MS Win 32 platform'); } # my $dir = -d 't' ? 't/test' : 'test'; my $file = "$dir/src/foo"; my @stat; (@stat = stat $file) || die "$file: $!\n"; my $vars = { dir => $dir, file => $file, }; @$vars{ @Template::Plugin::File::STAT_KEYS } = @stat; test_expect(\*DATA, undef, $vars); __DATA__ -- test -- [% USE f = File('/foo/bar/baz.html', nostat=1) -%] p: [% f.path %] r: [% f.root %] n: [% f.name %] d: [% f.dir %] e: [% f.ext %] h: [% f.home %] a: [% f.abs %] -- expect -- p: /foo/bar/baz.html r: n: baz.html d: /foo/bar e: html h: ../.. a: /foo/bar/baz.html -- test -- [% USE f = File('foo/bar/baz.html', nostat=1) -%] p: [% f.path %] r: [% f.root %] n: [% f.name %] d: [% f.dir %] e: [% f.ext %] h: [% f.home %] a: [% f.abs %] -- expect -- p: foo/bar/baz.html r: n: baz.html d: foo/bar e: html h: ../.. a: foo/bar/baz.html -- test -- [% USE f = File('baz.html', nostat=1) -%] p: [% f.path %] r: [% f.root %] n: [% f.name %] d: [% f.dir %] e: [% f.ext %] h: [% f.home %] a: [% f.abs %] -- expect -- p: baz.html r: n: baz.html d: e: html h: a: baz.html -- test -- [% USE f = File('bar/baz.html', root='/foo', nostat=1) -%] p: [% f.path %] r: [% f.root %] n: [% f.name %] d: [% f.dir %] e: [% f.ext %] h: [% f.home %] a: [% f.abs %] -- expect -- p: bar/baz.html r: /foo n: baz.html d: bar e: html h: .. a: /foo/bar/baz.html -- test -- [% USE f = File('bar/baz.html', root='/foo', nostat=1) -%] p: [% f.path %] h: [% f.home %] rel: [% f.rel('wiz/waz.html') %] -- expect -- p: bar/baz.html h: .. rel: ../wiz/waz.html -- test -- [% USE baz = File('foo/bar/baz.html', root='/tmp/tt2', nostat=1) -%] [% USE waz = File('wiz/woz/waz.html', root='/tmp/tt2', nostat=1) -%] [% baz.rel(waz) %] -- expect -- ../../wiz/woz/waz.html -- test -- [% USE f = File('foo/bar/baz.html', nostat=1) -%] [[% f.atime %]] -- expect -- [] -- test -- [% USE f = File(file) -%] [% f.path %] [% f.name %] -- expect -- -- process -- [% dir %]/src/foo foo -- test -- [% USE f = File(file) -%] [% f.path %] [% f.mtime %] -- expect -- -- process -- [% dir %]/src/foo [% mtime %] -- test -- [% USE file(file) -%] [% file.path %] [% file.mtime %] -- expect -- -- process -- [% dir %]/src/foo [% mtime %] -- test -- [% TRY -%] [% USE f = File('') -%] n: [% f.name %] [% CATCH -%] Drat, there was a [% error.type %] error. [% END %] -- expect -- Drat, there was a File error. Template-Toolkit-3.102/t/directive.t0000644000000000000000000001141313600243610016014 0ustar rootroot#============================================================= -*-perl-*- # # t/directive.t # # Test basic directive layout and processing options. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; my $ttobjs = [ tt => Template->new(), pre => Template->new( PRE_CHOMP => 1 ), post => Template->new( POST_CHOMP => 1 ), trim => Template->new( INCLUDE_PATH => -d 't' ? 't/test/lib' : 'test/lib', TRIM => 1 ), ]; test_expect(\*DATA, $ttobjs, callsign); __DATA__ #------------------------------------------------------------------------ # basic directives #------------------------------------------------------------------------ -- test -- [% a %] [%a%] -- expect -- alpha alpha -- test -- pre [% a %] pre[% a %] -- expect -- pre alpha prealpha -- test -- [% a %] post [% a %]post -- expect -- alpha post alphapost -- test -- pre [% a %] post pre[% a %]post -- expect -- pre alpha post prealphapost -- test -- [% a %][%b%][% c %] -- expect -- alphabravocharlie -- test -- [% a %][%b %][% c %][% d %] -- expect -- alphabravocharliedelta #------------------------------------------------------------------------ # comments #------------------------------------------------------------------------ -- test -- [%# this is a comment which should be ignored in totality %]hello world -- expect -- hello world -- test -- [% # this is a one-line comment a %] -- expect -- alpha -- test -- [% # this is a two-line comment a = # here's the next line b -%] [% a %] -- expect -- bravo -- test -- [% a = c # this is a comment on the end of the line b = d # so is this -%] a: [% a %] b: [% b %] -- expect -- a: charlie b: delta #------------------------------------------------------------------------ # manual chomping #------------------------------------------------------------------------ -- test -- [% a %] [% b %] -- expect -- alpha bravo -- test -- [% a -%] [% b %] -- expect -- alphabravo -- test -- [% a -%] [% b %] -- expect -- alpha bravo -- test -- [% a %] [%- b %] -- expect -- alphabravo -- test -- [% a %] [%- b %] -- expect -- alphabravo -- test -- start [% a %] [% b %] end -- expect -- start alpha bravo end -- test -- start [%- a %] [% b -%] end -- expect -- startalpha bravoend -- test -- start [%- a -%] [% b -%] end -- expect -- startalphabravoend -- test -- start [%- a %] [%- b -%] end -- expect -- startalphabravoend #------------------------------------------------------------------------ # PRE_CHOMP enabled #------------------------------------------------------------------------ -- test -- -- use pre -- start [% a %] mid [% b %] end -- expect -- startalpha midbravo end -- test -- start [% a %] mid [% b %] end -- expect -- startalpha midbravo end -- test -- start [%+ a %] mid [% b %] end -- expect -- start alpha midbravo end -- test -- start [%+ a %] mid [% b %] end -- expect -- start alpha midbravo end -- test -- start [%- a %] mid [%- b %] end -- expect -- startalpha midbravo end #------------------------------------------------------------------------ # POST_CHOMP enabled #------------------------------------------------------------------------ -- test -- -- use post -- start [% a %] mid [% b %] end -- expect -- start alphamid bravoend -- test -- start [% a %] mid [% b %] end -- expect -- start alphamid bravoend -- test -- start [% a +%] mid [% b %] end -- expect -- start alpha mid bravoend -- test -- start [% a +%] [% b +%] end -- expect -- start alpha bravo end -- test -- start [% a -%] mid [% b -%] end -- expect -- start alphamid bravoend #------------------------------------------------------------------------ # TRIM enabled #------------------------------------------------------------------------ -- test -- -- use trim -- [% INCLUDE trimme %] -- expect -- I am a template element file which will get TRIMmed -- test -- [% BLOCK foo %] this is block foo [% END -%] [% BLOCK bar %] this is block bar [% END %] [% INCLUDE foo %] [% INCLUDE bar %] end -- expect -- this is block foo this is block bar end -- test -- [% PROCESS foo %] [% PROCESS bar %] [% BLOCK foo %] this is block foo [% END -%] [% BLOCK bar %] this is block bar [% END -%] end -- expect -- this is block foo this is block bar end -- test -- [% r; r = s; "-"; r %]. -- expect -- romeo-sierra. -- test -- [% IF a; b; ELSIF c; d; ELSE; s; END %] -- expect -- bravo Template-Toolkit-3.102/t/compile2.t0000644000000000000000000000525414232015000015546 0ustar rootroot#============================================================= -*-perl-*- # # t/compile2.t # # Test that the compiled template files written by compile1.t can be # loaded and used. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use File::Spec; $^W = 1; # script may be being run in distribution root or 't' directory my @dir = -d 't' ? qw(t test src) : qw(test src); my $dir = File::Spec->catfile(@dir); my $zero = File::Spec->catfile(@dir, 'divisionbyzero'); my $ttcfg = { POST_CHOMP => 1, INCLUDE_PATH => $dir, COMPILE_EXT => '.ttc', CONSTANTS => { zero => $zero, }, }; my $compiled = "$dir/foo.ttc"; # check compiled template files exist ok( -f $compiled ); ok( -f "$dir/complex.ttc" ); # ensure template metadata is saved in compiled file (bug fixed in v2.00) my $out = ''; my $tt = Template->new($ttcfg); ok( $tt->process('baz', { showname => 1 }, \$out) ); ok( scalar $out =~ /^name: baz/ ); # we're going to hack on the foo.ttc file to change some key text. # this way we can tell that the template was loaded from the compiled # version and not the source. my @current_times = (stat $compiled)[8,9]; open(FOO, '<', $compiled) || die "$compiled: $!\n"; local $/ = undef; my $foo = ; close(FOO); $foo =~ s/the foo file/the hacked foo file/; open(FOO, ">", $compiled) || die "$compiled: $!\n"; print FOO $foo; close(FOO); # Set mtime back to what it was utime( @current_times, $compiled ); test_expect(\*DATA, $ttcfg); __DATA__ -- test -- [% INCLUDE foo a = 'any value' %] -- expect -- This is the hacked foo file, a is any value -- test -- [% META author => 'billg' version => 6.66 %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: billg, version: 6.66 - 3 - 2 - 1 -- test -- [% META author => 'billg' version => 6.66 %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: billg, version: 6.66 - 3 - 2 - 1 -- test -- [%- # second pass, reads the compiled code from cache -%] [% INCLUDE divisionbyzero -%] -- expect -- -- process -- undef error - Illegal division by zero at [% constants.zero %] line 1, chunk 1. Template-Toolkit-3.102/t/compile1.t0000644000000000000000000000417513600243610015556 0ustar rootroot#============================================================= -*-perl-*- # # t/compile1.t # # Test the facility for the Template::Provider to maintain a persistance # cache of compiled templates by writing generated Perl code to files. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use File::Spec; # declare extra tests to follow test_expect(); $Template::Test::EXTRA = 2; # script may be being run in distribution root or 't' directory my @dir = -d 't' ? qw(t test src) : qw(test src); my $dir = File::Spec->catfile(@dir); my $zero = File::Spec->catfile(@dir, 'divisionbyzero'); my $ttcfg = { POST_CHOMP => 1, INCLUDE_PATH => $dir, COMPILE_EXT => '.ttc', EVAL_PERL => 1, CONSTANTS => { zero => $zero, }, }; # delete any existing files foreach my $f ( "$dir/foo.ttc", "$dir/complex.ttc", "$dir/divisionbyzero.ttc" ) { ok( unlink($f) ) if -f $f; } test_expect(\*DATA, $ttcfg); # $EXTRA tests ok( -f "$dir/foo.ttc" ); ok( -f "$dir/complex.ttc" ); __DATA__ -- test -- [% INCLUDE evalperl %] -- expect -- This file includes a perl block. -- test -- [% TRY %] [% INCLUDE foo %] [% CATCH file %] Error: [% error.type %] - [% error.info %] [% END %] -- expect -- This is the foo file, a is -- test -- [% META author => 'abw' version => 3.14 %] [% INCLUDE complex %] -- expect -- This is the header, title: Yet Another Template Test This is a more complex file which includes some BLOCK definitions This is the footer, author: abw, version: 3.14 - 3 - 2 - 1 -- test -- [% INCLUDE baz %] -- expect -- This is the baz file, a: -- test -- [%- # first pass, writes the compiled code to cache -%] [% INCLUDE divisionbyzero -%] -- expect -- -- process -- undef error - Illegal division by zero at [% constants.zero %] line 1. Template-Toolkit-3.102/t/format.t0000644000000000000000000000344314635371175015353 0ustar rootroot#============================================================= -*-perl-*- # # t/format.t # # Template script testing the format plugin. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; $Template::Test::PRESERVE = 1; my ($a, $b, $c, $d) = qw( alpha bravo charlie delta ); my $params = { 'a' => $a, 'b' => $b, 'c' => $c, 'd' => $d, }; test_expect(\*DATA, { INTERPOLATE => 1, POST_CHOMP => 1 }, $params); #------------------------------------------------------------------------ # test input #------------------------------------------------------------------------ __DATA__ [% USE format %] [% bold = format('%s') %] [% ital = format('%s') %] [% bold('heading') +%] [% ital('author') +%] ${ ital('affil.') } [% bold('footing') +%] $bold -- expect -- heading author affil. footing -- test -- [% USE format('
  • %s') %] [% FOREACH item = [ a b c d ] %] [% format(item) +%] [% END %] -- expect --
  • alpha
  • bravo
  • charlie
  • delta -- test -- [% USE bold = format("%s") %] [% USE ital = format("%s") %] [% bold('This is bold') +%] [% ital('This is italic') +%] -- expect -- This is bold This is italic -- test -- [% USE padleft = format('%-*s') %] [% USE padright = format('%*s') %] [% padleft(10, a) %]-[% padright(10, b) %] -- expect -- alpha - bravo Template-Toolkit-3.102/t/error.t0000644000000000000000000000167113600243610015174 0ustar rootroot#============================================================= -*-perl-*- # # t/error.t # # Test that errors are propagated back to the caller as a # Template::Exception object. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ../lib ); use Template::Constants qw( :status ); use Template::Test; $^W = 1; my $template = Template->new({ BLOCKS => { badinc => "[% INCLUDE nosuchfile %]", }, }); ok( ! $template->process('badinc') ); my $error = $template->error(); ok( $error ); ok( ref $error eq 'Template::Exception' ); ok( $error->type eq 'file' ); ok( $error->info eq 'nosuchfile: not found' ); Template-Toolkit-3.102/t/anycase.t0000644000000000000000000000424414232015000015455 0ustar rootroot#============================================================= -*-perl-*- # # t/anycase.t # # Test the ANYCASE option. This allows directive keywords to be specified # in lower case. The problem is that it would usually preclude the use of # variables of the same name, or even hash keys matching directive keywords. # # Here's a simplified version of a real-life example: # # [% # page = { wrapper = 'html '}; # wrap = page.wrapper; # "some content" WRAPPER $wrap # %] # # I've added a couple of custom rules in the tokeniser to assume keywords # aren't actually keywords if they follow a dot (e.g. page.wrapper) or # precede an equals sign (e.g. { wrapper = 'html' }). # # Written by Andy Wardley # # Copyright (C) 1996-2020 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. # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; ok(1); my $tt_vanilla = Template->new; my $tt_anycase = Template->new({ ANYCASE => 1, TAG_STYLE => 'outline', }); my $engines = [ default => $tt_vanilla, anycase => $tt_anycase, ]; test_expect(\*DATA, $engines, callsign); __DATA__ -- test -- -- name ANYCASE -- -- use anycase -- %% page = { wrapper = 'html', include = 'header', next = 'about.html' } wrapper: [% page.wrapper %] include: [% page.include %] next: [% page.next %] [% BLOCK html %][% content %][% END -%] %% wrapper $page.wrapper Hello World! %%- end %% w = page.wrapper %% wrapper $w Much cool! %%- end -- expect -- wrapper: html include: header next: about.html Hello World!Much cool! -- test -- -- name template name is a keyword -- %% block view This is the view %% end view: [% include view %] -- expect -- view: This is the view -- test -- -- name different kinds of include -- %% block include This is the included template %% end %% include = include include inc: [% GET include %] -- expect -- inc: This is the included template Template-Toolkit-3.102/t/leak.t0000644000000000000000000001201213600243620014747 0ustar rootroot#============================================================= -*-perl-*- # # t/leak.t # # Attempts to detect memory leaks... but fails. That's a Good Thing # if it means there are no memory leaks (in this particular aspect) # or a Bad Thing if it there are, but we're not smart enough to detect # them. :-) # # Written by Andy Wardley # # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2001 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ../blib/arch ); use Template::Test; $^W = 1; $Template::Test::PRESERVE = 1; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; #------------------------------------------------------------------------ package Holler; our ( $TRACE, $PREFIX ); $TRACE = ''; $PREFIX = 'Holler:'; sub new { my $class = shift; my $id = shift || ''; my $self = bless \$id, $class; $self->trace("created"); return $self; } sub trace { my $self = shift; $TRACE .= "$$self @_\n"; } sub clear { $TRACE = ''; return ''; } sub DESTROY { my $self = shift; $self->trace("destroyed"); } #------------------------------------------------------------------------ package Plugin::Holler; use base qw( Template::Plugin ); sub new { my ($class, $context, @args) = @_; bless { context => $context, holler => Holler->new(@args), }, $class; } sub trace { my $self = shift; $self->{ context }->process('trace'); } #------------------------------------------------------------------------ package main; my $ttcfg = { INCLUDE_PATH => -d 't' ? 't/test/src' : 'test/src', PLUGIN_FACTORY => { holler => 'Plugin::Holler' }, EVAL_PERL => 1, BLOCKS => { trace => "TRACE ==[% trace %]==", }, }; my $ttvars = { holler => sub { Holler->new(@_) }, trace => sub { $Holler::TRACE }, clear => \&Holler::clear, v56 => ( $^V && eval '$^V ge v5.6.0' && eval '$^V le v5.7.0' ), }; test_expect(\*DATA, $ttcfg, $ttvars); __DATA__ -- test -- [% a = holler('first'); trace %] -- expect -- first created -- test -- [% trace %] -- expect -- first created first destroyed -- test -- [% clear; b = [ ]; b.0 = holler('list'); trace %] -- expect -- list created -- test -- [% trace %] -- expect -- list created list destroyed -- stop -- -- test -- [% BLOCK shout; a = holler('second'); END -%] [% clear; PROCESS shout; trace %] -- expect -- second created -- test -- [% BLOCK shout; a = holler('third'); END -%] [% clear; INCLUDE shout; trace %] -- expect -- third created third destroyed -- test -- [% MACRO shout BLOCK; a = holler('fourth'); END -%] [% clear; shout; trace %] -- expect -- fourth created fourth destroyed -- test -- [% clear; USE holler('holler plugin'); trace %] -- expect -- holler plugin created -- test -- [% BLOCK shout; USE holler('process plugin'); END -%] [% clear; PROCESS shout; holler.trace %] -- expect -- TRACE ==process plugin created == -- test -- [% BLOCK shout; USE holler('include plugin'); END -%] [% clear; INCLUDE shout; trace %] -- expect -- include plugin created include plugin destroyed -- test -- [% MACRO shout BLOCK; USE holler('macro plugin'); END -%] [% clear; shout; trace %] -- expect -- macro plugin created macro plugin destroyed -- test -- [% MACRO shout BLOCK; USE holler('macro plugin'); holler.trace; END -%] [% clear; shout; trace %] -- expect -- TRACE ==macro plugin created ==macro plugin created macro plugin destroyed -- test -- [% clear; PROCESS leak1; trace %] -- expect -- Hello created -- test -- [% clear; INCLUDE leak1; trace %] -- expect -- Hello created Hello destroyed -- test -- [% clear; PROCESS leak2; trace %] -- expect -- Goodbye created -- test -- [% clear; INCLUDE leak2; trace %] -- expect -- Goodbye created Goodbye destroyed -- test -- [% MACRO leak BLOCK; PROCESS leak1 + leak2; USE holler('macro plugin'); END -%] [% IF v56; clear; leak; trace; ELSE; "Perl version < 5.6.0 or > 5.7.0, skipping this test"; END -%] -- expect -- -- process -- [% IF v56 -%] Hello created Goodbye created macro plugin created Hello destroyed Goodbye destroyed macro plugin destroyed [% ELSE -%] Perl version < 5.6.0 or > 5.7.0, skipping this test [% END -%] -- test -- [% PERL %] Holler->clear(); my $h = Holler->new('perl'); $stash->set( h => $h ); [% END -%] [% trace %] -- expect -- perl created -- test -- [% BLOCK x; PERL %] Holler->clear(); my $h = Holler->new('perl'); $stash->set( h => $h ); [% END; END -%] [% x; trace %] -- expect -- perl created perl destroyed -- test -- [% MACRO y PERL %] Holler->clear(); my $h = Holler->new('perl macro'); $stash->set( h => $h ); [% END -%] [% y; trace %] -- expect -- perl macro created perl macro destroyed Template-Toolkit-3.102/t/throw.t0000644000000000000000000000370013600243610015201 0ustar rootroot#============================================================= -*-perl-*- # # t/throw.t # # Test the THROW directive. # # Written by Andy Wardley # # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; test_expect(\*DATA); __DATA__ -- test -- [% me = 'I' -%] [% TRY -%] [%- THROW chicken "Failed failed failed" 'boo' name='Fred' -%] [% CATCH -%] ERROR: [% error.type %] - [% error.info.0 %]/[% error.info.1 %]/[% error.info.name %] [% END %] -- expect -- ERROR: chicken - Failed failed failed/boo/Fred -- test -- [% TRY -%] [% THROW food 'eggs' -%] [% CATCH -%] ERROR: [% error.type %] / [% error.info %] [% END %] -- expect -- ERROR: food / eggs # test throwing multiple params -- test -- [% pi = 3.14 e = 2.718 -%] [% TRY -%] [% THROW foo pi e msg="fell over" reason="brain exploded" -%] [% CATCH -%] [% error.type %]: pi=[% error.info.0 %] e=[% error.info.1 %] I [% error.info.msg %] because my [% error.info.reason %]! [% END %] -- expect -- foo: pi=3.14 e=2.718 I fell over because my brain exploded! -- test -- [% TRY -%] [% THROW foo 'one' 2 three=3.14 -%] [% CATCH -%] [% error.type %] [% error.info.0 %] [% error.info.1 %] [% error.info.three %] [%- FOREACH e = error.info.args %] * [% e %] [%- END %] [% END %] -- expect -- foo one 2 3.14 * one * 2 -- test -- [% TRY -%] [% THROW food 'eggs' 'flour' msg="Missing Ingredients" -%] [% CATCH food -%] [% error.info.msg %] [% FOREACH item = error.info.args -%] * [% item %] [% END -%] [% END %] -- expect -- Missing Ingredients * eggs * flour Template-Toolkit-3.102/t/zz-plugin-leak.t0000644000000000000000000000402014232015000016673 0ustar rootroot#============================================================= -*-perl-*- # # t/zz-plugin-leak.t # # Test the Template::Plugins module. # # Written by Andy Wardley # # Copyright (C) 1996-2020 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. # #======================================================================== use strict; use lib qw( t/lib ./lib ../lib ../blib/arch ); use Template::Test; use Template::Plugins; use Template::Constants qw( :debug ); use Cwd qw( abs_path ); $^W = 1; my $DEBUG = grep(/^--?d(debug)?$/, @ARGV); BEGIN { unless (grep(/--dev/, @ARGV)) { skip_all('Internal test for developer, add the --dev flag to run'); } unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { skip_all("Developer tests not required for installation"); } } use Test::LeakTrace; if ($@) { skip_all('Test::LeakTrace not installed'); } ntests(2); my $dir = abs_path(-d 't' ? 't/test/plugin' : 'test/plugin'); my $src = abs_path(-d 't' ? 't/test/lib' : 'test/lib'); unshift(@INC, $dir); my ($input, $output); $output = ''; # Copy input parsing from Template::Test::test_expect eval { local $/ = undef; $input = ; }; $input =~ s/^#.*?\n//gm; $input = $' if $input =~ /\s*--\s*start\s*--\s*/; $input = $` if $input =~ /\s*--\s*stop\s*--\s*/; # Declare a processor my $tt1 = Template->new({ PLUGIN_BASE => [ 'MyPlugs', 'Template::Plugin' ], INCLUDE_PATH => $src, DEBUG => $DEBUG ? DEBUG_PLUGINS : 0, }) || die Template->error(); # Check whether processing with a double-included filter produces more than 4 leaks. leaks_cmp_ok { $tt1->process(\$input, {}, \$output); } '<', 4; # There should be none at all here. no_leaks_ok { $tt1->process(\$input, {}, \$output); } "No leaks at all"; __END__ [% USE Simple -%] [% 'world' | simple %] [% INCLUDE simple2 %] [% 'hello' | simple %] Template-Toolkit-3.102/t/varsv1.t0000644000000000000000000002173113600243610015264 0ustar rootroot#============================================================= -*-perl-*- # # t/varsv1.t # # Template script testing variable use with version 1 compatibility. # In version 1, leading '$' on variables were ignored. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Constants qw( :status ); $^W = 1; $Template::Test::DEBUG = 0; # sample data my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z) = qw( alpha bravo charlie delta echo foxtrot golf hotel india juliet kilo lima mike november oscar papa quebec romeo sierra tango umbrella victor whisky x-ray yankee zulu ); my @days = qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday ); my $day = -1; my $count = 0; my $params = { 'a' => $a, 'b' => $b, 'c' => $c, 'd' => $d, 'e' => $e, 'f' => { 'g' => $g, 'h' => $h, 'i' => { 'j' => $j, 'k' => $k, }, }, 'l' => $l, 'r' => $r, 's' => $s, 't' => $t, 'w' => $w, 'n' => sub { $count }, 'up' => sub { ++$count }, 'down' => sub { --$count }, 'reset' => sub { $count = shift(@_) || 0 }, 'undef' => sub { undef }, 'zero' => sub { 0 }, 'one' => sub { 'one' }, 'halt' => sub { die Template::Exception->new('stop', 'stopped') }, 'join' => sub { join(shift, @_) }, 'split' => sub { my $s = shift; $s = quotemeta($s); my @r = split(/$s/, shift); \@r }, 'magic' => { 'chant' => 'Hocus Pocus', 'spell' => sub { join(" and a bit of ", @_) }, }, 'day' => { 'prev' => \&yesterday, 'this' => \&today, 'next' => \&tomorrow, }, 'belief' => \&belief, 'people' => sub { return qw( Tom Dick Larry ) }, "letter$a" => "'$a'", # don't define a 'z' - DEFAULT test relies on its non-existance }; my $tt = [ default => Template->new({ INTERPOLATE => 1, ANYCASE => 1, V1DOLLAR => 1, }), notcase => Template->new({ INTERPOLATE => 1, V1DOLLAR => 0, }) ]; test_expect(\*DATA, $tt, $params); #------------------------------------------------------------------------ # subs #------------------------------------------------------------------------ sub yesterday { return "All my troubles seemed so far away..."; } sub today { my $when = shift || 'Now'; return "$when it looks as though they're here to stay."; } sub tomorrow { my $dayno = shift; unless (defined $dayno) { $day++; $day %= 7; $dayno = $day; } return $days[$dayno]; } sub belief { my @beliefs = @_; my $b = join(' and ', @beliefs); $b = '' unless length $b; return "Oh I believe in $b."; } __DATA__ #------------------------------------------------------------------------ # GET #------------------------------------------------------------------------ -- test -- [% a %] [% $a %] [% GET b %] [% GET $b %] [% get c %] [% get $c %] -- expect -- alpha alpha bravo bravo charlie charlie -- test -- [% b %] [% $b %] [% GET b %] [% GET $b %] -- expect -- bravo bravo bravo bravo -- test -- $a $b ${c} ${d} [% $e %] -- expect -- alpha bravo charlie delta echo -- test -- [% letteralpha %] [% ${"letter$a"} %] [% GET ${"letter$a"} %] -- expect -- 'alpha' 'alpha' 'alpha' -- test -- [% f.g %] [% $f.g %] [% $f.$g %] -- expect -- golf golf golf -- test -- [% GET f.h %] [% get $f.h %] [% get f.${'h'} %] [% get $f.${'h'} %] -- expect -- hotel hotel hotel hotel -- test -- $f.h ${f.g} ${f.h}.gif -- expect -- hotel golf hotel.gif -- test -- [% f.i.j %] [% $f.i.j %] [% f.$i.j %] [% f.i.$j %] [% $f.$i.$j %] -- expect -- juliet juliet juliet juliet juliet -- test -- [% f.i.j %] [% $f.i.j %] [% GET f.i.j %] [% GET $f.i.j %] -- expect -- juliet juliet juliet juliet -- test -- [% get $f.i.k %] -- expect -- kilo -- test -- [% f.i.j %] $f.i.k [% f.${'i'}.${"j"} %] ${f.i.k}.gif -- expect -- juliet kilo juliet kilo.gif -- test -- [% 'this is literal text' %] [% GET 'so is this' %] [% "this is interpolated text containing $r and $f.i.j" %] [% GET "$t?" %] [% "$f.i.k" %] -- expect -- this is literal text so is this this is interpolated text containing romeo and juliet tango? kilo -- test -- [% name = "$a $b $w" -%] Name: $name -- expect -- Name: alpha bravo whisky -- test -- [% join('--', a b, c, f.i.j) %] -- expect -- alpha--bravo--charlie--juliet -- test -- [% text = 'The cat sat on the mat' -%] [% FOREACH word = split(' ', text) -%]<$word> [% END %] -- expect -- -- test -- [% magic.chant %] [% GET magic.chant %] [% magic.chant('foo') %] [% GET $magic.chant('foo') %] -- expect -- Hocus Pocus Hocus Pocus Hocus Pocus Hocus Pocus -- test -- <<[% magic.spell %]>> [% magic.spell(a b c) %] -- expect -- <<>> alpha and a bit of bravo and a bit of charlie -- test -- [% one %] [% one('two', 'three') %] [% one(2 3) %] -- expect -- one one one -- test -- [% day.prev %] [% day.this %] [% belief('yesterday') %] -- expect -- All my troubles seemed so far away... Now it looks as though they're here to stay. Oh I believe in yesterday. -- test -- Yesterday, $day.prev $day.this ${belief('yesterday')} -- expect -- Yesterday, All my troubles seemed so far away... Now it looks as though they're here to stay. Oh I believe in yesterday. -- test -- -- use notcase -- [% day.next %] $day.next -- expect -- Monday Tuesday -- test -- [% FOREACH [ 1 2 3 4 5 ] %]$day.next [% END %] -- expect -- Wednesday Thursday Friday Saturday Sunday -- test -- -- use default -- before [% halt %] after -- expect -- before #------------------------------------------------------------------------ # CALL #------------------------------------------------------------------------ -- test -- before [% CALL a %]a[% CALL b %]n[% CALL c %]d[% CALL d %] after -- expect -- before and after -- test -- ..[% CALL undef %].. -- expect -- .... -- test -- ..[% CALL zero %].. -- expect -- .... -- test -- ..[% n %]..[% CALL n %].. -- expect -- ..0.... -- test -- ..[% up %]..[% CALL up %]..[% n %] -- expect -- ..1....2 -- test -- [% CALL reset %][% n %] -- expect -- 0 -- test -- [% CALL reset(100) %][% n %] -- expect -- 100 #------------------------------------------------------------------------ # SET #------------------------------------------------------------------------ -- test -- [% a = a %] $a [% a = b %] $a [% a = $c %] $a [% $a = d %] $a [% $a = $e %] $a -- expect -- alpha bravo charlie delta echo -- test -- [% SET a = a %] $a [% SET a = b %] $a [% SET a = $c %] $a [% SET $a = d %] $a [% SET $a = $e %] $a -- expect -- alpha bravo charlie delta echo -- test -- [% a = b b = c c = d d = e %][% a %] [% b %] [% c %] [% d %] -- expect -- bravo charlie delta echo -- test -- [% SET a = c b = d c = e %]$a $b $c -- expect -- charlie delta echo -- test -- [% a = f.g %] $a [% a = $f.h %] $a [% a = f.i.j %] $a [% a = $f.i.k %] $a -- expect -- golf hotel juliet kilo -- test -- [% f.g = r %] $f.g [% $f.h = $r %] $f.h [% f.i.j = $s %] $f.i.j [% $f.i.k = f.i.j %] ${f.i.k} -- expect -- romeo romeo sierra sierra -- test -- [% user = { id = 'abw' name = 'Andy Wardley' callsign = "[-$a-$b-$w-]" } -%] ${user.id} ${ user.id } $user.id ${user.id}.gif [% message = "$b: ${ user.name } (${user.id}) ${ user.callsign }" -%] MSG: $message -- expect -- abw abw abw abw.gif MSG: bravo: Andy Wardley (abw) [-alpha-bravo-whisky-] -- test -- [% product = { id => 'XYZ-2000', desc => 'Bogon Generator', cost => 678, } -%] The $product.id $product.desc costs \$${product.cost}.00 -- expect -- The XYZ-2000 Bogon Generator costs $678.00 #------------------------------------------------------------------------ # DEFAULT #------------------------------------------------------------------------ -- test -- [% a %] [% DEFAULT a = b -%] [% a %] -- expect -- alpha alpha -- test -- [% a = '' -%] [% DEFAULT a = b -%] [% a %] -- expect -- bravo -- test -- [% a = '' b = '' -%] [% DEFAULT a = c b = d z = r -%] [% a %] [% b %] [% z %] -- expect -- charlie delta romeo #------------------------------------------------------------------------ # 'global' vars #------------------------------------------------------------------------ -- test -- [% global.version = '3.14' -%] Version: [% global.version %] -- expect -- Version: 3.14 -- test -- Version: [% global.version %] -- expect -- Version: 3.14 -- test -- [% global.newversion = global.version + 1 -%] Version: [% global.version %] Version: [% global.newversion %] -- expect -- Version: 3.14 Version: 4.14 -- test -- Version: [% global.version %] Version: [% global.newversion %] -- expect -- Version: 3.14 Version: 4.14 Template-Toolkit-3.102/t/stash.t0000644000000000000000000001764513600243610015175 0ustar rootroot#============================================================= -*-perl-*- # # t/stash.t # # Template script testing (some elements of) the Template::Stash # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Constants qw( :status :debug ); use Template; use Template::Stash; use Template::Config; use Template::Test; $^W = 1; my $DEBUG = grep(/-d/, @ARGV); #$Template::Parser::DEBUG = $DEBUG; #$Template::Directive::PRETTY = $DEBUG; #------------------------------------------------------------------------ # define some simple objects for testing #------------------------------------------------------------------------ package ListObject; package HashObject; sub hello { my $self = shift; return "Hello $self->{ planet }"; } sub goodbye { my $self = shift; return $self->no_such_method(); } #------------------------------------------------------------------------ # Another object for tracking down a bug with DBIx::Class where TT is # causing the numification operator to be called. Matt S Trout suggests # we've got a truth test somewhere that should be a defined but that # doesn't appear to be the case... # http://rt.cpan.org/Ticket/Display.html?id=23763 #------------------------------------------------------------------------ package Numbersome; use overload '""' => 'stringify', '0+' => 'numify', fallback => 1; sub new { my ($class, $text) = @_; bless \$text, $class; } sub numify { my $self = shift; return "FAIL: numified $$self"; } sub stringify { my $self = shift; return "PASS: stringified $$self"; } sub things { return [qw( foo bar baz )]; } package GetNumbersome; sub new { my ($class, $text) = @_; bless { }, $class; } sub num { Numbersome->new("from GetNumbersome"); } #----------------------------------------------------------------------- # another object without overloaded comparison. # http://rt.cpan.org/Ticket/Display.html?id=24044 #----------------------------------------------------------------------- package CmpOverloadObject; use overload ('cmp' => 'compare_overload', '<=>', 'compare_overload'); sub new { bless {}, shift }; sub hello { return "Hello"; } sub compare_overload { die "Mayhem!"; } package main; $Template::Config::STASH = 'Template::Stash'; my $count = 20; my $data = { foo => 10, bar => { baz => 20, }, baz => sub { return { boz => ($count += 10), biz => (shift || ''), }; }, obj => bless({ name => 'an object', }, 'AnObject'), bop => sub { return ( bless ({ name => 'an object' }, 'AnObject') ) }, hashobj => bless({ planet => 'World' }, 'HashObject'), listobj => bless([10, 20, 30], 'ListObject'), num => Numbersome->new("Numbersome"), getnum => GetNumbersome->new, cmp_ol => CmpOverloadObject->new(), clean => sub { my $error = shift; $error =~ s/(\s*\(.*?\))?\s+at.*$//; return $error; }, }; my $stash = Template::Stash->new($data); match( $stash->get('foo'), 10 ); match( $stash->get([ 'bar', 0, 'baz', 0 ]), 20 ); match( $stash->get('bar.baz'), 20 ); match( $stash->get('bar(10).baz'), 20 ); match( $stash->get('baz.boz'), 30 ); match( $stash->get('baz.boz'), 40 ); match( $stash->get('baz.biz'), '' ); match( $stash->get('baz(50).biz'), '' ); # args are ignored $stash->set( 'bar.buz' => 100 ); match( $stash->get('bar.buz'), 100 ); # test the dotop() method match( $stash->dotop({ foo => 10 }, 'foo'), 10 ); my $ttlist = [ 'default' => Template->new(), 'warn' => Template->new(DEBUG => DEBUG_UNDEF, DEBUG_FORMAT => ''), ]; test_expect(\*DATA, $ttlist, $data); __DATA__ -- test -- a: [% a %] -- expect -- a: -- test -- -- use warn -- [% TRY; a; CATCH; "ERROR: $error"; END %] -- expect -- ERROR: undef error - a is undefined -- test -- -- use default -- [% myitem = 'foo' -%] 1: [% myitem %] 2: [% myitem.item %] 3: [% myitem.item.item %] -- expect -- 1: foo 2: foo 3: foo -- test -- [% myitem = 'foo' -%] [% "* $item\n" FOREACH item = myitem -%] [% "+ $item\n" FOREACH item = myitem.list %] -- expect -- * foo + foo -- test -- [% myitem = 'foo' -%] [% myitem.hash.value %] -- expect -- foo -- test -- [% myitem = 'foo' mylist = [ 'one', myitem, 'three' ] global.mylist = mylist -%] [% mylist.item %] 0: [% mylist.item(0) %] 1: [% mylist.item(1) %] 2: [% mylist.item(2) %] -- expect -- one 0: one 1: foo 2: three -- test -- [% "* $item\n" FOREACH item = global.mylist -%] [% "+ $item\n" FOREACH item = global.mylist.list -%] -- expect -- * one * foo * three + one + foo + three -- test -- [% global.mylist.push('bar'); "* $item.key => $item.value\n" FOREACH item = global.mylist.hash -%] -- expect -- * one => foo * three => bar -- test -- [% myhash = { msg => 'Hello World', things => global.mylist, a => 'alpha' }; global.myhash = myhash -%] * [% myhash.item('msg') %] -- expect -- * Hello World -- test -- [% global.myhash.delete('things') -%] keys: [% global.myhash.keys.sort.join(', ') %] -- expect -- keys: a, msg -- test -- [% "* $item\n" FOREACH item IN global.myhash.items.sort -%] -- expect -- * a * alpha * Hello World * msg -- test -- [% items = [ 'foo', 'bar', 'baz' ]; take = [ 0, 2 ]; slice = items.$take; slice.join(', '); %] -- expect -- foo, baz -- test -- [% items = { foo = 'one', bar = 'two', baz = 'three' } take = [ 'foo', 'baz' ]; slice = items.$take; slice.join(', '); %] -- expect -- one, three -- test -- [% items = { foo = 'one', bar = 'two', baz = 'three' } keys = items.keys.sort; items.${keys}.join(', '); %] -- expect -- two, three, one -- test -- [% obj.name %] -- expect -- an object -- test -- [% obj.name.list.first %] -- expect -- an object -- test -- [% obj.items.first %] -- expect -- name -- test -- [% obj.items.1 %] -- expect -- an object -- test -- [% bop.first.name %] -- expect -- an object -- test -- [% listobj.0 %] / [% listobj.first %] -- expect -- 10 / 10 -- test -- [% listobj.2 %] / [% listobj.last %] -- expect -- 30 / 30 -- test -- [% listobj.join(', ') %] -- expect -- 10, 20, 30 -- test -- =[% size %]= -- expect -- == -- test -- [% foo = { "one" = "bar" "" = "empty" } -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} setting foo.one to baz [% fookey = "one" foo.$fookey = "baz" -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} setting foo."" to quux [% fookey = "" foo.$fookey = "full" -%] foo is { [% FOREACH k IN foo.keys.sort %]"[% k %]" = "[% foo.$k %]" [% END %]} --expect -- foo is { "" = "empty" "one" = "bar" } setting foo.one to baz foo is { "" = "empty" "one" = "baz" } setting foo."" to quux foo is { "" = "full" "one" = "baz" } # test Dave Howorth's patch (v2.15) which makes the stash more strict # about what it considers to be a missing method error -- test -- [% hashobj.hello %] -- expect -- Hello World -- test -- [% TRY; hashobj.goodbye; CATCH; "ERROR: "; clean(error); END %] -- expect -- ERROR: undef error - Can't locate object method "no_such_method" via package "HashObject" #----------------------------------------------------------------------- # try and pin down the numification bug #----------------------------------------------------------------------- -- test -- [% FOREACH item IN num.things -%] * [% item %] [% END -%] -- expect -- * foo * bar * baz -- test -- [% num %] -- expect -- PASS: stringified Numbersome -- test -- [% getnum.num %] -- expect -- PASS: stringified from GetNumbersome # Exercise the object with the funky overloaded comparison -- test -- [% cmp_ol.hello %] -- expect -- Hello Template-Toolkit-3.102/t/parser2.t0000644000000000000000000000172513600243610015421 0ustar rootroot#============================================================= -*-perl-*- # # t/parser.t # # Test the Template::Parser module. # # Written by Colin Keith # # Copyright (C) 2012 Colin Keith. All Rights Reserved # Copyright (C) 2012 Hagen Software, Inc. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( . ../lib ); use Template::Test; use Template::Config; use Template::Parser; $^W = 1; #$Template::Test::DEBUG = 0; #$Template::Test::PRESERVE = 1; #$Template::Stash::DEBUG = 1; #$Template::Parser::DEBUG = 1; #$Template::Directive::PRETTY = 1; my $p = Template::Parser->new(); my $expectedText = 'this is a test'; my($tokens) = $p->split_text(<[0]->[1], '3-4', 'Correctly exclude blank lines preceeding a directive from line number count'); 1; Template-Toolkit-3.102/t/text.t0000644000000000000000000000561713600243610015033 0ustar rootroot#============================================================= -*-perl-*- # # t/text.t # # Test general text blocks, ensuring all characters can be used. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; ok(1); #------------------------------------------------------------------------ package Stringy; use overload '""' => \&asString; sub asString { my $self = shift; return $$self; } sub new { my ($class, $val) = @_; return bless \$val, $class; } #------------------------------------------------------------------------ package main; my $tt = [ basic => Template->new(), interp => Template->new(INTERPOLATE => 1), ]; my $vars = callsign(); my $v2 = { ref => sub { my $a = shift; "$a\[" . ref($a) . ']' }, sfoo => Stringy->new('foo'), sbar => Stringy->new('bar'), }; @$vars{ keys %$v2 } = values %$v2; test_expect(\*DATA, $tt, $vars); __DATA__ -- test -- This is a text block "hello" 'hello' 1/3 1\4 $ @ { } @{ } ${ } # ~ ' ! % *foo $a ${b} $c -- expect -- This is a text block "hello" 'hello' 1/3 1\4 $ @ { } @{ } ${ } # ~ ' ! % *foo $a ${b} $c -- test -- © -- expect --
    © -- test -- [% foo = 'Hello World' -%] start [% # # [% foo %] # # -%] end -- expect -- start end -- test -- pre [% # [% PROCESS foo %] -%] mid [% BLOCK foo; "This is foo"; END %] -- expect -- pre mid -- test -- -- use interp -- This is a text block "hello" 'hello' 1/3 1\4 \$ @ { } @{ } \${ } # ~ ' ! % *foo $a ${b} $c -- expect -- This is a text block "hello" 'hello' 1/3 1\4 $ @ { } @{ } ${ } # ~ ' ! % *foo alpha bravo charlie -- test --
    © -- expect --
    © -- test -- [% foo = 'Hello World' -%] start [% # # [% foo %] # # -%] end -- expect -- start end -- test -- pre [% # # [% PROCESS foo %] # -%] mid [% BLOCK foo; "This is foo"; END %] -- expect -- pre mid -- test -- [% a = "C'est un test"; a %] -- expect -- C'est un test -- test -- [% META title = "C'est un test" -%] [% component.title -%] -- expect -- C'est un test -- test -- [% META title = 'C\'est un autre test' -%] [% component.title -%] -- expect -- C'est un autre test -- test -- [% META title = "C'est un \"test\"" -%] [% component.title -%] -- expect -- C'est un "test" -- test -- [% sfoo %]/[% sbar %] -- expect -- foo/bar -- test -- [% s1 = "$sfoo" s2 = "$sbar "; s3 = sfoo; ref(s1); '/'; ref(s2); '/'; ref(s3); -%] -- expect -- foo[]/bar []/foo[Stringy] Template-Toolkit-3.102/t/switch.t0000644000000000000000000000752313600243610015346 0ustar rootroot#============================================================= -*-perl-*- # # t/switch.t # # Template script testing SWITCH / CASE blocks # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; $^W = 1; $Template::Test::DEBUG = 0; #$Template::Parser::DEBUG = 0; my $ttcfg = { # INCLUDE_PATH => [ qw( t/test/lib test/lib ) ], POST_CHOMP => 1, }; test_expect(\*DATA, $ttcfg, &callsign()); __DATA__ #------------------------------------------------------------------------ # test simple case #------------------------------------------------------------------------ -- test -- before [% SWITCH a %] this is ignored [% END %] after -- expect -- before after -- test -- before [% SWITCH a %] this is ignored [% CASE x %] not matched [% END %] after -- expect -- before after -- test -- before [% SWITCH a %] this is ignored [% CASE not_defined %] not matched [% END %] after -- expect -- before after -- test -- before [% SWITCH a %] this is ignored [% CASE 'alpha' %] matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE a %] matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH 'alpha' %] this is ignored [% CASE a %] matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE b %] matched [% END %] after -- expect -- before after -- test -- before [% SWITCH a %] this is ignored [% CASE a %] matched [% CASE b %] not matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE b %] not matched [% CASE a %] matched [% END %] after -- expect -- before matched after #------------------------------------------------------------------------ # test default case #------------------------------------------------------------------------ -- test -- before [% SWITCH a %] this is ignored [% CASE a %] matched [% CASE b %] not matched [% CASE %] default not matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE a %] matched [% CASE b %] not matched [% CASE DEFAULT %] default not matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE z %] not matched [% CASE x %] not matched [% CASE %] default matched [% END %] after -- expect -- before default matched after -- test -- before [% SWITCH a %] this is ignored [% CASE z %] not matched [% CASE x %] not matched [% CASE DEFAULT %] default matched [% END %] after -- expect -- before default matched after #------------------------------------------------------------------------ # test multiple matches #------------------------------------------------------------------------ -- test -- before [% SWITCH a %] this is ignored [% CASE [ a b c ] %] matched [% CASE d %] not matched [% CASE %] default not matched [% END %] after -- expect -- before matched after -- test -- before [% SWITCH a %] this is ignored [% CASE [ a b c ] %] matched [% CASE a %] not matched, no drop-through [% CASE DEFAULT %] default not matched [% END %] after -- expect -- before matched after #----------------------------------------------------------------------- # regex metacharacter quoting # http://rt.cpan.org/Ticket/Display.html?id=24183 #----------------------------------------------------------------------- -- test -- [% foo = 'a(b)' bar = 'a(b)'; SWITCH foo; CASE bar; 'ok'; CASE; 'not ok'; END %] -- expect -- ok Template-Toolkit-3.102/t/process_dir.t0000644000000000000000000000353413600243610016357 0ustar rootroot#============================================================= -*-perl-*- # # t/process_dir.t # # Test the PROCESS option. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template; use Test::More; use File::Path qw (remove_tree); my $testdir = 'testdir'; my $CACHEDIR = 'ttcache'; remove_tree("$CACHEDIR", "$testdir"); my $config = {COMPILE_DIR => $CACHEDIR}; my $tt1 = Template->new($config); my $data = <<'EOF'; This is the first test [% TRY; PROCESS "testdir"; CATCH e; "error: e"; END; %] This is the end. EOF my $expected1 = "file error - $testdir: not found"; my $expected2 = $^O ne 'MSWin32' ? "file error - ./$testdir: not a file" : "file error - $testdir: not a file"; my $expected3 = <<'EOF'; This is the first test This is the end. EOF my $ret = undef; $tt1->process(\$data, {}, \$ret); is($tt1->error(), $expected1, 'Error on missing file'); mkdir($CACHEDIR, 0755); is(-d $CACHEDIR, 1, "Made cache dir ($CACHEDIR)"); mkdir($testdir, 0755); is(-d $testdir, 1, "Made test dir ($testdir)"); my $tt2 = Template->new($config); undef $ret; $tt2->process(\$data, {}, \$ret); is($tt2->error(), $expected2, 'Error on PROCESSing directory'); -f "$CACHEDIR/$testdir" && fail("Erroneous creation of 0b file with name of folder '$testdir' in cache folder"); rmdir($testdir); open(my $OUT, '>', $testdir); close($OUT); my $tt3 = Template->new($config); undef $ret; $tt3->process(\$data, {}, \$ret); is($ret, $expected3, 'Correctly PROCESSed file'); done_testing(); remove_tree("$CACHEDIR", "$testdir"); Template-Toolkit-3.102/t/zz-plugin-leak-gh-213.t0000644000000000000000000000543013600243610017610 0ustar rootroot#!/usr/bin/perl #============================================================= -*-perl-*- # # t/zz-plugin-leak-gh-213.t # # Testcase from aka GH #213 # view https://github.com/abw/Template2/pull/213 # # Written by Nicolas R. # #======================================================================== # stolen from t/filter.t need to refactor package Tie::File2Str; sub TIEHANDLE { my ( $class, $textref ) = @_; bless $textref, $class; } sub PRINT { my $self = shift; $$self .= join( '', @_ ); } package main; use lib qw( t/lib ./lib ../lib ../blib/arch ./test ); use Template; use Test::More; plan skip_all => "Broken on older perls. We need to sort this out once everything is passing"; use File::Temp qw(tempfile tempdir); plan skip_all => "Developer test only - set RELEASE_TESTING=1" unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ); plan tests => 3; # ------- t1.txt - checkleak template my $t1 = <<'EOT'; [%- USE Echo -%] [% FILTER $Echo %]foo[% END %] [% FILTER $Echo %]bar[% END %] EOT # ------- checkleak.pm a super checkleak custom filter my $plugin_echo = <<'EOT'; package Template::Plugin::Echo; use base qw(Template::Plugin::Filter); sub filter { my ($self, $text) = @_; return $text . $text; } 1; EOT my $template_tmpdir = tempdir( CLEANUP => 1 ); write_text( qq[$template_tmpdir/t1.txt], $t1 ); my $plugindir = tempdir( CLEANUP => 1 ); my $plugin_pm = qq[$plugindir/Template/Plugin/Echo.pm]; # pretty ugly but only run by authors... mkdir("$plugindir/Template") && mkdir("$plugindir/Template/Plugin"); die q[Failed to create plugindir] unless -d "$plugindir/Template/Plugin"; write_text( $plugin_pm, $plugin_echo ); unshift @INC, $plugindir; ok eval { do $plugin_pm; 1 }, "can load Template::Plugin::checkleak" or die "Failed to load Template::Plugin::checkleak - $@"; # chdir to our temporary folder with templates chdir($template_tmpdir) or die; my $tt = Template->new( { 'PLUGIN_BASE' => $plugindir } ); my $out; my $stderr; { local *STDERR; tie( *STDERR, "Tie::File2Str", \$stderr ); $tt->process( 't1.txt', {}, \$out ) || print STDERR "Error: " . $tt->error(); } # make sure we can process the template without any issues # the original bug was doing a weaken on the plugin itself.. # resulting in not being able to load it a second time is $out, <<'EXPECT', "Template processed correctly using Plugin checkleak twice"; foofoo barbar EXPECT is $stderr, undef, "no warning from process 'Reference is already weak'"; done_testing; exit; END { chdir '/' } # cd out of the temp dir. sub write_text { # could also use File::Slurper::write_file .... my ( $file, $content ) = @_; open( my $fh, '>', $file ) or die $!; print {$fh} $content; close($fh); } Template-Toolkit-3.102/t/constants.t0000644000000000000000000001210713600243610016053 0ustar rootroot#============================================================= -*-perl-*- # # t/constants.t # # Test constant folding via Template::Namespace::Constants # # Written by Andy Wardley # # Copyright (C) 1996-2002 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2002 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Stash; use Template::Directive; use Template::Parser; use Template::Namespace::Constants; my $DEBUG = grep(/-d/, @ARGV); $Template::Namespace::Constants::DEBUG = $DEBUG; my $n = 0; my $constants = { author => 'Andy \'Da Man\' Wardley', single => 'foo\'bar', double => "foo'bar", joint => ', ', col => { back => '#ffffff', text => '#000000', }, counter => sub { $n++ }, }; my $namespace = Template::Namespace::Constants->new( $constants ); ok( $namespace, 'created constants namespace' ); is( $namespace->ident([ 'constants', 0, "'author'", 0 ]), q{'Andy \'Da Man\' Wardley'}, 'author match' ); is( $namespace->ident([ 'constants', 0, "'single'", 0 ]), "'foo\\'bar'", 'single match' ); is( $namespace->ident([ 'constants', 0, "'double'", 0 ]), "'foo\\'bar'", 'double match' ); is( $namespace->ident([ 'constants', 0, "'col'", 0, "'back'", 0 ]), "'#ffffff'", 'col.back match' ); is( $namespace->ident([ 'constants', 0, "'col'", 0, "'text'", 0 ]), "'#000000'", 'col.text match' ); my $factory = Template::Directive->new({ NAMESPACE => { const => $namespace, } }); ok( $factory, 'created Template::Directive factory' ); my $parser = Template::Parser->new( FACTORY => $factory ); ok( $parser, 'created Template::Parser parser' ); my $parsed = $parser->parse(<error(), "\n" unless $parsed; my $text = $parsed->{ BLOCK }; ok( scalar $text =~ /'Andy \\'Da Man\\' Wardley'/, 'author folded' ); ok( scalar $text =~ /'back is ' . '#ffffff'/, 'col.back folded' ); ok( scalar $text =~ /stash->get\(\['col', 0, 'user', 0\]\)/, 'col.user unfolded' ); $parser = Template::Parser->new({ NAMESPACE => { const => $namespace, } }); ok( $parser, 'created Template::Parser parser' ); $parsed = $parser->parse(<error(), "\n" unless $parsed; $text = $parsed->{ BLOCK }; ok( scalar $text =~ /'Andy \\'Da Man\\' Wardley'/, 'author folded' ); ok( scalar $text =~ /'back is ' . '#ffffff'/, 'col.back folded' ); ok( scalar $text =~ /stash->get\(\['col', 0, 'user', 0\]\)/, 'col.user unfolded' ); #------------------------------------------------------------------------ my $tt1 = Template->new({ NAMESPACE => { const => $namespace, }, }); ok( $tt1, 'created tt1' ); my $const2 = { author => 'abw', joint => ' is the new ', col => { back => 'orange', text => 'black', }, fave => 'back', }; my $tt2 = Template->new({ CONSTANTS => $const2, }); ok( $tt2, 'created tt2' ); my $tt3 = Template->new({ CONSTANTS => $const2, CONSTANTS_NAMESPACE => 'const', }); ok( $tt3, 'created tt3' ); my $engines = [ tt1 => $tt1, tt2 => $tt2, tt3 => $tt3 ]; my $vars = { col => { user => 'red', luza => 'blue', }, constants => $constants, }; test_expect(\*DATA, $engines, $vars); __DATA__ -- test -- hello [% const.author %] [% "back is $const.col.back" %] and text is [% const.col.text %] col.user is [% col.user %] -- expect -- hello Andy 'Da Man' Wardley back is #ffffff and text is #000000 col.user is red -- test -- # look ma! I can even call virtual methods on contants! [% const.col.keys.sort.join(', ') %] -- expect -- back, text -- test -- # and even pass constant arguments to constant virtual methods! [% const.col.keys.sort.join(const.joint) %] -- expect -- back, text -- test -- # my constants can be subs, etc. zero [% const.counter %] one [% const.counter %] -- expect -- zero 0 one 1 -- test -- -- use tt2 -- [% "$constants.author thinks " %] [%- constants.col.values.sort.reverse.join(constants.joint) %] -- expect -- abw thinks orange is the new black -- test -- -- use tt3 -- [% "$const.author thinks " -%] [% const.col.values.sort.reverse.join(const.joint) %] -- expect -- abw thinks orange is the new black -- test -- -- name no const.foo -- no [% const.foo %]? -- expect -- no ? -- test -- fave [% const.fave %] col [% const.col.${const.fave} %] -- expect -- fave back col orange -- test -- -- use tt2 -- -- name defer references -- [% "$key\n" FOREACH key = constants.col.keys.sort %] -- expect -- back text -- test -- -- use tt3 -- a: [% const.author %] b: [% const.author = 'Fred Smith' %] c: [% const.author %] -- expect -- a: abw b: c: abw Template-Toolkit-3.102/t/service.t0000644000000000000000000001211113600243610015472 0ustar rootroot#============================================================= -*-perl-*- # # t/service.t # # Test the Template::Service module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Template::Service; use Template::Document; use Template::Constants qw( :debug ); my $DEBUG = grep(/^--?d(debug)?$/, @ARGV); my $dir = -d 't' ? 't/test' : 'test'; my $config = { INCLUDE_PATH => "$dir/src:$dir/lib", PRE_PROCESS => [ 'config', 'header' ], POST_PROCESS => 'footer', BLOCKS => { demo => sub { return 'This is a demo' }, astext => "Another template block, a is '[% a %]'", }, ERROR => { barf => 'barfed', default => 'error', }, DEBUG => $DEBUG ? DEBUG_SERVICE : 0, }; my $tt1 = Template->new($config); $config->{ AUTO_RESET } = 0; my $tt2 = Template->new($config); $config->{ ERROR } = 'barfed'; my $tt3 = Template->new($config); $config->{ PRE_PROCESS } = 'before'; $config->{ POST_PROCESS } = 'after'; $config->{ PROCESS } = 'process'; $config->{ WRAPPER } = 'outer'; my $tt4 = Template->new($config); $config->{ WRAPPER } = [ 'outer', 'inner' ]; my $tt5 = Template->new($config); my $replace = { title => 'Joe Random Title', }; test_expect(\*DATA, [ tt1 => $tt1, tt2 => $tt2, tt3 => $tt3, wrapper => $tt4, nested => $tt5, ], $replace); __END__ # test that headers and footers get added -- test -- This is some text -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' This is some text footer # test that the 'demo' block (template sub) is defined -- test -- [% INCLUDE demo %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' This is a demo footer # and also the 'astext' block (template text) -- test -- [% INCLUDE astext a = 'artifact' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' Another template block, a is 'artifact' footer # test that 'barf' exception gets redirected to the correct error template -- test -- [% THROW barf 'Not feeling too good' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' barfed: [barf] [Not feeling too good] footer # test all other errors get redirected correctly -- test -- [% INCLUDE no_such_file %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' error: [file] [no_such_file: not found] footer # import some block definitions from 'blockdef'... -- test -- [% PROCESS blockdef -%] [% INCLUDE block1 a = 'alpha' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' start of blockdef end of blockdef This is block 1, defined in blockdef, a is alpha footer # ...and make sure they go away for the next service -- test -- [% INCLUDE block1 %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' error: [file] [block1: not found] footer # now try it again with AUTO_RESET turned off... -- test -- -- use tt2 -- [% PROCESS blockdef -%] [% INCLUDE block1 a = 'alpha' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' start of blockdef end of blockdef This is block 1, defined in blockdef, a is alpha footer # ...and the block definitions should persist -- test -- [% INCLUDE block1 a = 'alpha' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' This is block 1, defined in blockdef, a is alpha footer # test that the 'demo' block is still defined -- test -- [% INCLUDE demo %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' This is a demo footer # and also the 'astext' block -- test -- [% INCLUDE astext a = 'artifact' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' Another template block, a is 'artifact' footer # test that a single ERROR template can be specified -- test -- -- use tt3 -- [% THROW food 'cabbages' %] -- expect -- header: title: Joe Random Title menu: This is the menu, defined in 'config' barfed: [food] [cabbages] footer -- test -- -- use wrapper -- [% title = 'The Foo Page' -%] begin page content title is "[% title %]" end page content -- expect -- This comes before begin process begin page content title is "The Foo Page" end page content end process This comes after -- test -- -- use nested -- [% title = 'The Bar Page' -%] begin page content title is "[% title %]" end page content -- expect -- This comes before begin process begin page content title is "The Bar Page" end page content end process This comes after Template-Toolkit-3.102/t/pod.t0000644000000000000000000000406113600243610014621 0ustar rootroot#============================================================= -*-perl-*- # # t/pod.t # # Tests the 'Pod' plugin. # # Written by Andy Wardley # # Copyright (C) 2001 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; use Carp qw( confess ); $^W = 1; $Template::Test::DEBUG = 0; $Template::Test::PRESERVE = 1; #$Template::View::DEBUG = 1; eval "use Pod::POM"; if ($@) { skip_all('Pod::POM not installed'); } my $config = { INCLUDE_PATH => 'templates:../templates', # RELATIVE => 1, # POST_CHOMP => 1, }; my $vars = { podloc => -d 't' ? 't/test/pod' : 'test/pod', }; test_expect(\*DATA, $config, $vars); __DATA__ -- test -- [% USE pod; pom = pod.parse("$podloc/no_such_file.pod"); pom ? 'not ok' : 'ok'; ' - file does not exist'; %] -- expect -- ok - file does not exist -- test -- [% USE pod; pom = pod.parse("$podloc/test1.pod"); pom ? 'ok' : 'not ok'; ' - file parsed'; global.pom = pom; global.warnings = pod.warnings; %] -- expect -- ok - file parsed -- test -- [% global.warnings.join("\n") %] -- expect -- -- process -- spurious '>' at [% podloc %]/test1.pod line 17 spurious '>' at [% podloc %]/test1.pod line 21 -- test -- [% FOREACH h1 = global.pom.head1 -%] * [% h1.title %] [% END %] -- expect -- * NAME * SYNOPSIS * DESCRIPTION * THE END -- test -- [% FOREACH h2 = global.pom.head1.2.head2 -%] + [% h2.title %] [% END %] -- expect -- + First Subsection + Second Subsection -- test -- [% PROCESS $item.type FOREACH item=global.pom.head1.2.content %] [% BLOCK head2 -%]

    [% item.title | trim %]

    [% END %] [% BLOCK text -%]

    [% item | trim %]

    [% END %] [% BLOCK verbatim -%] 
    [% item | trim %]
    [% END %] -- expect --

    This is the description for My::Module.

    This is verbatim

    First Subsection

    Second Subsection

    Template-Toolkit-3.102/t/chomp.t0000644000000000000000000001733213600243610015152 0ustar rootroot#============================================================= -*-perl-*- # # t/chomp.t # # Test the PRE_CHOMP and POST_CHOMP options. # # Written by Andy Wardley # # Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use Template::Constants qw( :chomp ); # uncomment these lines for debugging the generated Perl code #$Template::Directive::PRETTY = 1; #$Template::Parser::DEBUG = 1; match( CHOMP_NONE, 0 ); match( CHOMP_ONE, 1 ); match( CHOMP_ALL, 1 ); match( CHOMP_COLLAPSE, 2 ); match( CHOMP_GREEDY, 3 ); my $foo = "\n[% foo %]\n"; my $bar = "\n[%- bar -%]\n"; my $baz = "\n[%+ baz +%]\n"; my $ding = "!\n\n[%~ ding ~%]\n\n!"; my $dong = "!\n\n[%= dong =%]\n\n!"; my $dang = "Hello[%# blah blah blah -%]\n!"; my $winsux1 = "[% ding -%]\015\012[% dong %]"; my $winsux2 = "[% ding -%]\015\012\015\012[% dong %]"; my $winsux3 = "[% ding %]\015\012[%- dong %]"; my $winsux4 = "[% ding %]\015\012\015\012[%- dong %]"; my $blocks = { foo => $foo, bar => $bar, baz => $baz, ding => $ding, dong => $dong, dang => $dang, winsux1 => $winsux1, winsux2 => $winsux2, winsux3 => $winsux3, winsux4 => $winsux4, }; # script may be being run in distribution root or 't' directory my $dir = -d 't' ? 't/test/lib' : 'test/lib'; #------------------------------------------------------------------------ # tests without any CHOMP options set #------------------------------------------------------------------------ my $tt2 = Template->new({ BLOCKS => $blocks, INCLUDE_PATH => $dir, }); my $vars = { foo => 3.14, bar => 2.718, baz => 1.618, ding => 'Hello', dong => 'World' }; my $out; ok( $tt2->process('foo', $vars, \$out), 'foo' ); match( $out, "\n3.14\n", 'foo out' ); $out = ''; ok( $tt2->process('bar', $vars, \$out), 'bar' ); match( $out, "2.718", 'bar out' ); $out = ''; ok( $tt2->process('baz', $vars, \$out), 'baz' ); match( $out, "\n1.618\n", 'baz out' ); $out = ''; ok( $tt2->process('ding', $vars, \$out), 'ding' ); match( $out, "!Hello!", 'ding out' ); $out = ''; ok( $tt2->process('dong', $vars, \$out), 'dong' ); match( $out, "! World !", 'dong out' ); $out = ''; ok( $tt2->process('dang', $vars, \$out), 'dang' ); match( $out, "Hello!", 'dang out' ); $out = ''; ok( $tt2->process('winsux1', $vars, \$out), 'winsux1' ); match( od($out), "HelloWorld", 'winsux1 out' ); $out = ''; ok( $tt2->process('winsux2', $vars, \$out), 'winsux2' ); match( od($out), 'Hello\015\012World', 'winsux2 out' ); $out = ''; ok( $tt2->process('winsux3', $vars, \$out), 'winsux3' ); match( od($out), "HelloWorld", 'winsux3 out' ); $out = ''; ok( $tt2->process('winsux4', $vars, \$out), 'winsux4' ); match( od($out), 'Hello\015\012World', 'winsux4 out' ); $out = ''; ok( $tt2->process('dos_newlines', $vars, \$out), 'dos_newlines' ); match( $out, "HelloWorld", 'dos_newlines out' ); sub od{ join( '', map { my $ord = ord($_); ($ord > 127 || $ord < 32 ) ? sprintf '\0%lo', $ord : $_ } split //, shift() ); } #------------------------------------------------------------------------ # tests with the PRE_CHOMP option set #------------------------------------------------------------------------ $tt2 = Template->new({ PRE_CHOMP => 1, BLOCKS => $blocks, }); $out = ''; ok( $tt2->process('foo', $vars, \$out), 'pre pi' ); match( $out, "3.14\n", 'pre pi match' ); $out = ''; ok( $tt2->process('bar', $vars, \$out), 'pre e' ); match( $out, "2.718", 'pre e match' ); $out = ''; ok( $tt2->process('baz', $vars, \$out), 'pre phi' ); match( $out, "\n1.618\n", 'pre phi match' ); $out = ''; ok( $tt2->process('ding', $vars, \$out), 'pre hello' ); match( $out, "!Hello!", 'pre hello match' ); $out = ''; ok( $tt2->process('dong', $vars, \$out), 'pre world' ); match( $out, "! World !", 'pre world match' ); #------------------------------------------------------------------------ # tests with the POST_CHOMP option set #------------------------------------------------------------------------ $tt2 = Template->new({ POST_CHOMP => 1, BLOCKS => $blocks, }); $out = ''; ok( $tt2->process('foo', $vars, \$out), 'post pi' ); match( $out, "\n3.14", 'post pi match' ); $out = ''; ok( $tt2->process('bar', $vars, \$out), 'post e' ); match( $out, "2.718", 'post e match' ); $out = ''; ok( $tt2->process('baz', $vars, \$out), 'post phi' ); match( $out, "\n1.618\n", 'post phi match' ); $out = ''; ok( $tt2->process('ding', $vars, \$out), 'post hello' ); match( $out, "!Hello!", 'post hello match' ); $out = ''; ok( $tt2->process('dong', $vars, \$out), 'post world' ); match( $out, "! World !", 'post world match' ); my $tt = [ tt_pre_none => Template->new(PRE_CHOMP => CHOMP_NONE), tt_pre_one => Template->new(PRE_CHOMP => CHOMP_ONE), tt_pre_all => Template->new(PRE_CHOMP => CHOMP_ALL), tt_pre_coll => Template->new(PRE_CHOMP => CHOMP_COLLAPSE), tt_post_none => Template->new(POST_CHOMP => CHOMP_NONE), tt_post_one => Template->new(POST_CHOMP => CHOMP_ONE), tt_post_all => Template->new(POST_CHOMP => CHOMP_ALL), tt_post_coll => Template->new(POST_CHOMP => CHOMP_COLLAPSE), ]; test_expect(\*DATA, $tt); __DATA__ #------------------------------------------------------------------------ # tt_pre_none #------------------------------------------------------------------------ -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20 end #------------------------------------------------------------------------ # tt_pre_one #------------------------------------------------------------------------ -- test -- -- use tt_pre_one -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin1020 end #------------------------------------------------------------------------ # tt_pre_all #------------------------------------------------------------------------ -- test -- -- use tt_pre_all -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin1020 end #------------------------------------------------------------------------ # tt_pre_coll #------------------------------------------------------------------------ -- test -- -- use tt_pre_coll -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20 end #------------------------------------------------------------------------ # tt_post_none #------------------------------------------------------------------------ -- test -- -- use tt_post_none -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20 end #------------------------------------------------------------------------ # tt_post_all #------------------------------------------------------------------------ -- test -- -- use tt_post_all -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20end #------------------------------------------------------------------------ # tt_post_one #------------------------------------------------------------------------ -- test -- -- use tt_post_one -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20end #------------------------------------------------------------------------ # tt_post_coll #------------------------------------------------------------------------ -- test -- -- use tt_post_coll -- -- test -- begin[% a = 10; b = 20 %] [% a %] [% b %] end -- expect -- begin 10 20 end Template-Toolkit-3.102/t/base.t0000644000000000000000000000712613600243620014757 0ustar rootroot#============================================================= -*-perl-*- # # t/base.t # # Test the Template::Base.pm module. # # Written by Andy Wardley # # 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$ # #======================================================================== use strict; use lib qw( ./lib ../lib ); use Template::Test; ntests(24); #------------------------------------------------------------------------ # a dummy module, derived from Template::Base and destined for failure #------------------------------------------------------------------------ package Template::Fail; use base qw( Template::Base ); our $ERROR; use Template::Base; sub _init { my $self = shift; return $self->error('expected failure'); } #------------------------------------------------------------------------ # another dummy module, expecting a 'name' parameter #------------------------------------------------------------------------ package Template::Named; use base qw( Template::Base ); our $ERROR; use Template::Base; sub _init { my ($self, $params) = @_; $self->{ NAME } = $params->{ name } || return $self->error("No name!"); return $self; } sub name { $_[0]->{ NAME }; } #------------------------------------------------------------------------ # module to test version #------------------------------------------------------------------------ package Template::Version; use Template::Base; use base qw( Template::Base ); our ( $ERROR, $VERSION ); $VERSION = 3.14; #------------------------------------------------------------------------ # main package, run some tests #------------------------------------------------------------------------ package main; my ($mod, $pkg); # instantiate a base class object and test error reporting/returning $mod = Template::Base->new(); ok( $mod ); $mod->error('barf'); ok( $mod->error() eq 'barf' ); # Template::Fail should never work, but we check it reports errors OK ok( ! Template::Fail->new() ); ok( Template::Fail->error eq 'expected failure'); ok( $Template::Fail::ERROR eq 'expected failure'); # Template::Named should only work with a 'name'parameters $mod = Template::Named->new(); ok( ! $mod ); ok( $Template::Named::ERROR eq 'No name!' ); ok( Template::Named->error() eq 'No name!' ); # give it what it wants... $mod = Template::Named->new({ name => 'foo' }); ok( $mod ); ok( $mod->name() eq 'foo' ); ok( ! $mod->error() ); # ... in 2 different flavours $mod = Template::Named->new(name => 'foo'); ok( $mod ); ok( $mod->name() eq 'foo' ); ok( ! $mod->error() ); # test the use of error() for setting and retrieving object errors ok( ! defined $mod->error('more errors') ); ok( $mod->error() eq 'more errors' ); # check package error is still set, then clear. ok( Template::Named->error() eq 'No name!' ); $Template::Named::ERROR = ''; # test via $pkg indirection $pkg = 'Template::Named'; $mod = $pkg->new(); ok( ! $mod ); ok( $pkg->error eq 'No name!' ); $mod = $pkg->new({ name => 'bar' }); ok( $mod && $mod->name eq 'bar' ); ok( ! $mod->error ); #------------------------------------------------------------------------ # test module_version() method #------------------------------------------------------------------------ $pkg = 'Template::Version'; is( $pkg->module_version(), 3.14, 'package version' ); my $obj = $pkg->new() || die $pkg->error(); ok( $obj, 'created a version object' ); is( $obj->module_version(), 3.14, 'object version' ); Template-Toolkit-3.102/t/vars.t0000644000000000000000000002656014232015000015012 0ustar rootroot#============================================================= -*-perl-*- # # t/vars.t # # Template script testing variable use. # # Written by Andy Wardley # # Copyright (C) 1996-2006 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$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Test; use Template::Stash; use Template::Constants qw( :status ); use Template::Directive; use Template::Parser; $Template::Test::DEBUG = 0; $Template::Parser::DEBUG = 0; # sample data my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z) = qw( alpha bravo charlie delta echo foxtrot golf hotel india juliet kilo lima mike november oscar papa quebec romeo sierra tango umbrella victor whisky x-ray yankee zulu ); my @days = qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday ); my $day = -1; my $count = 0; my $params = { 'a' => $a, 'b' => $b, 'c' => $c, 'd' => $d, 'e' => $e, 'f' => { 'g' => $g, 'h' => $h, 'i' => { 'j' => $j, 'k' => $k, }, }, 'g' => "solo $g", 'l' => $l, 'r' => $r, 's' => $s, 't' => $t, 'w' => $w, 'n' => sub { $count }, 'up' => sub { ++$count }, 'down' => sub { --$count }, 'reset' => sub { $count = shift(@_) || 0 }, 'undef' => sub { undef }, 'zero' => sub { 0 }, 'one' => sub { 'one' }, 'halt' => sub { die Template::Exception->new('stop', 'stopped') }, 'join' => sub { join(shift, @_) }, 'split' => sub { my $s = shift; $s = quotemeta($s); my @r = split(/$s/, shift); \@r }, 'magic' => { 'chant' => 'Hocus Pocus', 'spell' => sub { join(" and a bit of ", @_) }, }, 'day' => { 'prev' => \&yesterday, 'this' => \&today, 'next' => \&tomorrow, }, 'belief' => \&belief, 'people' => sub { return qw( Tom Dick Larry ) }, 'gee' => 'g', "letter$a" => "'$a'", 'yankee' => \&yankee, '_private' => 123, '_hidden' => 456, expose => sub { undef $Template::Stash::PRIVATE }, add => sub { $_[0] + $_[1] }, # don't define a 'z' - DEFAULT test relies on its non-existance }; my $tt = [ default => Template->new({ INTERPOLATE => 1, ANYCASE => 1 }), notcase => Template->new({ INTERPOLATE => 1, ANYCASE => 0 }) ]; test_expect(\*DATA, $tt, $params); #------------------------------------------------------------------------ # subs #------------------------------------------------------------------------ sub yesterday { return "All my troubles seemed so far away..."; } sub today { my $when = shift || 'Now'; return "$when it looks as though they're here to stay."; } sub tomorrow { my $dayno = shift; unless (defined $dayno) { $day++; $day %= 7; $dayno = $day; } return $days[$dayno]; } sub belief { my @beliefs = @_; my $b = join(' and ', @beliefs); $b = '' unless length $b; return "Oh I believe in $b."; } sub yankee { my $a = []; $a->[1] = { a => 1 }; $a->[3] = { a => 2 }; return $a; } __DATA__ #------------------------------------------------------------------------ # GET #------------------------------------------------------------------------ -- test -- [[% nosuchvariable %]] [$nosuchvariable] -- expect -- [] [] -- test -- [% a %] [% GET b %] [% get c %] -- expect -- alpha bravo charlie -- test -- [% b %] [% GET b %] -- expect -- bravo bravo -- test -- $a $b ${c} ${d} [% e %] -- expect -- alpha bravo charlie delta echo -- test -- [% letteralpha %] [% ${"letter$a"} %] [% GET ${"letter$a"} %] -- expect -- 'alpha' 'alpha' 'alpha' -- test -- [% f.g %] [% f.$gee %] [% f.${gee} %] -- expect -- golf golf golf -- test -- [% GET f.h %] [% get f.h %] [% f.${'h'} %] [% get f.${'h'} %] -- expect -- hotel hotel hotel hotel -- test -- $f.h ${f.g} ${f.h}.gif -- expect -- hotel golf hotel.gif -- test -- [% f.i.j %] [% GET f.i.j %] [% get f.i.k %] -- expect -- juliet juliet kilo -- test -- [% f.i.j %] $f.i.k [% f.${'i'}.${"j"} %] ${f.i.k}.gif -- expect -- juliet kilo juliet kilo.gif -- test -- [% 'this is literal text' %] [% GET 'so is this' %] [% "this is interpolated text containing $r and $f.i.j" %] [% GET "$t?" %] [% "$f.i.k" %] -- expect -- this is literal text so is this this is interpolated text containing romeo and juliet tango? kilo -- test -- [% name = "$a $b $w" -%] Name: $name -- expect -- Name: alpha bravo whisky -- test -- [% join('--', a b, c, f.i.j) %] -- expect -- alpha--bravo--charlie--juliet -- test -- [% text = 'The cat sat on the mat' -%] [% FOREACH word = split(' ', text) -%]<$word> [% END %] -- expect -- -- test -- [% magic.chant %] [% GET magic.chant %] [% magic.chant('foo') %] [% GET magic.chant('foo') %] -- expect -- Hocus Pocus Hocus Pocus Hocus Pocus Hocus Pocus -- test -- <<[% magic.spell %]>> [% magic.spell(a b c) %] -- expect -- <<>> alpha and a bit of bravo and a bit of charlie -- test -- [% one %] [% one('two', 'three') %] [% one(2 3) %] -- expect -- one one one -- test -- [% day.prev %] [% day.this %] [% belief('yesterday') %] -- expect -- All my troubles seemed so far away... Now it looks as though they're here to stay. Oh I believe in yesterday. -- test -- Yesterday, $day.prev $day.this ${belief('yesterday')} -- expect -- Yesterday, All my troubles seemed so far away... Now it looks as though they're here to stay. Oh I believe in yesterday. -- test -- -- use notcase -- [% day.next %] $day.next -- expect -- Monday Tuesday -- test -- [% FOREACH [ 1 2 3 4 5 ] %]$day.next [% END %] -- expect -- Wednesday Thursday Friday Saturday Sunday -- test -- -- use default -- before [% halt %] after -- expect -- before -- test -- [% FOREACH k = yankee -%] [% loop.count %]. [% IF k; k.a; ELSE %]undef[% END %] [% END %] -- expect -- 1. undef 2. 1 3. undef 4. 2 #------------------------------------------------------------------------ # CALL #------------------------------------------------------------------------ -- test -- before [% CALL a %]a[% CALL b %]n[% CALL c %]d[% CALL d %] after -- expect -- before and after -- test -- ..[% CALL undef %].. -- expect -- .... -- test -- ..[% CALL zero %].. -- expect -- .... -- test -- ..[% n %]..[% CALL n %].. -- expect -- ..0.... -- test -- ..[% up %]..[% CALL up %]..[% n %] -- expect -- ..1....2 -- test -- [% CALL reset %][% n %] -- expect -- 0 -- test -- [% CALL reset(100) %][% n %] -- expect -- 100 #------------------------------------------------------------------------ # SET #------------------------------------------------------------------------ -- test -- [% a = a %] $a [% a = b %] $a -- expect -- alpha bravo -- test -- [% SET a = a %] $a [% SET a = b %] $a [% SET a = $c %] [$a] [% SET a = $gee %] $a [% SET a = ${gee} %] $a -- expect -- alpha bravo [] solo golf solo golf -- test -- [% a = b b = c c = d d = e %][% a %] [% b %] [% c %] [% d %] -- expect -- bravo charlie delta echo -- test -- [% SET a = c b = d c = e %]$a $b $c -- expect -- charlie delta echo -- test -- [% 'a' = d 'include' = e 'INCLUDE' = f.g %][% a %]-[% ${'include'} %]-[% ${'INCLUDE'} %] -- expect -- delta-echo-golf -- test -- [% a = f.g %] $a [% a = f.i.j %] $a -- expect -- golf juliet -- test -- [% f.g = r %] $f.g [% f.i.j = s %] $f.i.j [% f.i.k = f.i.j %] ${f.i.k} -- expect -- romeo sierra sierra -- test -- [% user = { id = 'abw' name = 'Andy Wardley' callsign = "[-$a-$b-$w-]" } -%] ${user.id} ${ user.id } $user.id ${user.id}.gif [% message = "$b: ${ user.name } (${user.id}) ${ user.callsign }" -%] MSG: $message -- expect -- abw abw abw abw.gif MSG: bravo: Andy Wardley (abw) [-alpha-bravo-whisky-] -- test -- [% product = { id => 'XYZ-2000', desc => 'Bogon Generator', cost => 678, } -%] The $product.id $product.desc costs \$${product.cost}.00 -- expect -- The XYZ-2000 Bogon Generator costs $678.00 -- test -- [% data => { g => 'my data' } complex = { gee => 'g' } -%] [% data.${complex.gee} %] -- expect -- my data #------------------------------------------------------------------------ # DEFAULT #------------------------------------------------------------------------ -- test -- [% a %] [% DEFAULT a = b -%] [% a %] -- expect -- alpha alpha -- test -- [% a = '' -%] [% DEFAULT a = b -%] [% a %] -- expect -- bravo -- test -- [% a = '' b = '' -%] [% DEFAULT a = c b = d z = r -%] [% a %] [% b %] [% z %] -- expect -- charlie delta romeo #------------------------------------------------------------------------ # 'global' vars #------------------------------------------------------------------------ -- test -- [% global.version = '3.14' -%] Version: [% global.version %] -- expect -- Version: 3.14 -- test -- Version: [% global.version %] -- expect -- Version: 3.14 -- test -- [% global.newversion = global.version + 1 -%] Version: [% global.version %] Version: [% global.newversion %] -- expect -- Version: 3.14 Version: 4.14 -- test -- Version: [% global.version %] Version: [% global.newversion %] -- expect -- Version: 3.14 Version: 4.14 -- test -- [% hash1 = { foo => 'Foo', bar => 'Bar', } hash2 = { wiz => 'Wiz', woz => 'Woz', } -%] [% hash1.import(hash2) -%] keys: [% hash1.keys.sort.join(', ') %] -- expect -- keys: bar, foo, wiz, woz -- test -- [% mage = { name => 'Gandalf', aliases => [ 'Mithrandir', 'Olorin', 'Incanus' ] } -%] [% import(mage) -%] [% name %] [% aliases.join(', ') %] -- expect -- Gandalf Mithrandir, Olorin, Incanus # test private variables -- test -- [[% _private %]][[% _hidden %]] -- expect -- [][] # make them visible -- test -- [% CALL expose -%] [[% _private %]][[% _hidden %]] -- expect -- [123][456] # Stas reported a problem with spacing in expressions but I can't # seem to reproduce it... -- test -- [% a = 4 -%] [% b=6 -%] [% c = a + b -%] [% d=a+b -%] [% c %]/[% d %] -- expect -- 10/10 -- test -- [% a = 1 b = 2 c = 3 -%] [% d = 1+1 %]d: [% d %] [% e = a+b %]e: [% e %] -- expect -- d: 2 e: 3 # these tests check that the incorrect precedence in the parser has now # been fixed, thanks to Craig Barrat. -- test -- [% 1 || 0 && 0 # should be 1 || (0&&0), not (1||0)&&0 %] -- expect -- 1 -- test -- [% 1 + !0 + 1 # should be 1 + (!0) + 0, not 1 + !(0 + 1) %] -- expect -- 3 -- test -- [% "x" _ "y" == "y"; ',' # should be ("x"_"y")=="y", not "x"_("y"=="y") %] -- expect -- , -- test -- [% "x" _ "y" == "xy" # should be ("x"_"y")=="xy", not "x"_("y"=="xy") %] -- expect -- 1 -- test -- [% add(3, 5) %] -- expect -- 8 -- test -- [% add(3 + 4, 5 + 7) %] -- expect -- 19 -- test -- [% a = 10; b = 20; c = 30; add(add(a,b+1),c*3); %] -- expect -- 121 -- test -- [% a = 10; b = 20; c = 30; d = 5; e = 7; add(a+5, b < 10 ? c : d + e*5); -%] -- expect -- 55 -- test -- [% SET monkey="testing" IF 1; monkey %] -- expect -- testing -- test -- [% monkey = "testing<4>" FILTER html IF 1; monkey %] -- expect -- testing<4> -- test -- [% testing="initial"; SET testing="changed" IF 0; testing %] -- expect -- initial Template-Toolkit-3.102/lib/0000755000000000000000000000000014635373376014202 5ustar rootrootTemplate-Toolkit-3.102/lib/Template/0000755000000000000000000000000014635373376015755 5ustar rootrootTemplate-Toolkit-3.102/lib/Template/Namespace/0000755000000000000000000000000014635373376017651 5ustar rootrootTemplate-Toolkit-3.102/lib/Template/Namespace/Constants.pm0000644000000000000000000001054514635371175022163 0ustar rootroot#================================================================= -*-Perl-*- # # Template::Namespace::Constants # # DESCRIPTION # Plugin compiler module for performing constant folding at compile time # on variables in a particular namespace. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 1996-2022 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #============================================================================ package Template::Namespace::Constants; use strict; use warnings; use base 'Template::Base'; use Template::Config; use Template::Directive; use Template::Exception; our $VERSION = '3.100'; our $DEBUG = 0 unless defined $DEBUG; sub _init { my ($self, $config) = @_; $self->{ STASH } = Template::Config->stash($config) || return $self->error(Template::Config->error()); return $self; } #------------------------------------------------------------------------ # ident(\@ident) foo.bar(baz) #------------------------------------------------------------------------ sub ident { my ($self, $ident) = @_; my @save = @$ident; # discard first node indicating constants namespace splice(@$ident, 0, 2); my $nelems = @$ident / 2; my ($e, $result); local $" = ', '; print STDERR "constant ident [ @$ident ] " if $DEBUG; foreach $e (0..$nelems-1) { # node name must be a constant unless ($ident->[$e * 2] =~ s/^'(.+)'$/$1/s) { $self->DEBUG(" * deferred (non-constant item: ", $ident->[$e * 2], ")\n") if $DEBUG; return Template::Directive->ident(\@save); } # if args is non-zero then it must be eval'ed if ($ident->[$e * 2 + 1]) { my $args = $ident->[$e * 2 + 1]; my $comp = eval "$args"; if ($@) { $self->DEBUG(" * deferred (non-constant args: $args)\n") if $DEBUG; return Template::Directive->ident(\@save); } $self->DEBUG("($args) ") if $comp && $DEBUG; $ident->[$e * 2 + 1] = $comp; } } $result = $self->{ STASH }->get($ident); if (! length $result || ref $result) { my $reason = length $result ? 'reference' : 'no result'; $self->DEBUG(" * deferred ($reason)\n") if $DEBUG; return Template::Directive->ident(\@save); } $result =~ s/'/\\'/g; $self->DEBUG(" * resolved => '$result'\n") if $DEBUG; return "'$result'"; } 1; __END__ =head1 NAME Template::Namespace::Constants - Compile time constant folding =head1 SYNOPSIS # easy way to define constants use Template; my $tt = Template->new({ CONSTANTS => { pi => 3.14, e => 2.718, }, }); # nitty-gritty, hands-dirty way use Template::Namespace::Constants; my $tt = Template->new({ NAMESPACE => { constants => Template::Namespace::Constants->new({ pi => 3.14, e => 2.718, }, }, }); =head1 DESCRIPTION The C module implements a namespace handler which is plugged into the C compiler module. This then performs compile time constant folding of variables in a particular namespace. =head1 METHODS =head2 new(\%constants) The new() constructor method creates and returns a reference to a new Template::Namespace::Constants object. This creates an internal stash to store the constant variable definitions passed as arguments. my $handler = Template::Namespace::Constants->new({ pi => 3.14, e => 2.718, }); =head2 ident(\@ident) Method called to resolve a variable identifier into a compiled form. In this case, the method fetches the corresponding constant value from its internal stash and returns it. =head1 AUTHOR Andy Wardley Eabw@wardley.orgE L =head1 COPYRIGHT Copyright (C) 1996-2022 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =cut # Local Variables: # mode: perl # perl-indent-level: 4 # indent-tabs-mode: nil # End: # # vim: expandtab shiftwidth=4: Template-Toolkit-3.102/lib/Template/Modules.pod0000644000000000000000000001257114635371175020072 0ustar rootroot#============================================================= -*-perl-*- # # Template::Modules # # DESCRIPTION # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 1996-2022 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #======================================================================== =head1 NAME Template::Modules - Template Toolkit Modules =head1 Template Toolkit Modules This documentation provides an overview of the different modules that comprise the Template Toolkit. =head2 Template The L