File Coverage

blib/lib/DBIx/Simple/UTF8Columns.pm

Criterion	Covered	Total	%
statement	30	95	31.5
branch	0	30	0.0
condition	0	15	0.0
subroutine	10	21	47.6
pod	2	3	66.6
total	42	164	25.6

use strict;
use warnings;
use Carp ();
use 5.8.1;
use utf8;
use Encode ();
use DBIx::Simple 1.28;

$Carp::Internal{$_} = 1
    for qw( DBIx::Simple::UTF8Columns
            DBIx::Simple::UTF8Columns::Result );

package DBIx::Simple::UTF8Columns;

our $VERSION = '0.03';

use base qw( DBIx::Simple );

our $DEFAULT_ENCODING = 'utf8';

sub connect {
    my $class = shift;
    my $db    = $class->SUPER::connect(@_);

    if (defined $db) {
        # 'result_class' is lvalue
        $db->result_class = 'DBIx::Simple::UTF8Columns::Result';
    }

    return $db;
}

sub encoding {
    my $self = shift;

    if (! ref $self) {      # class method
        if (@_) {
            $DEFAULT_ENCODING = shift;
        }
        return $DEFAULT_ENCODING;
    }
    else {                  # instance method
        if (@_) {
            $self->{_encoding} = shift;
            $self->{_encoder}  = undef;
        }
        elsif (! defined $self->{_encoding}) {
            $self->{_encoding} = $DEFAULT_ENCODING;
            $self->{_encoder}  = undef;
        }
        return $self->{_encoding};
    }
}

sub _encoder {
    my $self = shift;

    if (! defined $self->{_encoder}) {
        $self->{_encoder} = Encode::find_encoding($self->encoding);
    }

    return $self->{_encoder};
}

sub query {
    my ($self, $query, @binds) = @_;

    foreach my $data ($query, @binds) {
        if (defined $data && ! ref $data && utf8::is_utf8($data)) {
            $data = $self->_encoder->encode($data);
        }
    }

    my $result = $self->SUPER::query($query, @binds);

    if ($self->{success} && defined $result) {
        $result->{_encoder} = $self->_encoder;
    }

    return $result;
}

package DBIx::Simple::UTF8Columns::Result;

use base qw( DBIx::Simple::Result );
use Carp;

sub _encoder {
    my ($self) = @_;

    if (! defined $self->{_encoder}) {
        $self->{_encoder}
            = Encode::find_encoding($DBIx::Simple::UTF8Columns::DEFAULT_ENCODING);
    }

    return $self->{_encoder};
}

sub _decode {
    my ($self, $data) = @_;

    if (defined $data && ! utf8::is_utf8($data)) {
        $data = $self->_encoder->decode($data);
    }
    return $data;
}

sub _encode {
    my ($self, $data) = @_;

    if (defined $data && utf8::is_utf8($data)) {
        $data = $self->_encoder->encode($data);
    }
    return $data;
}

# UNSUPPORTED: func, attr
# UNTOUCH:     columns
# UNSUPPORTED: bind, fetch, into

sub list {
    my $self = shift;

    my @results = $self->SUPER::list(@_);

    if (wantarray) {
        foreach my $result (@results) {
            $result = $self->_decode($result);
        }
        return @results;
    }
    else {
        return $self->_decode($results[-1]);
    }
}

sub array {
    my $self = shift;

    my $ref_result = $self->SUPER::array(@_);

    if (defined $ref_result) {
        foreach my $data (@$ref_result) {
            $data = $self->_decode($data);
        }
    }

    return $ref_result;
}

sub hash {
    my $self = shift;

    my $ref_results = $self->SUPER::hash(@_);

    if (defined $ref_results) {
        foreach my $result (values %$ref_results) {
            $result = $self->_decode($result);
        }
    }

    return $ref_results;
}

# UNTOUCH:     flat

sub arrays {
    my $self = shift;

    my @results = $self->SUPER::arrays(@_);
    foreach my $result (@results) {
        foreach my $column (@$result) {
            $column = $self->_decode($column);
        }
    }
    return wantarray ? @results : \@results;
}

# UNTOUCH:     hashes, map_hashes, map_arrays, map, rows, xto, html, text

1;
__END__