| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  |  | 
| 2 | 1 |  |  | 1 |  | 3 | use strict; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 3 | 1 |  |  | 1 |  | 3 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | package Jifty::DBI::Filter::utf8; | 
| 6 | 1 |  |  | 1 |  | 3 | use base qw/Jifty::DBI::Filter/; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 69 |  | 
| 7 | 1 |  |  | 1 |  | 6 | use Encode (); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 166 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 NAME | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Jifty::DBI::Filter::utf8 - Jifty::DBI UTF-8 data filter | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | This filter allow you to check that you operate with | 
| 16 |  |  |  |  |  |  | valid UTF-8 data. | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | Usage as type specific filter is recommended. | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | =head1 METHODS | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | =head2 encode | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | Method always unset UTF-8 flag on the value, but | 
| 25 |  |  |  |  |  |  | if value doesn't have flag then method checks | 
| 26 |  |  |  |  |  |  | value for malformed UTF-8 data and stop on | 
| 27 |  |  |  |  |  |  | the first bad code. | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | =cut | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | sub encode { | 
| 32 | 5 |  |  | 5 | 1 | 6 | my $self = shift; | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 5 |  |  |  |  | 13 | my $value_ref = $self->value_ref; | 
| 35 | 5 | 100 |  |  |  | 30 | return undef unless ( defined($$value_ref) ); | 
| 36 |  |  |  |  |  |  |  | 
| 37 | 4 | 100 |  |  |  | 11 | if ( Encode::is_utf8($$value_ref) ) { | 
| 38 | 1 |  |  |  |  | 2 | $$value_ref = Encode::encode_utf8($$value_ref); | 
| 39 |  |  |  |  |  |  | } else { | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | # if value has no utf8 flag but filter on the stack | 
| 42 |  |  |  |  |  |  | # we do double encoding, and stop on the first bad characters | 
| 43 |  |  |  |  |  |  | # with FB_QUIET fallback schema. We this schema because we | 
| 44 |  |  |  |  |  |  | # don't want data grow | 
| 45 | 3 |  |  |  |  | 14 | $$value_ref = Encode::encode_utf8( | 
| 46 |  |  |  |  |  |  | Encode::decode_utf8( $$value_ref, Encode::FB_QUIET ) ); | 
| 47 |  |  |  |  |  |  | } | 
| 48 | 4 |  |  |  |  | 87 | return 1; | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | =head2 decode | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | Checks whether value is correct UTF-8 data or not and | 
| 54 |  |  |  |  |  |  | substitute all malformed data with the C<0xFFFD> code point. | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | Always set UTF-8 flag on the value. | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | =cut | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub decode { | 
| 61 | 6 |  |  | 6 | 1 | 8 | my $self = shift; | 
| 62 |  |  |  |  |  |  |  | 
| 63 | 6 |  |  |  |  | 16 | my $value_ref = $self->value_ref; | 
| 64 | 6 | 100 |  |  |  | 31 | return undef unless ( defined($$value_ref) ); | 
| 65 |  |  |  |  |  |  |  | 
| 66 | 4 | 50 |  |  |  | 16 | unless ( Encode::is_utf8($$value_ref) ) { | 
| 67 | 4 |  |  |  |  | 14 | $$value_ref = Encode::decode_utf8($$value_ref); | 
| 68 |  |  |  |  |  |  | } | 
| 69 | 4 |  |  |  |  | 95 | return 1; | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | 1; | 
| 73 |  |  |  |  |  |  | __END__ |