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 | |
4e8964d5 |
8 | __PACKAGE__->mk_classdata( '_utf8_columns' ); |
5dd9c59c |
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; |
4e8964d5 |
40 | if (@_) { |
41 | foreach my $col (@_) { |
42 | $self->throw_exception("column $col doesn't exist") |
43 | unless $self->has_column($col); |
44 | } |
45 | return $self->_utf8_columns({ map { $_ => 1 } @_ }); |
46 | } else { |
47 | return $self->_utf8_columns; |
5dd9c59c |
48 | } |
5dd9c59c |
49 | } |
50 | |
51 | =head1 EXTENDED METHODS |
52 | |
53 | =head2 get_column |
54 | |
55 | =cut |
56 | |
57 | sub get_column { |
58 | my ( $self, $column ) = @_; |
59 | my $value = $self->next::method($column); |
60 | |
4e8964d5 |
61 | my $cols = $self->_utf8_columns; |
62 | if ( $cols and defined $value and $cols->{$column} ) { |
5dd9c59c |
63 | Encode::_utf8_on($value) unless Encode::is_utf8($value); |
64 | } |
65 | |
66 | $value; |
67 | } |
68 | |
e063fe2c |
69 | =head2 get_columns |
70 | |
71 | =cut |
72 | |
73 | sub get_columns { |
74 | my $self = shift; |
75 | my %data = $self->next::method(@_); |
76 | |
4e8964d5 |
77 | foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) { |
404939a4 |
78 | Encode::_utf8_on($data{$col}) unless Encode::is_utf8($data{$col}); |
e063fe2c |
79 | } |
80 | |
81 | %data; |
82 | } |
83 | |
5dd9c59c |
84 | =head2 store_column |
85 | |
86 | =cut |
87 | |
88 | sub store_column { |
89 | my ( $self, $column, $value ) = @_; |
90 | |
4e8964d5 |
91 | my $cols = $self->_utf8_columns; |
92 | if ( $cols and defined $value and $cols->{$column} ) { |
5dd9c59c |
93 | Encode::_utf8_off($value) if Encode::is_utf8($value); |
94 | } |
95 | |
96 | $self->next::method( $column, $value ); |
97 | } |
98 | |
99 | =head1 AUTHOR |
100 | |
101 | Daisuke Murase <typester@cpan.org> |
102 | |
103 | =head1 COPYRIGHT |
104 | |
105 | This program is free software; you can redistribute |
106 | it and/or modify it under the same terms as Perl itself. |
107 | |
108 | The full text of the license can be found in the |
109 | LICENSE file included with this module. |
110 | |
111 | =cut |
112 | |
113 | 1; |
114 | |