The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);

use Test::More tests    => 46;
use Encode qw(decode encode);


BEGIN {
    # Подготовка объекта тестирования для работы с utf8
    my $builder = Test::More->builder;
    binmode $builder->output,         ":utf8";
    binmode $builder->failure_output, ":utf8";
    binmode $builder->todo_output,    ":utf8";

    note "************* DBIx::DR::PerlishTemplate *************";
    use_ok 'DBIx::DR::PerlishTemplate';
    use_ok 'File::Spec::Functions', 'catfile', 'rel2abs';
    use_ok 'File::Basename', 'dirname', 'basename';

}

my $tpl = DBIx::DR::PerlishTemplate->new;
ok $tpl, 'DBIx::DR::PerlishTemplate->new';


my @tests = (
    {
        template    => q{
            %= 50 - 11
            +
            <%==
                24 / 12
             %> + <%== 12 / 6 %>
             %== '+ 1'
        },
        prepend     => [],
        args        => [],
        sql         => qr{^\s*\?\s*\+\s*2\s*\+\s*2\s*\+\s*1\s*$}s,
        vars        => [ 39 ],
        name        => 'Immediate substitutions',
    },

    {
        template    => '%= 13 / 8',
        prepend     => [],
        args        => [],
        sql         => qr{^\?$},
        vars        => [ 13 / 8 ],
        name        => 'Placeholder test',
    },
    {
        template    => '%== 13 / 8',
        prepend     => [],
        args        => [],
        sql         => qr{^1\.625$},
        vars        => [],
        name        => 'Immediate substitution',

    },

    {
        template    => '%= $variable',
        prepend     => ['my $variable = 127'],
        args        => [],
        sql         => qr{^\?$},
        vars        => [127],
        name        => 'Placeholder substitution with prepend',
    },

    {
        template    => '%= $variable',
        prepend     => [],
        args        => [],
        sql         => qr{^\?$},
        vars        => [127],
        name        => 'Placeholder substitution without prepend',
        die         => qr{\$variable}
    },

    {
        template    => '<%== 24 / 12 %> + <%== 12 / 6 %>',
        prepend     => [],
        args        => [],
        sql         => qr{^2 \+ 2$},
        vars        => [],
        name        => 'Immediate substitutions',
    },

    {
        template    => '<%= 24 / 12 %> + <%== 12 / 6 %>',
        prepend     => [],
        args        => [],
        sql         => qr{^\? \+ 2$},
        vars        => [2],
        name        => 'Immediate and placeholder substitutions',
    },

    {
        template    => 'a%<%== "♥" %>-% + <%= "♥" %>',
        prepend     => [],
        args        => [],
        sql         => qr{^a%♥-% \+ \?$},
        vars        => ['♥'],
        name        => 'UTF8 Immediate and placeholder substitutions',
    },

    {
        template    => q{
            % my $path = $0;
            % use File::Spec::Functions qw(catfile rel2abs);
            % use File::Basename qw(dirname);
            %= rel2abs dirname $0},
        prepend     => [],
        args        => [],
        sql         => qr{^\s*\?$},
        vars        => [ rel2abs dirname $0 ],
        name        => 'UTF8 Immediate and placeholder substitutions',
    },
    {
        template    => q[
            % for (1 .. 10) {
            <%= $_ %>,
            % }
        ],
        prepend     => [],
        args        => [],
        sql         => qr[^(\s*\?,){10}\s*$]s,
        vars        => [ 1 .. 10 ],
        name        => 'foreach',
    },
    {
        template    => q^
            SELECT
                '{abc}'::text[] AS "array"
        ^,
        prepend     => [],
        args        => [],
        sql         => qr[SELECT\s+'\{abc\}']s,
        vars        => [],
        name        => '{} brackets',
    },
);

for my $t(@tests) {
    $t->{prepend} ||= [];
    $t->{preprepend} ||= [];


    $tpl->clean_prepend;
    $tpl->prepend($_) for @{ $t->{prepend} };
    $tpl->preprepend($_) for @{ $t->{preprepend} };

    my $res = eval { $tpl->render($t->{template}, @{ $t->{args} }) };
    diag $@ unless ok $res || $t->{die}, $t->{name};
    if ($t->{die}) {
        like $@, $t->{die}, 'Renderer died';
    } else {
        diag $@ unless ok !$@, 'Rendered without exceptions';
        like $tpl->sql, $t->{sql}, 'Rendering sql';
        diag $tpl->sql unless
        ok @{ $tpl->variables } ~~ @{ $t->{vars} }, 'Bind variables';
    }
}


=head1 COPYRIGHT

 Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
 Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>

 This program is free software, you can redistribute it and/or
 modify it under the terms of the Artistic License.

=cut