lib/DBIx/Class/UTF8Columns.pm

   1 package DBIx::Class::UTF8Columns;
   2 use strict;
   3 use warnings;
   4 use base qw/DBIx::Class/;
   5
   6 __PACKAGE__->mk_classdata( '_utf8_columns' );
   7
   8 =head1 NAME
   9
  10 DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns (DEPRECATED)
  11
  12 =head1 SYNOPSIS
  13
  14     package Artist;
  15     use base 'DBIx::Class::Core';
  16
  17     __PACKAGE__->load_components(qw/UTF8Columns/);
  18     __PACKAGE__->utf8_columns(qw/name description/);
  19
  20     # then belows return strings with utf8 flag
  21     $artist->name;
  22     $artist->get_column('description');
  23
  24 =head1 DESCRIPTION
  25
  26 This module allows you to get and store utf8 (unicode) column data
  27 in a database that does not natively support unicode. It ensures
  28 that column data is correctly serialised as a byte stream when
  29 stored and de-serialised to unicode strings on retrieval.
  30
  31   THE USE OF THIS MODULE (AND ITS COUSIN DBIx::Class::ForceUTF8) IS VERY
  32   STRONGLY DISCOURAGED, PLEASE READ THE WARNINGS BELOW FOR AN EXPLANATION.
  33
  34 If you want to continue using this module and do not want to receive
  35 further warnings set the environmane variable C<DBIC_UTF8COLUMNS_OK>
  36 to a true value.
  37
  38 =head2 Warning - Module does not function properly on create/insert
  39
  40 Recently (April 2010) a bug was found deep in the core of L<DBIx::Class>
  41 which affects any component attempting to perform encoding/decoding by
  42 overloading L<store_column|DBIx::Class::Row/store_column> and
  43 L<get_columns|DBIx::Class::Row/get_columns>. As a result of this problem
  44 L<create|DBIx::Class::ResultSet/create> sends the original column values
  45 to the database, while L<update|DBIx::Class::ResultSet/update> sends the
  46 encoded values. L<DBIx::Class::UTF8Columns> and L<DBIx::Class::ForceUTF8>
  47 are both affected by ths bug.
  48
  49 It is unclear how this bug went undetected for so long (it was
  50 introduced in March 2006), No attempts to fix it will be made while the
  51 implications of changing such a fundamental behavior of DBIx::Class are
  52 being evaluated. However in this day and age you should not be using
  53 this module anyway as Unicode is properly supported by all major
  54 database engines, as explained below.
  55
  56 If you have specific questions about the integrity of your data in light
  57 of this development - please
  58 L<join us on IRC or the mailing list|DBIx::Class/GETTING HELP/SUPPORT>
  59 to further discuss your concerns with the team.
  60
  61 =head2 Warning - Native Database Unicode Support
  62
  63 If your database natively supports Unicode (as does SQLite with the
  64 C<sqlite_unicode> connect flag, MySQL with C<mysql_enable_utf8>
  65 connect flag or Postgres with the C<pg_enable_utf8> connect flag),
  66 then this component should B<not> be used, and will corrupt unicode
  67 data in a subtle and unexpected manner.
  68
  69 It is far better to do Unicode support within the database if
  70 possible rather than converting data to and from raw bytes on every
  71 database round trip.
  72
  73 =head2 Warning - Component Overloading
  74
  75 Note that this module overloads L<DBIx::Class::Row/store_column> in a way
  76 that may prevent other components overloading the same method from working
  77 correctly. This component must be the last one before L<DBIx::Class::Row>
  78 (which is provided by L<DBIx::Class::Core>). DBIx::Class will detect such
  79 incorrect component order and issue an appropriate warning, advising which
  80 components need to be loaded differently.
  81
  82 =head1 SEE ALSO
  83
  84 L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
  85
  86 =head1 METHODS
  87
  88 =head2 utf8_columns
  89
  90 =cut
  91
  92 sub utf8_columns {
  93     my $self = shift;
  94     if (@_) {
  95         foreach my $col (@_) {
  96             $self->throw_exception("column $col doesn't exist")
  97                 unless $self->has_column($col);
  98         }
  99         return $self->_utf8_columns({ map { $_ => 1 } @_ });
 100     } else {
 101         return $self->_utf8_columns;
 102     }
 103 }
 104
 105 =head1 EXTENDED METHODS
 106
 107 =head2 get_column
 108
 109 =cut
 110
 111 sub get_column {
 112     my ( $self, $column ) = @_;
 113     my $value = $self->next::method($column);
 114
 115     utf8::decode($value) if (
 116       defined $value and $self->_is_utf8_column($column) and ! utf8::is_utf8($value)
 117     );
 118
 119     return $value;
 120 }
 121
 122 =head2 get_columns
 123
 124 =cut
 125
 126 sub get_columns {
 127     my $self = shift;
 128     my %data = $self->next::method(@_);
 129
 130     foreach my $col (keys %data) {
 131       utf8::decode($data{$col}) if (
 132         exists $data{$col} and defined $data{$col} and $self->_is_utf8_column($col) and ! utf8::is_utf8($data{$col})
 133       );
 134     }
 135
 136     return %data;
 137 }
 138
 139 =head2 store_column
 140
 141 =cut
 142
 143 sub store_column {
 144     my ( $self, $column, $value ) = @_;
 145
 146     # the dirtyness comparison must happen on the non-encoded value
 147     my $copy;
 148
 149     if ( defined $value and $self->_is_utf8_column($column) and utf8::is_utf8($value) ) {
 150       $copy = $value;
 151       utf8::encode($value);
 152     }
 153
 154     $self->next::method( $column, $value );
 155
 156     return $copy || $value;
 157 }
 158
 159 # override this if you want to force everything to be encoded/decoded
 160 sub _is_utf8_column {
 161   # my ($self, $col) = @_;
 162   return ($_[0]->utf8_columns || {})->{$_[1]};
 163 }
 164
 165 =head1 AUTHORS
 166
 167 See L<DBIx::Class/CONTRIBUTORS>.
 168
 169 =head1 LICENSE
 170
 171 You may distribute this code under the same terms as Perl itself.
 172
 173 =cut
 174
 175 1;