remove_columns now deletes columns from _columns fixing has_columns false positives
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / UTF8Columns.pm
1 package DBIx::Class::UTF8Columns;
2 use strict;
3 use warnings;
4 use base qw/DBIx::Class/;
5
6 use utf8;
7
8 __PACKAGE__->mk_classdata( '_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     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;
48     }
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
61     my $cols = $self->_utf8_columns;
62     if ( $cols and defined $value and $cols->{$column} ) {
63         utf8::decode($value) unless utf8::is_utf8($value);
64    }
65
66     $value;
67 }
68
69 =head2 get_columns
70
71 =cut
72
73 sub get_columns {
74     my $self = shift;
75     my %data = $self->next::method(@_);
76
77     foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
78         utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
79     }
80
81     %data;
82 }
83
84 =head2 store_column
85
86 =cut
87
88 sub store_column {
89     my ( $self, $column, $value ) = @_;
90
91     my $cols = $self->_utf8_columns;
92     if ( $cols and defined $value and $cols->{$column} ) {
93         utf8::encode($value) if utf8::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