Updated version and Changes for 0.06999_02
[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 use Encode;
7
8 __PACKAGE__->mk_classdata( force_utf8_columns => [] );
9
10 =head1 NAME
11
12 DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns
13
14 =head1 SYNOPSIS
15
16     package Artist;
17     __PACKAGE__->load_components(qw/UTF8Columns Core/);
18     __PACKAGE__->utf8_columns(qw/name description/);
19     
20     # then belows return strings with utf8 flag
21     $artist->name;
22     $artist->get_column('description');
23
24 =head1 DESCRIPTION
25
26 This module allows you to get columns data that have utf8 (Unicode) flag.
27
28 =head1 SEE ALSO
29
30 L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
31
32 =head1 METHODS
33
34 =head2 utf8_columns
35
36 =cut
37
38 sub utf8_columns {
39     my $self = shift;
40     for (@_) {
41         $self->throw_exception("column $_ doesn't exist")
42             unless $self->has_column($_);
43     }
44     $self->force_utf8_columns( \@_ );
45 }
46
47 =head1 EXTENDED METHODS
48
49 =head2 get_column
50
51 =cut
52
53 sub get_column {
54     my ( $self, $column ) = @_;
55     my $value = $self->next::method($column);
56
57     if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
58         Encode::_utf8_on($value) unless Encode::is_utf8($value);
59     }
60
61     $value;
62 }
63
64 =head2 get_columns
65
66 =cut
67
68 sub get_columns {
69     my $self = shift;
70     my %data = $self->next::method(@_);
71
72     for (@{ $self->force_utf8_columns }) {
73         Encode::_utf8_on($data{$_}) if $data{$_} and !Encode::is_utf8($_);
74     }
75
76     %data;
77 }
78
79 =head2 store_column
80
81 =cut
82
83 sub store_column {
84     my ( $self, $column, $value ) = @_;
85
86     if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
87         Encode::_utf8_off($value) if Encode::is_utf8($value);
88     }
89
90     $self->next::method( $column, $value );
91 }
92
93 =head1 AUTHOR
94
95 Daisuke Murase <typester@cpan.org>
96
97 =head1 COPYRIGHT
98
99 This program is free software; you can redistribute
100 it and/or modify it under the same terms as Perl itself.
101
102 The full text of the license can be found in the
103 LICENSE file included with this module.
104
105 =cut
106
107 1;
108