Merge HasA, HasMany and MightHave into one file, Relationships, for easier
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / UTF8Columns.pm
1 package DBIx::Class::UTF8Columns;
2 use strict;
3 use warnings;
4 use base qw/DBIx::Class/;
5
6 BEGIN {
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 }
16
17 __PACKAGE__->mk_classdata( '_utf8_columns' );
18
19 =head1 NAME
20
21 DBIx::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
35 This module allows you to get columns data that have utf8 (Unicode) flag.
36
37 =head1 SEE ALSO
38
39 L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
40
41 =head1 METHODS
42
43 =head2 utf8_columns
44
45 =cut
46
47 sub utf8_columns {
48     my $self = shift;
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;
57     }
58 }
59
60 =head1 EXTENDED METHODS
61
62 =head2 get_column
63
64 =cut
65
66 sub get_column {
67     my ( $self, $column ) = @_;
68     my $value = $self->next::method($column);
69
70     my $cols = $self->_utf8_columns;
71     if ( $cols and defined $value and $cols->{$column} ) {
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     }
79
80     $value;
81 }
82
83 =head2 get_columns
84
85 =cut
86
87 sub get_columns {
88     my $self = shift;
89     my %data = $self->next::method(@_);
90
91     foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
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         }
98     }
99
100     %data;
101 }
102
103 =head2 store_column
104
105 =cut
106
107 sub store_column {
108     my ( $self, $column, $value ) = @_;
109
110     my $cols = $self->_utf8_columns;
111     if ( $cols and defined $value and $cols->{$column} ) {
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         }
118     }
119
120     $self->next::method( $column, $value );
121 }
122
123 =head1 AUTHOR
124
125 Daisuke Murase <typester@cpan.org>
126
127 =head1 COPYRIGHT
128
129 This program is free software; you can redistribute
130 it and/or modify it under the same terms as Perl itself.
131
132 The full text of the license can be found in the
133 LICENSE file included with this module.
134
135 =cut
136
137 1;
138