#!/usr/bin/perl -w
use strict;
use HTML::Mason::Tests;
my $tests = make_tests();
$tests->run;
sub make_tests
{
my $group = HTML::Mason::Tests->tests_class->new( name => 'sections',
description => 'Tests various <%foo> sections' );
#------------------------------------------------------------
$group->add_support( path => '/support/args_test',
component => <<'EOF',
<% $message %>\
<%args>
$message
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/support/perl_args_test',
component => <<'EOF',
a: <% $a %>
b: <% join(",",@b) %>
c: <% join(",",map("$_=$c{$_}",sort(keys(%c)))) %>
d: <% $d %>
e: <% join(",",@e) %>
f: <% join(",",map("$_=$f{$_}",sort(keys(%f)))) %>
<%args>
$a
@b # a comment
%c
$d=>5 # another comment
@e=>('foo','baz')
%f=>(joe=>1,bob=>2)
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'args',
description => 'tests <%args> block',
component => <<'EOF',
args Test
<& support/args_test, message => 'Hello World!' &>
EOF
expect => <<'EOF',
args Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'attr',
description => 'tests <%attr> block',
component => <<'EOF',
attr Test
foo
<% $m->current_comp->attr('foo') %>
<% $m->current_comp->attr('bar')->[1] %>
<% $m->current_comp->attr('baz')->{b} %>
<%attr>
foo => 'a'
bar => [1, 3]
baz => { a => 1, b => 2 }
EOF
expect => <<'EOF',
attr Test
foo
a
3
2
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'def',
description => 'tests <%def> block',
component => <<'EOF',
<%def intro>
% my $comp = $m->current_comp;
Hello!
My name is <% $comp->name %>. Full name <% $comp->title %>.
I was created by <% $comp->owner->path %>.
<& .link, site=>'masonhq', label=>'Mason' &>
<& intro &>
<& .link, site=>'apache', label=>'Apache Foundation' &>
<& .link, site=>'yahoo' &>
<& .link, site=>'excite' &>
<%def .link>
--> <% $label %>
<%args>
$site
$label=>ucfirst($site)
EOF
expect => <<'EOF',
Hello!
My name is intro. Full name /sections/def:intro.
I was created by /sections/def.
--> Mason
--> Apache Foundation
--> Yahoo
--> Excite
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'doc',
description => 'tests <%doc> section',
component => <<'EOF',
doc Test
Hello World!
<%doc>
This is an HTML::Mason documentation section.
Right?
EOF
expect => <<'EOF',
doc Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'filter',
description => 'tests <%filter> section',
component => <<'EOF',
filter Test
!dlorW olleH
<%filter>
s/\!dlorW olleH/Hello World!/;
EOF
expect => <<'EOF',
filter Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'flags',
description => 'tests <%flags> section',
component => <<'EOF',
flags Test
foo
<%flags>
inherit=>undef # an inherit flag
EOF
expect => <<'EOF',
flags Test
foo
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'init',
description => 'tests <%init> section',
component => <<'EOF',
init Test
<% $message %>
<%init>
my $message = "Hello World!";
EOF
expect => <<'EOF',
init Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'method',
description => 'tests <%method> section',
component => <<'EOF',
method Test
% $m->current_comp->call_method('foo','y'=>2);
% my $out = $m->current_comp->scall_method('bar',qw(a b c));
<% uc($out) %>
<%method foo>
% my $sum = $y + $y;
<% $y %> + <% $y %> = <% $sum %>.
<%ARGS>
$y
<%method bar>
The second method. Arguments are <% join(",",@_) %>.
EOF
expect => <<'EOF',
method Test
2 + 2 = 4.
THE SECOND METHOD. ARGUMENTS ARE A,B,C.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'once',
description => 'tests <%once> block',
component => <<'EOF',
once Test
<% $message %>
<%once>
my $message = "Hello World";
<%INIT>
$message .= "!";
EOF
expect => <<'EOF',
once Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'perl',
description => 'test <%perl> sections and makes sure block names are case-insensitive',
component => <<'EOF',
perl Test
<%perl>
my $message = "Hello";
<%Perl>
$message .= " World!";
<% $message %>
<%perl>
$message = "How are you?";
<% $message %>
EOF
expect => <<'EOF',
perl Test
Hello World!
How are you?
EOF
);
#------------------------------------------------------------
=pod
$group->add_test( name => 'perl_args',
description => 'tests old <%perl_args> block',
component => <<'EOF',
<& support/perl_args_test, a=>'fargo', b=>[17,82,16], c=>{britain=>3, spain=>1} &>
EOF
expect => <<'EOF',
a: fargo
b: 17,82,16
c: britain=3,spain=1
d: 5
e: foo,baz
f: bob=2,joe=1
EOF
);
=cut
#------------------------------------------------------------
# Carp in 5.6.0 is broken so just skip it
unless ($] == 5.006)
{
$group->add_test( name => 'omitted_args',
description => 'tests error message when expect args are not passed',
component => '<& support/perl_args_test, b=>[17,82,16], c=>{britain=>3, spain=>1} &>',
expect_error => qr{no value sent for required parameter 'a'},
);
}
#------------------------------------------------------------
$group->add_test( name => 'overridden_args',
description => 'tests overriding of default args values',
component => <<'EOF',
<& support/perl_args_test, a=>'fargo', b=>[17,82,16], c=>{britain=>3, spain=>1}, d=>103, e=>['a','b','c'], f=>{ralph=>15, sue=>37} &>
EOF
expect => <<'EOF',
a: fargo
b: 17,82,16
c: britain=3,spain=1
d: 103
e: a,b,c
f: ralph=15,sue=37
EOF
);
#------------------------------------------------------------
=pod
$group->add_test( name => 'perl_doc',
description => 'tests old <%perl_doc> section',
component => <<'EOF',
perl_doc Test
Hello World!
<%perl_doc>
This is an HTML::Mason documentation section.
Right?
EOF
expect => <<'EOF',
perl_doc Test
Hello World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'perl_init',
description => 'tests old <%perl_init> section',
component => <<'EOF',
perl_init Test
<% $message %>
<%perl_init>
my $message = "Hello World!";
EOF
expect => <<'EOF',
perl_init Test
Hello World!
EOF
);
=cut
#------------------------------------------------------------
$group->add_test( name => 'shared',
description => 'tests <%shared> section',
component => <<'EOF',
<%def .main>
Hello <% $name %>.
% $m->current_comp->owner->call_method('foo');
% $m->current_comp->owner->call_method('bar');
<& .baz &>
<%method foo>
This is the foo method, <% $name %>.
<%method bar>
This is the bar method, <% $name %>.
<%def .baz>
This is the baz subcomponent, <% $name %>.
<& .main &>
% $name = 'Mary';
<& .main &>
<%shared>
my $name = 'Joe';
EOF
expect => <<'EOF',
Hello Joe.
This is the foo method, Joe.
This is the bar method, Joe.
This is the baz subcomponent, Joe.
Hello Mary.
This is the foo method, Mary.
This is the bar method, Mary.
This is the baz subcomponent, Mary.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'text',
description => 'tests <%text> section',
component => <<'EOF',
<%text>
%
<%once>
<%init>
<%doc>
<%args>
EOF
expect => <<'EOF',
%
<%once>
<%init>
<%doc>
<%args>
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'multiple',
description => 'tests repeated blocks of the same type',
component => <<'EOF',
<%attr>
name=>'Joe'
<%init>
my $var1 = "Foo!";
<%filter>
tr/a-z/A-Z/
var1 = <% $var1 %>
var2 = <% $var2 %>
Name = <% $m->current_comp->attr('name') %>
Color = <% $m->current_comp->attr('color') %>
<%filter>
s/\!/\?/g
<%init>
my $var2 = "Bar!";
<%attr>
color=>'Blue'
EOF
expect => <<'EOF',
VAR1 = FOO?
VAR2 = BAR?
NAME = JOE
COLOR = BLUE
EOF
);
#------------------------------------------------------------
return $group;
}