cycle tests and a weaken call
[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
6use Encode;
7
8__PACKAGE__->mk_classdata( force_utf8_columns => [] );
9
10=head1 NAME
11
12DBIx::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
26This module allows you to get columns data that have utf8 (Unicode) flag.
27
28=head1 SEE ALSO
29
30L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
31
32=head1 METHODS
33
34=head2 utf8_columns
35
36=cut
37
38sub 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
53sub 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
e063fe2c 64=head2 get_columns
65
66=cut
67
68sub 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
5dd9c59c 79=head2 store_column
80
81=cut
82
83sub 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
95Daisuke Murase <typester@cpan.org>
96
97=head1 COPYRIGHT
98
99This program is free software; you can redistribute
100it and/or modify it under the same terms as Perl itself.
101
102The full text of the license can be found in the
103LICENSE file included with this module.
104
105=cut
106
1071;
108