1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
#============================================================= -*-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;
}
|
