#!/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 => 'component',
                                                      description => 'Component object functionality' );


#------------------------------------------------------------

    $group->add_test( name => 'comp_obj',
                      path => 'comp_obj_test/comp_obj',
                      call_path => 'comp_obj_test/comp_obj',
                      description => 'Tests several component object methods',
                      component => <<'EOF',
<%def .subcomp>
% my $adj = 'happy';
I am a <% $adj %> subcomp.
<%args>
$crucial
$useless=>17
</%args>
</%def>

<%method meth>
% my $adj = 'sad';
I am a <% $adj %> method.
<%args>
$crucial
$useless=>17
</%args>
</%method>

% my $anon = $m->interp->make_component(comp_source=>join("\n",'% my $adj = "flummoxed";','I am a <% $adj %> anonymous component.'),name=>'anonymous');

<% '-' x 60 %>

File-based:
<& /shared/display_comp_obj, comp=>$m->current_comp &>

<% '-' x 60 %>

Subcomponent:
<& /shared/display_comp_obj, comp=>$m->fetch_comp('.subcomp')  &>

<% '-' x 60 %>

Method:
<& /shared/display_comp_obj, comp=>$m->fetch_comp('SELF:meth')  &>

<% '-' x 60 %>

Anonymous component:
<& $anon &>
<& $anon &>
<& /shared/display_comp_obj, comp=>$anon &>

<%args>
@animals=>('lions','tigers')
</%args>
EOF
                      expect => <<'EOF',



------------------------------------------------------------

File-based:
Declared args:
@animals=>('lions','tigers')

I am not a subcomponent.
I am not a method.
I am file-based.
My short name is comp_obj.
My directory is /component/comp_obj_test.
I have 1 subcomponent(s).
Including one called .subcomp.
My title is /component/comp_obj_test/comp_obj.

My path is /component/comp_obj_test/comp_obj.
My comp_id is /component/comp_obj_test/comp_obj.


------------------------------------------------------------

Subcomponent:
Declared args:
$crucial
$useless=>17

I am a subcomponent.
I am not a method.
I am not file-based.
My short name is .subcomp.
My parent component is /component/comp_obj_test/comp_obj.
My directory is /component/comp_obj_test.
I have 0 subcomponent(s).
My title is /component/comp_obj_test/comp_obj:.subcomp.

My path is /component/comp_obj_test/comp_obj:.subcomp.
My comp_id is [subcomponent '.subcomp' of /component/comp_obj_test/comp_obj].


------------------------------------------------------------

Method:
Declared args:
$crucial
$useless=>17

I am a subcomponent.
I am a method.
I am not file-based.
My short name is meth.
My parent component is /component/comp_obj_test/comp_obj.
My directory is /component/comp_obj_test.
I have 0 subcomponent(s).
My title is /component/comp_obj_test/comp_obj:meth.

My path is /component/comp_obj_test/comp_obj:meth.
My comp_id is [method 'meth' of /component/comp_obj_test/comp_obj].


------------------------------------------------------------

Anonymous component:
I am a flummoxed anonymous component.
I am a flummoxed anonymous component.
Declared args:

I am not a subcomponent.
I am not a method.
I am not file-based.
My short name is [anon something].
I have 0 subcomponent(s).
My title is [anon something].

My comp_id is [anon something].
EOF
                     );


#------------------------------------------------------------

    $group->add_test( name => 'context',
                      description => 'Tests list/scalar context propogation in comp calls',
                      component => <<'EOF',
Context checking:

List:\
% my $discard = [$m->comp('.subcomp')];


Scalar:\
% scalar $m->comp('.subcomp');


Scalar:\
<& .subcomp &>

<%def .subcomp>
% $m->print( wantarray ? 'array' : 'scalar' );
</%def>
EOF
                      expect => <<'EOF',
Context checking:

List:
array

Scalar:
scalar

Scalar:
scalar

EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'scomp',
                      description => 'Test scomp Request method',
                      component => <<'EOF',

% my $text = $m->scomp('.subcomp', 1,2,3);
-----
<% $text %>

<%def .subcomp>
 Hello, you say <% join '', @_ %>.
</%def>
EOF
                      expect => <<'EOF',

-----

 Hello, you say 123.


EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'mfu_count',
                      description => 'Test mfu_count component method',
                      component => <<'EOF',
<% $m->current_comp->mfu_count %>
% $m->current_comp->mfu_count(75);
<% $m->current_comp->mfu_count %>
EOF
                      expect => <<'EOF',
1
75
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'store',
                      description => 'Test store parameter to component call',
                      component => <<'EOF',

% my $buffy;
% my $rtn;
% $rtn = $m->comp({store => \$buffy}, '.subcomp', 1,2,3,4);
-----
<% $buffy %>
returned <% $rtn %>

<%def .subcomp>
 Hello, you say <% join '', @_ %>.
% return 'foo';
</%def>
EOF
                      expect => <<'EOF',

-----

 Hello, you say 1234.

returned foo

EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'flush_clear',
                      description => 'Flush then clear',
                      component => <<'EOF',
Foo
% $m->flush_buffer;
Bar
% $m->clear_buffer;
Baz
EOF
                      expect => <<'EOF',
Foo
Baz
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'flush_clear_scomp',
                      description => 'Flush then clear inside scomp - flush only affects top buffer',
                      component => <<'EOF',
<%method s>
Foo
% $m->flush_buffer;
Bar
% $m->clear_buffer;
Baz
</%method>
This is me
----------
This is scomp-ed output:
<% $m->scomp('SELF:s') %>
----------
This is me again
EOF
                      expect => <<'EOF',
This is me
----------
This is scomp-ed output:
Baz

----------
This is me again
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'attr_if_exists',
                      description => 'Test attr_if_exists method',
                      component => <<'EOF',
have it: <% $m->base_comp->attr_if_exists('have_it') %>
don't have it: <% defined($m->base_comp->attr_if_exists('don\'t have_it')) ? 'defined' : 'undefined' %>
<%attr>
have_it => 1
</%attr>
EOF
                      expect => <<'EOF',
have it: 1
don't have it: undefined
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'methods',
                      description => 'Test methods method',
                      component => <<'EOF',
% my $comp = $m->request_comp;
% my $methods = $comp->methods;
% foreach my $name ( sort keys %$methods ) {
<% $name %>
% }
<% $comp->methods('x') ? 'has' : 'does not have' %> x
<% $comp->methods('y') ? 'has' : 'does not have' %> y
<% $comp->methods('z') ? 'has' : 'does not have' %> z
<%method x>
x
</%method>
<%method y>
y
</%method>
EOF
                      expect => <<'EOF',
x
y
has x
has y
does not have z
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'subcomps',
                      description => 'Test subcomps method',
                      component => <<'EOF',
% my $comp = $m->request_comp;
% my $subcomps = $comp->subcomps;
% foreach my $name ( sort keys %$subcomps ) {
<% $name %>
% }
<% $comp->subcomps('x') ? 'has' : 'does not have' %> x
<% $comp->subcomps('y') ? 'has' : 'does not have' %> y
<% $comp->subcomps('z') ? 'has' : 'does not have' %> z
<%def x>
x
</%def>
<%def y>
y
</%def>
EOF
                      expect => <<'EOF',
x
y
has x
has y
does not have z
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'attributes',
                      description => 'Test attributes method',
                      component => <<'EOF',
% my $comp = $m->request_comp;
% my $attrs = $comp->attributes;
% foreach my $name ( sort keys %$attrs ) {
<% $name %>
% }
<%attr>
x => 1
y => 2
</%attr>
EOF
                      expect => <<'EOF',
x
y
EOF
                    );

#------------------------------------------------------------

    $group->add_support( path => 'args_copying_helper',
                         component => <<'EOF',
<%init>
$_[1] = 4;
$b = 5;
$ARGS{'c'} = 6;
</%init>

<%args>
$a
$b
</%args>
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'component_args_copying',
                      description => 'Test that @_ contains aliases, <%args> and %ARGS contain copies after comp',
                      component => <<'EOF',
$a is <% $a %>
$b is <% $b %>
$c is <% $c %>

<%init>;
my $a = 1;
my $b = 2;
my $c = 3;
$m->comp('args_copying_helper', a=>$a, b=>$b, c=>$c);
</%init>
EOF
                      expect => <<'EOF',

$a is 4
$b is 2
$c is 3
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'subrequest_args_copying',
                      description => 'Test that @_ contains aliases, <%args> and %ARGS contain copies after subrequest',
                      component => <<'EOF',
$a is <% $a %>
$b is <% $b %>
$c is <% $c %>

<%init>;
my $a = 1;
my $b = 2;
my $c = 3;
$m->subexec('/component/args_copying_helper', a=>$a, b=>$b, c=>$c);
</%init>
EOF
                      expect => <<'EOF',

$a is 4
$b is 2
$c is 3
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'modification_read_only_arg',
                      description => 'Test that read-only argument cannot be modified through @_',
                      component => <<'EOF',
<%init>;
$m->comp('args_copying_helper', a=>1, b=>2, c=>3);
</%init>
EOF
                      expect_error => 'Modification of a read-only value',
                    );

#------------------------------------------------------------

    return $group;
}