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