#!/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 => '<%== "♥" %> + <%= "♥" %>', prepend => [], args => [], sql => qr{^♥ \+ \?$}, 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'; ok @{ $tpl->variables } ~~ @{ $t->{vars} }, 'Bind variables'; } } =head1 COPYRIGHT Copyright (C) 2011 Dmitry E. Oboukhov Copyright (C) 2011 Roman V. Nikolaev This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut