1use strict;
2
3package HTML::FormFu::Filter::Encode;
4$HTML::FormFu::Filter::Encode::VERSION = '2.07';
5# ABSTRACT: Encode/Decode Submitted Values
6
7use Moose;
8use MooseX::Attribute::Chained;
9extends 'HTML::FormFu::Filter';
10
11use Encode qw(encode decode FB_CROAK);
12
13has encode_to => ( is => 'rw', traits => ['Chained'] );
14
15has _candidates => ( is => 'rw' );
16
17sub filter {
18    my ( $self, $value ) = @_;
19
20    return if !defined $value;
21
22    my $utf8 = $self->decode_to_utf8($value);
23
24    die "HTML::FormFu::Filter::Encode: Unable to decode given string to utf8"
25        if !defined $utf8;
26
27    return $self->encode_from_utf8($utf8);
28}
29
30sub get_candidates {
31    my ($self) = @_;
32
33    my $ret = $self->_candidates;
34
35    if ( $ret && wantarray ) {
36        return @$ret;
37    }
38
39    return $ret;
40}
41
42sub candidates {
43    my ( $self, @candidates ) = @_;
44
45    if ( @_ > 1 ) {
46        if ( ref $candidates[0] eq 'ARRAY' ) {
47            $self->_candidates( $candidates[0] );
48        }
49        else {
50            $self->_candidates( [@candidates] );
51        }
52    }
53
54    return $self;
55}
56
57sub decode_to_utf8 {
58    my ( $self, $value ) = @_;
59
60    my $ret;
61
62    foreach my $candidate ( $self->get_candidates ) {
63        eval { $ret = decode( $candidate, $value, FB_CROAK ) };
64
65        if ( !$@ ) {
66            last;
67        }
68    }
69
70    return $ret;
71}
72
73sub encode_from_utf8 {
74    my ( $self, $value ) = @_;
75
76    my $enc = $self->encode_to;
77
78    if ( !$enc ) {
79        return $value;
80    }
81
82    return encode( $enc, $value );
83}
84
85__PACKAGE__->meta->make_immutable;
86
871;
88
89__END__
90
91=pod
92
93=encoding UTF-8
94
95=head1 NAME
96
97HTML::FormFu::Filter::Encode - Encode/Decode Submitted Values
98
99=head1 VERSION
100
101version 2.07
102
103=head1 SYNOPSIS
104
105   # in your config:
106   elements:
107      - type: Text
108        filters:
109           - type: Encode
110             candidates:
111                - utf8
112                - Hebrew
113
114   # if you want to encode the decoded string to something else
115   elements:
116      - type: Text
117        filters:
118           - type: Encode
119             candidates:
120                - utf8
121                - Hebrew
122             encode_to: UTF-32BE
123
124=head1 AUTHOR
125
126Copyright (c) 2007 Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
127All rights reserved.
128
129=head1 LICENSE
130
131This library is free software, you can redistribute it and/or modify it
132under the same terms as Perl itself.
133
134=head1 AUTHOR
135
136Carl Franks <cpan@fireartist.com>
137
138=head1 COPYRIGHT AND LICENSE
139
140This software is copyright (c) 2018 by Carl Franks.
141
142This is free software; you can redistribute it and/or modify it under
143the same terms as the Perl 5 programming language system itself.
144
145=cut
146