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