#============================================================= -*-perl-*- # # t/unicode.t # # Test the handling of Unicode text in templates. # # Written by Mark Fowler <mark@twoshortplanks.com> # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # $Id$ # #======================================================================== use strict; use warnings; use lib qw( ./lib ../lib ); use Template::Provider; #use Template::Test; #ntests(20); BEGIN { unless ($] > 5.007) { print "1..0 # Skip perl < 5.8 can't do unicode well enough\n"; exit; } } use Template; use File::Temp qw(tempfile tempdir); use File::Spec::Functions; use Cwd; use Test::More tests => 20; # This is 'moose...' (with slashes in the 'o's them, and the '...' as one char). my $moose = "m\x{f8}\x{f8}se\x{2026}"; # right, create some templates in various encodings by hand # (it's the only way to be 100% sure they contain the right text) my %encoded_text = ( 'UTF-8' => "\x{ef}\x{bb}\x{bf}m\x{c3}\x{b8}\x{c3}\x{b8}se\x{e2}\x{80}\x{a6}", 'UTF-16BE' => "\x{fe}\x{ff}\x{0}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e &", 'UTF-16LE' => "\x{ff}\x{fe}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e\x{0}& ", 'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}\x{0}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0} &", 'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0}\x{0}& \x{0}\x{0}", ); # write those variables to temp files in a temp directory my %filenames = ( map { $_ => write_to_temp_file( filename => $_, text => $encoded_text{ $_ }, # uncomment to create files in cwd # dir => cwd, ) } keys %encoded_text ); my $tempdir = create_cache_dir(); # setup template toolkit and test all the encodings my $tt = setup_tt( tempdir => $tempdir ); test_it("first try", $tt, \%filenames, $moose); test_it("in memory", $tt, \%filenames, $moose); # okay, now we test everything again to see if the cache file # was written in a consisant state $tt = setup_tt( tempdir => $tempdir ); test_it("from cache", $tt, \%filenames, $moose); test_it("in cache, in memory", $tt, \%filenames, $moose); ######################################################################### sub create_cache_dir { return tempdir( CLEANUP => 1 ); } sub setup_tt { my %args = @_; return Template->new( ABSOLUTE => 1, COMPILE_DIR => $args{tempdir}, COMPILE_EXT => ".ttcache"); } sub test_it { local $Test::Builder::Level = $Test::Builder::Level + 1; my $name = shift; my $tt = shift; my $filenames = shift; my $string = shift; foreach my $encoding (keys %{ $filenames }) { my $output; $tt->process($filenames->{ $encoding },{},\$output) or $output = $tt->error; is(reasciify($output), reasciify($string), "$name - $encoding"); } } #------------------------------------------------------------------------ # reascify($string) # # escape all the high and low chars to \x{..} sequences #------------------------------------------------------------------------ sub reasciify { my $string = shift; $string = join '', map { my $ord = ord($_); ($ord > 127 || ($ord < 32 && $ord != 10)) ? sprintf '\x{%x}', $ord : $_ } split //, $string; return $string; } #------------------------------------------------------------------------ # write_to_temp_file( dir => $dir, filename => $file, text => $text) # # escape all the high and low chars to \x{..} sequences #------------------------------------------------------------------------ sub write_to_temp_file { my %args = @_; # use a temp dir unless one was specified. We automatically # delete the contents when we're done with the tempdir, where # otherwise we just leave the files lying around. unless (exists $args{dir}) { $args{dir} = tempdir( CLEANUP => 1 ); } # work out where we're going to store it my $temp_filename = catfile($args{dir}, $args{filename}); # open a filehandle with some PerlIO magic to convert data into # the correct encoding with the correct BOM on the front open my $temp_fh, ">:raw", $temp_filename or die "Can't write to '$temp_filename': $!"; # write the data out print $temp_fh $args{text}; close $temp_fh; # return where we've created it return $temp_filename; }