1#!perl -w
2
3use strict;
4use Test::More;
5
6use Text::ClearSilver;
7use utf8;
8
9use Encode qw(encode);
10
11my $tcs = Text::ClearSilver->new(encoding => 'utf8', functions => 'string');
12
13my $template = <<"END";
14"<?cs var:ja ?>" means "<?cs var:en ?>" in Japanese Kanji
15END
16
17my $out;
18my %var = (ja => "駱駝", en => 'camel');
19
20undef $out;
21$tcs->process(\$template, \%var, \$out);
22is $out, qq{"駱駝" means "camel" in Japanese Kanji\n}, "encoding => 'utf8'";
23
24undef $out;
25$tcs->process(\$template, \%var, \$out, encoding => 'bytes');
26isnt $out, qq{"駱駝" means "camel" in Japanese Kanji\n}, "encoding => 'bytes' breaks the output";
27
28undef $out;
29$tcs->process('camel.tcs', \%var, \$out, load_path => [qw(t/data)]);
30is $out, qq{"駱駝"は英語で"camel"といいます。\n}, "encoding => 'utf8'";
31
32undef $out;
33$tcs->process('camel.tcs', \%var, \$out, load_path => [qw(t/data)], input_layer => ":utf8");
34is $out, qq{"駱駝"は英語で"camel"といいます。\n}, "encoding => 'utf8'";
35
36undef $out;
37$tcs->process('camel.tcs', \%var, \$out, load_path => [qw(t/data)], encoding => 'bytes');
38isnt $out, qq{"駱駝"は英語で"camel"といいます。\n}, "encoding => 'bytes' breaks the output";
39
40undef $out;
41my $orig_template = $template = q{<?cs var:sprintf("駱駝") ?>};
42$tcs->process(\$template, {}, \$out);
43is $template, $orig_template, '$template is not touched';
44is $out, '駱駝';
45
46utf8::encode($template);
47$orig_template = $template;
48$tcs->process(\$template, {}, \$out);
49is $template, $orig_template, '$template is not touched';
50is $out, '駱駝';
51
52$tcs->register_function(is_utf8 => sub{ utf8::is_utf8($_[0]) });
53undef $out;
54$tcs->process(\q{<?cs var:is_utf8(foo) ?>}, { foo => "駱駝" }, \$out);
55ok $out, 'function arguments are utf8';
56
57undef $out;
58$tcs->process(\q{<?cs var:is_utf8(foo) ?>}, { foo => "駱駝" }, \$out, encoding => "bytes");
59ok !$out, 'function arguments are not utf8';
60
61$tcs->register_function( 'string.substr' => sub {
62    if(@_ == 2){
63        return substr $_[0], $_[1];
64    }
65    elsif(@_ == 3){
66        return substr $_[0], $_[1], $_[2];
67    }
68    else {
69        die "wrong number of arguments for substr";
70    }
71} );
72
73$tcs->process(\q{<?cs var:string.substr("foo ほげ bar", 0, 5) ?>}, {}, \$out);
74is $out, "foo ほ", "can define substr()";
75
76my $non_utf8 = encode Shift_JIS => "ラクダ";
77eval {
78    $tcs->process(\'', { camel => $non_utf8 }, \my $out);
79};
80like $@, qr/value.+not utf8/, $@;
81
82eval {
83    $tcs->process(\'', { $non_utf8 => "camel" }, \my $out);
84};
85like $@, qr/key.+not utf8/, $@;
86
87my $utf8 = encode utf_8 => "ラクダ";
88eval {
89    $tcs->process(\'', { camel => $utf8 }, \my $out);
90};
91is $@, '', 'utf8 encoded bytes';
92
93
94done_testing;
95