Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
157 lines (126 sloc) 4.55 KB
#============================================================= -*-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;
}