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 Encode;
   7
   8 __PACKAGE__->mk_classdata( force_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     for (@_) {
  41         $self->throw_exception("column $_ doesn't exist")
  42             unless $self->has_column($_);
  43     }
  44     $self->force_utf8_columns( \@_ );
  45 }
  46
  47 =head1 EXTENDED METHODS
  48
  49 =head2 get_column
  50
  51 =cut
  52
  53 sub get_column {
  54     my ( $self, $column ) = @_;
  55     my $value = $self->next::method($column);
  56
  57     if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
  58         Encode::_utf8_on($value) unless Encode::is_utf8($value);
  59     }
  60
  61     $value;
  62 }
  63
  64 =head2 store_column
  65
  66 =cut
  67
  68 sub store_column {
  69     my ( $self, $column, $value ) = @_;
  70
  71     if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
  72         Encode::_utf8_off($value) if Encode::is_utf8($value);
  73     }
  74
  75     $self->next::method( $column, $value );
  76 }
  77
  78 =head1 AUTHOR
  79
  80 Daisuke Murase <typester@cpan.org>
  81
  82 =head1 COPYRIGHT
  83
  84 This program is free software; you can redistribute
  85 it and/or modify it under the same terms as Perl itself.
  86
  87 The full text of the license can be found in the
  88 LICENSE file included with this module.
  89
  90 =cut
  91
  92 1;
  93