1 package DBIx::Class::UTF8Columns;
4 use base qw/DBIx::Class/;
8 # Perl 5.8.0 doesn't have utf8::is_utf8()
9 # Yes, 5.8.0 support for Unicode is suboptimal, but things like RHEL3 ship with it.
17 __PACKAGE__->mk_classdata( '_utf8_columns' );
21 DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns
26 __PACKAGE__->load_components(qw/UTF8Columns Core/);
27 __PACKAGE__->utf8_columns(qw/name description/);
29 # then belows return strings with utf8 flag
31 $artist->get_column('description');
35 This module allows you to get columns data that have utf8 (Unicode) flag.
39 L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
50 foreach my $col (@_) {
51 $self->throw_exception("column $col doesn't exist")
52 unless $self->has_column($col);
54 return $self->_utf8_columns({ map { $_ => 1 } @_ });
56 return $self->_utf8_columns;
60 =head1 EXTENDED METHODS
67 my ( $self, $column ) = @_;
68 my $value = $self->next::method($column);
70 my $cols = $self->_utf8_columns;
71 if ( $cols and defined $value and $cols->{$column} ) {
74 Encode::_utf8_on($value) unless Encode::is_utf8($value);
76 utf8::decode($value) unless utf8::is_utf8($value);
89 my %data = $self->next::method(@_);
91 foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
94 Encode::_utf8_on($data{$col}) unless Encode::is_utf8($data{$col});
96 utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
108 my ( $self, $column, $value ) = @_;
110 my $cols = $self->_utf8_columns;
111 if ( $cols and defined $value and $cols->{$column} ) {
113 if ($] <= 5.008000) {
114 Encode::_utf8_off($value) if Encode::is_utf8($value);
116 utf8::encode($value) if utf8::is_utf8($value);
120 $self->next::method( $column, $value );
125 Daisuke Murase <typester@cpan.org>
129 This program is free software; you can redistribute
130 it and/or modify it under the same terms as Perl itself.
132 The full text of the license can be found in the
133 LICENSE file included with this module.