#!/usr/bin/perl
# $File: //member/autrijus/Template-Extract/t/1-basic.t $ $Author: autrijus $
# $Revision: #13 $ $Change: 10075 $ $DateTime: 2004/02/16 16:50:48 $ vim: expandtab shiftwidth=4
use strict;
use Test::More tests => 12;
use_ok('Template::Extract');
my ($template, $document, $data);
my $obj = Template::Extract->new;
isa_ok($obj, 'Template::Extract');
$template = << '.';
[% FOREACH record %]
- [% title %]: [% rating %] - [% comment %].
[% ... %]
[% END %]
.
$document = << '.';
Great links
.
$data = Template::Extract->new->extract($template, $document);
is_deeply($data, {
'record' => [ {
'rating' => 'A+',
'comment' => 'nice',
'url' => 'http://slashdot.org',
'title' => 'News for nerds.',
}, {
'rating' => 'Z!',
'comment' => 'yeah',
'url' => 'http://microsoft.com',
'title' => 'Where do you want...',
} ]
}, 'synopsis');
$template = << '.';
[% FOREACH record %]
<[% /\w/ %]>[% para %][% /\w/ %]>
[% END %]
.
$document = << '.';
hello
world
, how are you?
.
$data = Template::Extract->new->extract($template, $document);
is_deeply($data, {
record => [ map { { para => $_ } } 'hello', 'world', ', how are you?' ]
}, 'implicit newlines with regex tags');
$template = << '.';
[% FOREACH subject %]
[% ... %]
[% sub.heading %]
[% FOREACH record %]
- [% title %]: [% rating %] - [% comment %].
[% ... %]
[% END %]
[% ... %]
[% END %]
[% FOREACH record %]
- [% title %]: [% rating %] - [% comment %].
[% ... %]
[% END %]
.
$document = << '.';
Great links
Foo
Bar
- CPAN.: +++++ - cool.
this text is ignored, also.
.
$data = Template::Extract->new->extract($template, $document);
is_deeply($data, {
'record' => [ {
'rating' => '+++++',
'comment' => 'cool',
'url' => 'http://cpan.org',
'title' => 'CPAN.',
} ],
'subject' => [map { {
'sub' => { 'heading' => $_ },
'record' => [ {
'rating' => 'A+',
'comment' => 'nice',
'url' => 'http://slashdot.org',
'title' => 'News for nerds.',
}, {
'rating' => 'Z!',
'comment' => 'yeah',
'url' => 'http://microsoft.com',
'title' => 'Where do you want...',
} ]
} } qw(Foo Bar)],
}, 'two nested and one extra FOREACH');
$template = << '.';
_[% C %][% D %]_
_[% D %][% E %]_
_[% E %][% D %][% C %]_
.
$document = << '.';
_doeray_
_rayme_
_meraydoe_
.
$data = Template::Extract->new->extract($template, $document);
is_deeply($data, {
'C' => 'doe',
'D' => 'ray',
'E' => 'me',
}, 'backtracking');
my $ext_data = { F => 'fa' };
$data = Template::Extract->new->extract($template, $document, $ext_data);
is_deeply($data, {
'C' => 'doe',
'D' => 'ray',
'E' => 'me',
'F' => 'fa',
}, 'external data');
is_deeply($data, $ext_data, 'ext_data should be the same as data');
$template = << '.';
[% FOREACH entry %]
[% ... %]
[% FOREACH title %][% title_text %][% END %]
[% content %]
([% FOREACH comment %][% SET sub.comment = 1 %][% comment_text %] |[% END %]Comment on this)
[% END %]
.
$document = << '.';
Title 1Title 1.a
xxx
(1 Comment |Comment on this)
Title 2
foo
(Comment on this)
.
$data = Template::Extract->new->extract( $template, $document );
is_deeply($data, {
'entry' => [ {
'comment' => [ {
'comment_text' => '1 Comment',
'sub' => { 'comment' => 1 },
} ],
'content' => 'xxx',
'title' => [ {
'title_text' => 'Title 1',
}, {
'title_text' => 'Title 1.a',
} ],
}, {
'content' => 'foo',
'title' => [ {
'title_text' => 'Title 2',
} ],
} ],
}, 'two FOREACHs nested inside a FOREACH');
$template = << '.';
[% FOREACH top %][% FOREACH foo %][% SET bar.x = "set" %]<[% baz.y %]|[% qux.z %]>[% END %][% END %]
.
$document = << '.';
new->extract($template, $document);
is_deeply($data, { top => [{ foo => [{
bar => { x => 'set' },
baz => { y => 'test1' },
qux => { z => '1' },
}, {
bar => { x => 'set' },
baz => { y => 'test2' },
qux => { z => '2' },
}] }] }, 'SET directive inside two FOREACHs');
$template = "[% FOREACH item %]hello [% foo %]
[% END %]";
$document = " hello name
";
$data = Template::Extract->new->extract($template, $document);
is_deeply($data, { item => [ { foo => 'name' } ] }, 'extra prepended data');
$Template::Extract::EXACT =
$Template::Extract::EXACT = 1;
$data = Template::Extract->new->extract($template, $document);
is($data, undef, 'partial match when $EXACT == 1 should fail');