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