File Coverage

blib/lib/CBOR/Free/X/WideCharacter.pm

Criterion	Covered	Total	%
statement	23	23	100.0
branch	2	2	100.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	31	31	100.0

package CBOR::Free::X::WideCharacter;

use strict;
use warnings;

use parent qw( CBOR::Free::X::Base );

use Text::Control ();

sub _new {
    my ($class, $value) = @_;

    my $hex = Text::Control::to_hex($value);

    $hex = _escape_multibyte($hex);

    return $class->SUPER::_new("Cannot encode wide character(s): “$hex”");
}

sub _escape_multibyte {
    my ($value) = @_;

    for my $i ( reverse 0 .. (length($value) - 1) ) {
        my $chr = substr( $value, $i, 1 );

        if (ord $chr > 0xff) {
            substr( $value, $i, 1, sprintf "\\x{%x}", ord $chr );
        }
    }

    utf8::encode($value);

    return "$value";
}

1;