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 get_columns
  65
  66 =cut
  67
  68 sub get_columns {
  69     my $self = shift;
  70     my %data = $self->next::method(@_);
  71
  72     for (@{ $self->force_utf8_columns }) {
  73         Encode::_utf8_on($data{$_}) if $data{$_} and !Encode::is_utf8($_);
  74     }
  75
  76     %data;
  77 }
  78
  79 =head2 store_column
  80
  81 =cut
  82
  83 sub store_column {
  84     my ( $self, $column, $value ) = @_;
  85
  86     if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
  87         Encode::_utf8_off($value) if Encode::is_utf8($value);
  88     }
  89
  90     $self->next::method( $column, $value );
  91 }
  92
  93 =head1 AUTHOR
  94
  95 Daisuke Murase <typester@cpan.org>
  96
  97 =head1 COPYRIGHT
  98
  99 This program is free software; you can redistribute
 100 it and/or modify it under the same terms as Perl itself.
 101
 102 The full text of the license can be found in the
 103 LICENSE file included with this module.
 104
 105 =cut
 106
 107 1;
 108