1# $Id$
2
3package Test::Data::Visitor::Encode;
4use strict;
5use warnings;
6use Data::Visitor::Callback;
7use Encode qw(encode decode encode_utf8 decode_utf8 is_utf8 FB_CROAK);
8use Test::More;
9use Test::Exception;
10
11sub import {
12    my $caller = caller(1);
13
14    foreach my $method qw(decode_ok encode_ok decode_utf8_ok encode_utf8_ok utf8_on_ok utf8_off_ok) {
15        no strict 'refs';
16        *{"${caller}::${method}"} = \&{$method};
17    }
18}
19
20sub encode_ok {
21    my ($enc, $data, $title) = @_;
22
23    lives_ok {
24        my $dve = Data::Visitor::Encode->new();
25        $dve->encode($enc, $data);
26    } "encode() doesn't croak";
27
28    Data::Visitor::Callback->new(
29        ignore_return_values => 1,
30        object => "visit_ref",
31        plain_value => sub {
32            my $caller;
33            my $i = 1;
34            do {
35                $caller = caller($i++);
36            } while ($caller =~ /Data::Visitor/);
37
38            local $Test::Builder::Level = $Test::Builder::Level + $i;
39            lives_ok { decode($enc, $_[1], &FB_CROAK) }
40                encode_utf8("value '" . (eval { decode($enc, $_[1]) } || '(fail)') . "' encodes to '$enc' for '$title'")
41            ;
42        }
43    )->visit($data);
44}
45
46sub decode_ok {
47    my ($enc, $data, $title) = @_;
48    my $dve = Data::Visitor::Encode->new();
49    $dve->decode($enc, $data);
50
51    Data::Visitor::Callback->new(
52        ignore_return_values => 1,
53        object => "visit_ref",
54        plain_value => sub {
55            my $caller;
56            my $i = 1;
57            do {
58                $caller = caller($i++);
59            } while ($caller =~ /Data::Visitor/);
60
61            local $Test::Builder::Level = $Test::Builder::Level + $i;
62            lives_ok { encode($enc, $_[1], &FB_CROAK) }
63                encode_utf8("value '$_[1]' decodes from '$enc' for '$title'")
64            ;
65        }
66    )->visit($data);
67}
68
69sub encode_utf8_ok {
70    my ($data, $title) = @_;
71
72    lives_ok {
73        my $dve = Data::Visitor::Encode->new();
74        $dve->encode_utf8($data);
75    } "encode_utf8 ok";
76
77    Data::Visitor::Callback->new(
78        ignore_return_values => 1,
79        object => "visit_ref",
80        plain_value => sub {
81            my $caller;
82            my $i = 1;
83            do {
84                $caller = caller($i++);
85            } while ($caller =~ /Data::Visitor/);
86
87            local $Test::Builder::Level = $Test::Builder::Level + $i;
88            ok(!is_utf8($_[1], 1), "value $_[1] is not utf8 for '$title'");
89        }
90    )->visit($data);
91}
92
93sub decode_utf8_ok {
94    my ($data, $title) = @_;
95
96    lives_ok {
97        my $dve = Data::Visitor::Encode->new();
98        $dve->decode_utf8($data);
99    } "decode_utf8 ok";
100
101    Data::Visitor::Callback->new(
102        ignore_return_values => 1,
103        object => "visit_ref",
104        plain_value => sub {
105            my $caller;
106            my $i = 1;
107            do {
108                $caller = caller($i++);
109            } while ($caller =~ /Data::Visitor/);
110
111            local $Test::Builder::Level = $Test::Builder::Level + $i;
112            ok(is_utf8($_[1], 1), encode_utf8("value $_[1] is utf8 for '$title'"));
113        }
114    )->visit($data);
115}
116
117sub utf8_on_ok {
118    my ($data, $title) = @_;
119
120    lives_ok {
121        my $dve = Data::Visitor::Encode->new();
122        $dve->utf8_on($data);
123    } "utf8_on ok";
124
125    Data::Visitor::Callback->new(
126        ignore_return_values => 1,
127        object => "visit_ref",
128        plain_value => sub {
129            my $caller;
130            my $i = 1;
131            do {
132                $caller = caller($i++);
133            } while ($caller =~ /Data::Visitor/);
134
135            local $Test::Builder::Level = $Test::Builder::Level + $i;
136            ok(is_utf8($_[1], 1), encode_utf8("value $_[1] is utf8 for '$title'"));
137        }
138    )->visit($data);
139}
140
141sub utf8_off_ok {
142    my ($data, $title) = @_;
143
144    lives_ok {
145        my $dve = Data::Visitor::Encode->new();
146        $dve->utf8_off($data);
147    } "utf8_off ok";
148
149    Data::Visitor::Callback->new(
150        ignore_return_values => 1,
151        object => "visit_ref",
152        plain_value => sub {
153            my $caller;
154            my $i = 1;
155            do {
156                $caller = caller($i++);
157            } while ($caller =~ /Data::Visitor/);
158
159            local $Test::Builder::Level = $Test::Builder::Level + $i;
160            ok(! is_utf8($_[1], 1), "value $_[1] is NOT utf8 for '$title'");
161        }
162    )->visit($data);
163}
164
1651;
166