lib/DBIx/Class/UTF8Columns.pm

   1 package DBIx::Class::UTF8Columns;
   2 use strict;
   3 use warnings;
   4 use base qw/DBIx::Class/;
   5 use utf8;
   6
   7 __PACKAGE__->mk_classdata( '_utf8_columns' );
   8
   9 =head1 NAME
  10
  11 DBIx::Class::UTF8Columns - Force UTF8 (Unicode) flag on columns
  12
  13 =head1 SYNOPSIS
  14
  15     package Artist;
  16     use base 'DBIx::Class::Core';
  17
  18     __PACKAGE__->load_components(qw/UTF8Columns/);
  19     __PACKAGE__->utf8_columns(qw/name description/);
  20
  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;
  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;
  49     }
  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
  62     my $cols = $self->_utf8_columns;
  63     if ( $cols and defined $value and $cols->{$column} ) {
  64       utf8::decode($value) unless utf8::is_utf8($value);
  65     }
  66
  67     return $value;
  68 }
  69
  70 =head2 get_columns
  71
  72 =cut
  73
  74 sub get_columns {
  75     my $self = shift;
  76     my %data = $self->next::method(@_);
  77
  78     foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
  79       utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
  80     }
  81
  82     return %data;
  83 }
  84
  85 =head2 store_column
  86
  87 =cut
  88
  89 sub store_column {
  90     my ( $self, $column, $value ) = @_;
  91
  92     my $cols = $self->_utf8_columns;
  93     if ( $cols and defined $value and $cols->{$column} ) {
  94       utf8::encode($value) if utf8::is_utf8($value);
  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