remove_columns now deletes columns from _columns fixing has_columns false positives
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / UTF8Columns.pm
CommitLineData
5dd9c59c 1package DBIx::Class::UTF8Columns;
2use strict;
3use warnings;
4use base qw/DBIx::Class/;
5
8236f0dc 6use utf8;
5dd9c59c 7
4e8964d5 8__PACKAGE__->mk_classdata( '_utf8_columns' );
5dd9c59c 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;
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
57sub 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} ) {
8236f0dc 63 utf8::decode($value) unless utf8::is_utf8($value);
64 }
5dd9c59c 65
66 $value;
67}
68
e063fe2c 69=head2 get_columns
70
71=cut
72
73sub 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 || {} }) {
8236f0dc 78 utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
e063fe2c 79 }
80
81 %data;
82}
83
5dd9c59c 84=head2 store_column
85
86=cut
87
88sub store_column {
89 my ( $self, $column, $value ) = @_;
90
4e8964d5 91 my $cols = $self->_utf8_columns;
92 if ( $cols and defined $value and $cols->{$column} ) {
8236f0dc 93 utf8::encode($value) if utf8::is_utf8($value);
5dd9c59c 94 }
95
96 $self->next::method( $column, $value );
97}
98
99=head1 AUTHOR
100
101Daisuke Murase <typester@cpan.org>
102
103=head1 COPYRIGHT
104
105This program is free software; you can redistribute
106it and/or modify it under the same terms as Perl itself.
107
108The full text of the license can be found in the
109LICENSE file included with this module.
110
111=cut
112
1131;
114