File Coverage

blib/lib/Data/Recursive/Encode.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	14	16	87.5
condition	8	19	42.1
subroutine	17	17	100.0
pod	5	5	100.0
total	110	123	89.4

package Data::Recursive::Encode;
use 5.008001;
use strict;
use warnings FATAL => 'all';

our $VERSION = '0.04';

use Encode ();
use Carp ();
use Scalar::Util qw(blessed refaddr);

sub _apply {
    my $code = shift;
    my $seen = shift;

    my @retval;
    for my $arg (@_) {
        if(my $ref = ref $arg){
            my $refaddr = refaddr($arg);
            my $proto;

            if(defined($proto = $seen->{$refaddr})){
                 # noop
            }
            elsif($ref eq 'ARRAY'){
                $proto = $seen->{$refaddr} = [];
                @{$proto} = _apply($code, $seen, @{$arg});
            }
            elsif($ref eq 'HASH'){
                $proto = $seen->{$refaddr} = {};
                %{$proto} = _apply($code, $seen, %{$arg});
            }
            elsif($ref eq 'REF' or $ref eq 'SCALAR'){
                $proto = $seen->{$refaddr} = \do{ my $scalar };
                ${$proto} = _apply($code, $seen, ${$arg});
            }
            else{ # CODE, GLOB, IO, LVALUE etc.
                $proto = $seen->{$refaddr} = $arg;
            }

            push @retval, $proto;
        }
        else{
            push @retval, defined($arg) ? $code->($arg) : $arg;
        }
    }

    return wantarray ? @retval : $retval[0];
}

sub decode {
    my ($class, $encoding, $stuff, $check) = @_;
    $encoding = Encode::find_encoding($encoding)
        || Carp::croak("$class: unknown encoding '$encoding'");
    $check ||= 0;
    _apply(sub { $encoding->decode($_[0], $check) }, {}, $stuff);
}

sub encode {
    my ($class, $encoding, $stuff, $check) = @_;
    $encoding = Encode::find_encoding($encoding)
        || Carp::croak("$class: unknown encoding '$encoding'");
    $check ||= 0;
    _apply(sub { $encoding->encode($_[0], $check) }, {}, $stuff);
}

sub decode_utf8 {
    my ($class, $stuff, $check) = @_;
    _apply(sub { Encode::decode_utf8($_[0], $check) }, {}, $stuff);
}

sub encode_utf8 {
    my ($class, $stuff) = @_;
    _apply(sub { Encode::encode_utf8($_[0]) }, {}, $stuff);
}

sub from_to {
    my ($class, $stuff, $from_enc, $to_enc, $check) = @_;
    @_ >= 4 or Carp::croak("Usage: $class->from_to(OCTET, FROM_ENC, TO_ENC[, CHECK])");
    $from_enc = Encode::find_encoding($from_enc)
        || Carp::croak("$class: unknown encoding '$from_enc'");
    $to_enc = Encode::find_encoding($to_enc)
        || Carp::croak("$class: unknown encoding '$to_enc'");
    _apply(sub { Encode::from_to($_[0], $from_enc, $to_enc, $check) }, {}, $stuff);
    return $stuff;
}

1;
__END__