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