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