Commit | Line | Data |
5dd9c59c |
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 store_column |
65 | |
66 | =cut |
67 | |
68 | sub store_column { |
69 | my ( $self, $column, $value ) = @_; |
70 | |
71 | if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) { |
72 | Encode::_utf8_off($value) if Encode::is_utf8($value); |
73 | } |
74 | |
75 | $self->next::method( $column, $value ); |
76 | } |
77 | |
78 | =head1 AUTHOR |
79 | |
80 | Daisuke Murase <typester@cpan.org> |
81 | |
82 | =head1 COPYRIGHT |
83 | |
84 | This program is free software; you can redistribute |
85 | it and/or modify it under the same terms as Perl itself. |
86 | |
87 | The full text of the license can be found in the |
88 | LICENSE file included with this module. |
89 | |
90 | =cut |
91 | |
92 | 1; |
93 | |