#!/usr/bin/perl -w

use strict;
use File::Basename;
use HTML::Mason::Tests;

my $outside_comp_root_test_file;
my $tests = make_tests();
$tests->run;

sub make_tests
{

    my $group = HTML::Mason::Tests->tests_class->new( name => 'comp-calls',
                                                      description => 'Component call syntax' );
    $outside_comp_root_test_file = dirname($group->comp_root) . "/.outside_comp";

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

    $group->add_support( path => '/support/amper_test',
                         component => <<'EOF',
amper_test.<p>
% if (%ARGS) {
Arguments:<p>
%   foreach my $key (sort keys %ARGS) {
<b><% $key %></b>: <% $ARGS{$key} %><br>
%   }
% }
EOF
                       );

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

    $group->add_test( name => 'ampersand',
                      description => 'tests all variations of component call path syntax',
                      component => <<'EOF',
<&support/amper_test&>
<& support/amper_test &>
<&  support/amper_test, &>
<& support/amper_test
&>
<&
support/amper_test &>
<&
support/amper_test
&>
EOF
                      expect => <<'EOF',
amper_test.<p>

amper_test.<p>

amper_test.<p>

amper_test.<p>

amper_test.<p>

amper_test.<p>

EOF
                 );

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

    $group->add_test( name => 'ampersand_with_args',
                      description => 'tests variations of component calls with arguments',
                      component => <<'EOF',
<& /comp-calls/support/amper_test, message=>'Hello World!'  &>
<& support/amper_test, message=>'Hello World!',
   to=>'Joe' &>
<& "support/amper_test" &>
% my $dir = "support";
% my %args = (a=>17, b=>32);
<& $dir . "/amper_test", %args &>
EOF
                      expect => <<'EOF',
amper_test.<p>
Arguments:<p>
<b>message</b>: Hello World!<br>

amper_test.<p>
Arguments:<p>
<b>message</b>: Hello World!<br>
<b>to</b>: Joe<br>

amper_test.<p>

amper_test.<p>
Arguments:<p>
<b>a</b>: 17<br>
<b>b</b>: 32<br>

EOF
                 );

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

    $group->add_support( path => '/support/funny_-+=@~~~._name',
                         component => <<'EOF',
foo is <% $ARGS{foo} %>
EOF
                       );

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

    $group->add_test( name => 'ampersand_with_funny_name',
                      description => 'component with non-alphabetic characters',
                      component => <<'EOF',
<& support/funny_-+=@~~~._name, foo => 5 &>
EOF
                      expect => <<'EOF',
foo is 5
EOF
                 );

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

    # This only tests for paths passed through Request::fetch_comp,
    # not Interp::load.  Not sure how zealously we want to
    # canonicalize.
    #
    $group->add_test( name => 'canonicalize_paths',
                      description => 'test that various paths are canonicalized to the same component',
                      component => <<'EOF',
<%perl>
my $path1 = '///comp-calls/support//amper_test';
my $comp1 = $m->fetch_comp($path1)
  or die "could not fetch comp1";
my $path2 = './support/./././amper_test';
my $comp2 = $m->fetch_comp($path2)
  or die "could not fetch comp2";
my $path3 = './support/../support/../support/././amper_test';
my $comp3 = $m->fetch_comp($path3)
  or die "could not fetch comp3";
unless ($comp1 == $comp2 && $comp2 == $comp3) {
    die sprintf
        (
         "different component objects for same canonical path:\n  %s (%s -> %s)\n  %s (%s -> %s)\n  %s (%s -> %s)",
         $comp1, $path1, $comp1->path,
         $comp2, $path2, $comp2->path,
         $comp3, $path3, $comp3->path,
         );
}
$m->comp($comp1);
$m->comp($comp2);
$m->comp($comp3);
</%perl>
EOF
                      expect => <<'EOF',
amper_test.<p>
amper_test.<p>
amper_test.<p>
EOF
                 );

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

    $group->add_test( name => 'fetch_comp_no_arg',
                      description => 'fetch_comp with blank or undefined argument returns undef',
                      component => <<'EOF',
fetch_comp(undef) = <% defined($m->fetch_comp(undef)) ? 'defined' : 'undefined' %>
fetch_comp("") = <% defined($m->fetch_comp("")) ? 'defined' : 'undefined' %>
EOF
                      expect => <<'EOF',
fetch_comp(undef) = undefined
fetch_comp("") = undefined
EOF
                 );

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

    $group->add_test( name => 'outside_comp_root_prepare',
                      description => 'test that file exists in dist/t for next two tests',
                      pre_code => sub { local *F; open(F, ">$outside_comp_root_test_file"); print F "hi"; },
                      component => "test file '$outside_comp_root_test_file' <% -e '$outside_comp_root_test_file' ? 'exists' : 'does not exist' %>",
                      expect => "test file '$outside_comp_root_test_file' exists",
                 );

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

    $group->add_test( name => 'outside_comp_root_absolute',
                      description => 'cannot call components outside comp root with absolute path',
                      component => <<'EOF',
<& /../.outside_comp &>
EOF
                      expect_error => qr{could not find component for path '/../.outside_comp'},
                 );

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

    $group->add_test( name => 'outside_comp_root_relative',
                      description => 'cannot call components outside comp root with relative path',
                      component => <<'EOF',
<& ../../.outside_comp &>
EOF
                      expect_error => qr{could not find component for path '../../.outside_comp'},
                 );

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

    # put /../ in add_support path to put component right under comp root
    $group->add_support( path => '/../outside_comp_root_from_top',
                         component => <<'EOF',
<& ../.outside_comp &>
EOF
                       );

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

    $group->add_test( name => 'outside_comp_root_relative_from_top',
                      description => 'cannot call components outside comp root with relative path from component at top of root',
                      component => <<'EOF',
<& /outside_comp_root_from_top &>
EOF
                      expect_error => qr{could not find component for path '../.outside_comp'},
                 );

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

    $group->add_test( name => 'parent_designator_with_no_parent',
                      description => 'using PARENT from component with no parent',
                      component => <<'EOF',
<%flags>
inherit=>undef
</%flags>

<& PARENT:foo &>
EOF
                      expect_error => qr/PARENT designator used from component with no parent/,
                 );

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

    $group->add_test( name => 'no_such_method',
                      description => 'calling nonexistent method on existing component',
                      component => <<'EOF',
<& support/amper_test:bar &>
EOF
                      expect_error => qr/no such method 'bar' for component/,
                 );

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

    $group->add_test( name => 'fetch_comp_no_errors',
                      description => 'fetch_comp should not throw any errors',
                      component => <<'EOF',
% foreach my $path (qw(foo support/amper_test:bar PARENT)) {
<% $m->fetch_comp($path) ? 'defined' : 'undefined' %>
% }
EOF
                      expect => <<'EOF',
undefined
undefined
undefined
EOF
                 );

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

    $group->add_support( path => '/support/methods',
                         component => <<'EOF',
<%method foo></%method>
EOF
                       );

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

    $group->add_test( name => 'comp_exists',
                      description => 'test comp_exists with various types of paths',
                      component => <<'EOF',
<%perl>
my @paths = qw(
   support/methods
   support/methods:foo
   support/methods:bar
   .foo
   .bar
   SELF
   SELF:foo
   PARENT
   PARENT:foo
   REQUEST
   REQUEST:foo
);
</%perl>

<%def .foo></%def>

% foreach my $path (@paths) {
<% $path %>: <% $m->comp_exists($path) %>
% }
EOF
                      expect => <<'EOF',


support/methods: 1
support/methods:foo: 1
support/methods:bar: 0
.foo: 1
.bar: 0
SELF: 1
SELF:foo: 0
PARENT: 0
PARENT:foo: 0
REQUEST: 1
REQUEST:foo: 0
EOF
                 );

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

    $group->add_test( name => 'comp_exists_no_arg',
                      description => 'comp_exists with blank or undefined argument returns 0',
                      component => <<'EOF',
comp_exists(undef) = <% $m->comp_exists(undef) %>
comp_exists("") = <% $m->comp_exists("") %>
EOF
                      expect => <<'EOF',
comp_exists(undef) = 0
comp_exists("") = 0
EOF
                 );

    return $group;
}