view release on metacpan or  search on metacpan

lib/DBIx/Class/UTF8Columns.pm  view on Meta::CPAN

        return $self->_utf8_columns({ map { $_ => 1 } @_ });
    } else {
        return $self->_utf8_columns;
    }
}

=head1 EXTENDED METHODS

=head2 get_column

=cut

sub get_column {
    my ( $self, $column ) = @_;
    my $value = $self->next::method($column);

    utf8::decode($value) if (
      defined $value and $self->_is_utf8_column($column) and ! utf8::is_utf8($value)
    );

    return $value;
}

=head2 get_columns

=cut

sub get_columns {
    my $self = shift;
    my %data = $self->next::method(@_);

    foreach my $col (keys %data) {
      utf8::decode($data{$col}) if (
        exists $data{$col} and defined $data{$col} and $self->_is_utf8_column($col) and ! utf8::is_utf8($data{$col})
      );
    }

    return %data;
}

=head2 store_column

=cut

sub store_column {
    my ( $self, $column, $value ) = @_;

    # the dirtiness comparison must happen on the non-encoded value
    my $copy;

    if ( defined $value and $self->_is_utf8_column($column) and utf8::is_utf8($value) ) {
      $copy = $value;
      utf8::encode($value);
    }

    $self->next::method( $column, $value );

    return $copy || $value;
}

# override this if you want to force everything to be encoded/decoded
sub _is_utf8_column {
  # my ($self, $col) = @_;
  return ($_[0]->utf8_columns || {})->{$_[1]};
}

=head1 FURTHER QUESTIONS?

Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.

=head1 COPYRIGHT AND LICENSE

This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
redistribute it and/or modify it under the same terms as the
L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.

=cut

1;