- Fix the synopsis for DBIC::Storage::DBI. ->datetime_parser returns a class,
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / UTF8Columns.pm
CommitLineData
5dd9c59c 1package DBIx::Class::UTF8Columns;
2use strict;
3use warnings;
4use base qw/DBIx::Class/;
5dd9c59c 5
4e8964d5 6__PACKAGE__->mk_classdata( '_utf8_columns' );
5dd9c59c 7
8=head1 NAME
9
10DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns
11
7c14c3cf 12 Please ensure you understand the purpose of this module before use.
13 Read the warnings below to prevent data corruption through misuse.
14
5dd9c59c 15=head1 SYNOPSIS
16
17 package Artist;
d88ecca6 18 use base 'DBIx::Class::Core';
19
20 __PACKAGE__->load_components(qw/UTF8Columns/);
5dd9c59c 21 __PACKAGE__->utf8_columns(qw/name description/);
d4daee7b 22
5dd9c59c 23 # then belows return strings with utf8 flag
24 $artist->name;
25 $artist->get_column('description');
26
27=head1 DESCRIPTION
28
7c14c3cf 29This module allows you to get and store utf8 (unicode) column data
30in a database that does not natively support unicode. It ensures
31that column data is correctly serialised as a byte stream when
32stored and de-serialised to unicode strings on retrieval.
33
34=head2 Warning - Native Database Unicode Support
35
36If your database natively supports Unicode (as does SQLite with the
37C<sqlite_unicode> connect flag, MySQL with C<mysql_enable_utf8>
38connect flag or Postgres with the C<pg_enable_utf8> connect flag),
39then this component should B<not> be used, and will corrupt unicode
40data in a subtle and unexpected manner.
41
42It is far better to do Unicode support within the database if
43possible rather convert data into and out of the database on every
44round trip.
5dd9c59c 45
7c14c3cf 46=head2 Warning - Component Overloading
d38cd95c 47
48Note that this module overloads L<DBIx::Class::Row/store_column> in a way
49that may prevent other components overloading the same method from working
50correctly. This component must be the last one before L<DBIx::Class::Row>
51(which is provided by L<DBIx::Class::Core>). DBIx::Class will detect such
52incorrect component order and issue an appropriate warning, advising which
53components need to be loaded differently.
54
5dd9c59c 55=head1 SEE ALSO
56
57L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
58
59=head1 METHODS
60
61=head2 utf8_columns
62
63=cut
64
65sub utf8_columns {
66 my $self = shift;
4e8964d5 67 if (@_) {
68 foreach my $col (@_) {
69 $self->throw_exception("column $col doesn't exist")
70 unless $self->has_column($col);
d38cd95c 71 }
4e8964d5 72 return $self->_utf8_columns({ map { $_ => 1 } @_ });
73 } else {
74 return $self->_utf8_columns;
5dd9c59c 75 }
5dd9c59c 76}
77
78=head1 EXTENDED METHODS
79
80=head2 get_column
81
82=cut
83
84sub get_column {
85 my ( $self, $column ) = @_;
86 my $value = $self->next::method($column);
87
d38cd95c 88 utf8::decode($value) if (
89 defined $value and $self->_is_utf8_column($column) and ! utf8::is_utf8($value)
90 );
5dd9c59c 91
55087b99 92 return $value;
5dd9c59c 93}
94
e063fe2c 95=head2 get_columns
96
97=cut
98
99sub get_columns {
100 my $self = shift;
101 my %data = $self->next::method(@_);
102
d38cd95c 103 foreach my $col (keys %data) {
104 utf8::decode($data{$col}) if (
105 exists $data{$col} and defined $data{$col} and $self->_is_utf8_column($col) and ! utf8::is_utf8($data{$col})
106 );
e063fe2c 107 }
108
55087b99 109 return %data;
e063fe2c 110}
111
5dd9c59c 112=head2 store_column
113
114=cut
115
116sub store_column {
117 my ( $self, $column, $value ) = @_;
118
d38cd95c 119 # the dirtyness comparison must happen on the non-encoded value
120 my $copy;
121
122 if ( defined $value and $self->_is_utf8_column($column) and utf8::is_utf8($value) ) {
123 $copy = $value;
124 utf8::encode($value);
5dd9c59c 125 }
126
127 $self->next::method( $column, $value );
d38cd95c 128
129 return $copy || $value;
5dd9c59c 130}
131
d38cd95c 132# override this if you want to force everything to be encoded/decoded
133sub _is_utf8_column {
2ba92e45 134 # my ($self, $col) = @_;
135 return ($_[0]->utf8_columns || {})->{$_[1]};
d38cd95c 136}
5dd9c59c 137
d38cd95c 138=head1 AUTHORS
5dd9c59c 139
d38cd95c 140See L<DBIx::Class/CONTRIBUTORS>.
5dd9c59c 141
d38cd95c 142=head1 LICENSE
5dd9c59c 143
d38cd95c 144You may distribute this code under the same terms as Perl itself.
5dd9c59c 145
146=cut
147
1481;