As clear as it gets
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / UTF8Columns.pm
CommitLineData
5dd9c59c 1package DBIx::Class::UTF8Columns;
2use strict;
3use warnings;
4use base qw/DBIx::Class/;
5
337c98ef 6BEGIN {
7
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.
10 if ($] <= 5.008000) {
11 require Encode;
12 } else {
13 require utf8;
14 }
15}
5dd9c59c 16
4e8964d5 17__PACKAGE__->mk_classdata( '_utf8_columns' );
5dd9c59c 18
19=head1 NAME
20
21DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns
22
23=head1 SYNOPSIS
24
25 package Artist;
d88ecca6 26 use base 'DBIx::Class::Core';
27
28 __PACKAGE__->load_components(qw/UTF8Columns/);
5dd9c59c 29 __PACKAGE__->utf8_columns(qw/name description/);
d4daee7b 30
5dd9c59c 31 # then belows return strings with utf8 flag
32 $artist->name;
33 $artist->get_column('description');
34
35=head1 DESCRIPTION
36
37This module allows you to get columns data that have utf8 (Unicode) flag.
38
39=head1 SEE ALSO
40
41L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
42
43=head1 METHODS
44
45=head2 utf8_columns
46
47=cut
48
49sub utf8_columns {
50 my $self = shift;
4e8964d5 51 if (@_) {
52 foreach my $col (@_) {
53 $self->throw_exception("column $col doesn't exist")
54 unless $self->has_column($col);
55 }
56 return $self->_utf8_columns({ map { $_ => 1 } @_ });
57 } else {
58 return $self->_utf8_columns;
5dd9c59c 59 }
5dd9c59c 60}
61
62=head1 EXTENDED METHODS
63
64=head2 get_column
65
66=cut
67
68sub get_column {
69 my ( $self, $column ) = @_;
70 my $value = $self->next::method($column);
71
4e8964d5 72 my $cols = $self->_utf8_columns;
73 if ( $cols and defined $value and $cols->{$column} ) {
337c98ef 74
75 if ($] <= 5.008000) {
76 Encode::_utf8_on($value) unless Encode::is_utf8($value);
77 } else {
78 utf8::decode($value) unless utf8::is_utf8($value);
79 }
80 }
5dd9c59c 81
82 $value;
83}
84
e063fe2c 85=head2 get_columns
86
87=cut
88
89sub get_columns {
90 my $self = shift;
91 my %data = $self->next::method(@_);
92
4e8964d5 93 foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
337c98ef 94
95 if ($] <= 5.008000) {
96 Encode::_utf8_on($data{$col}) unless Encode::is_utf8($data{$col});
97 } else {
98 utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
99 }
e063fe2c 100 }
101
102 %data;
103}
104
5dd9c59c 105=head2 store_column
106
107=cut
108
109sub store_column {
110 my ( $self, $column, $value ) = @_;
111
4e8964d5 112 my $cols = $self->_utf8_columns;
113 if ( $cols and defined $value and $cols->{$column} ) {
337c98ef 114
115 if ($] <= 5.008000) {
116 Encode::_utf8_off($value) if Encode::is_utf8($value);
117 } else {
118 utf8::encode($value) if utf8::is_utf8($value);
119 }
5dd9c59c 120 }
121
122 $self->next::method( $column, $value );
123}
124
125=head1 AUTHOR
126
127Daisuke Murase <typester@cpan.org>
128
129=head1 COPYRIGHT
130
131This program is free software; you can redistribute
132it and/or modify it under the same terms as Perl itself.
133
134The full text of the license can be found in the
135LICENSE file included with this module.
136
137=cut
138
1391;
140