view release on metacpan or  search on metacpan

t/10_tt_includes.t  view on Meta::CPAN

# -*- Mode: Perl; -*-

=head1 NAME

01_includes.t - Test the file include functionality of Template::Alloy - including some edge cases

=cut

our ($module, $is_tt, $compile_perl, $use_stream);
BEGIN {
    $module = 'Template::Alloy';
    if ($ENV{'USE_TT'} || grep {/tt/i} @ARGV) {
        $module = 'Template';
    }
    $is_tt = $module eq 'Template';
};

use strict;
use Test::More tests => (! $is_tt) ? 351 : 106;
use constant test_taint => 0 && eval { require Taint::Runtime };

use_ok($module);

Taint::Runtime::taint_start() if test_taint;

### find a place to allow for testing
my $test_dir = $0 .'.test_dir';
END { unlink "$test_dir/stream.out"; rmdir $test_dir }
mkdir $test_dir, 0755;
ok(-d $test_dir, "Got a test dir up and running");
mkdir "$test_dir/nested", 0755;
END { rmdir "$test_dir/nested" }
ok(-d $test_dir, "Got a nested test dir up and running");

sub process_ok { # process the value and say if it was ok
    my $str  = shift;
    my $test = shift;
    my $vars = shift || {};
    my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
    push @$conf, (COMPILE_PERL => $compile_perl) if $compile_perl;
    push @$conf, (STREAM => 1) if $use_stream;
    my $obj  = shift || $module->new(@$conf, ABSOLUTE => 1, INCLUDE_PATH => $test_dir); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    Taint::Runtime::taint(\$str) if test_taint;

    my $fh;
    if ($use_stream) {
        open($fh, ">", "$test_dir/stream.out") || return ok(0, "Line $line   \"$str\" - Can't open stream.out: $!");
        select $fh;
    }

    $obj->process(\$str, $vars, \$out);

    if ($use_stream) {
        select STDOUT;
        close $fh;
        open($fh, "<", "$test_dir/stream.out") || return ok(0, "Line $line   \"$str\" - Can't read stream.out: $!");
        $out = '';
        read($fh, $out, -s "$test_dir/stream.out");
    }

    my $ok = ref($test) ? $out =~ $test : $out eq $test;
    if ($ok) {
        ok(1, "Line $line   \"$str\" => \"$out\"");
        return $obj;
    } else {
        ok(0, "Line $line   \"$str\"");
        warn "# Was:\n$out\n# Should've been:\n$test\n";
        print map {"$_\n"} grep { defined } $obj->error if $obj->can('error');
        print $obj->dump_parse_tree(\$str) if $obj->can('dump_parse_tree');
        if ($compile_perl && $obj->can('compile_template')) {
            foreach my $key (sort keys %{ $obj->{'_documents'} }) {
                my $v = $obj->{'_documents'}->{$key};
                print "--------------------- $key ---------------------\n";
                print ${ $obj->compile_template($v) };
            }
        }
        exit;
    }
}

### create some files to include
my @files;
END { unlink @files };
sub write_file {
    my ($file, $content) = @_;
    push @files, $file;
    open(my $fh, ">", $file) || die "Couldn't open $file: $!";
    print $fh $content;
    close $fh;
}

write_file("$test_dir/foo.tt",         "([% template.foo %][% INCLUDE bar.tt %])");
write_file("$test_dir/bar.tt",         "[% blue %]BAR");
write_file("$test_dir/baz.tt",         "[% SET baz = 42 %][% baz %][% bing %]");
write_file("$test_dir/wrap.tt",        "Hi[% baz; template.foo; baz = 'wrap' %][% content %]there");
write_file("$test_dir/meta.tt",        "[% META bar='meta.tt' %]Metafoo([% component.foo %]) Metabar([% component.bar %])");
write_file("$test_dir/catch.tt",       "Error ([% error.type %]) - ([% error.info %])");
write_file("$test_dir/catch2.tt",      "Error2 ([% error.type %]) - ([% error.info %])");
write_file("$test_dir/die.tt",         "[% THROW bing 'blang' %])");
write_file("$test_dir/config.tt",      "[% CONFIG DUMP => {html => 1} %][% DUMP foo %]");