File Coverage

blib/lib/POE/Component/IRC/Plugin/Unicode/UCD.pm

Criterion	Covered	Total	%
statement	18	40	45.0
branch	0	14	0.0
condition	0	6	0.0
subroutine	6	10	60.0
pod			n/a
total	24	70	34.2

package POE::Component::IRC::Plugin::Unicode::UCD;

use warnings;
use strict;

our $VERSION = '0.004';

use base 'POE::Component::IRC::Plugin::BaseWrap';

use Carp;
use Encode qw/decode encode_utf8/;
use Unicode::UCD 'charinfo';

sub _make_default_args {
    return (
        response_event  => 'irc_unicode_ucd',
        trigger         => qr/^utf8?\s+(?=\S)/i,
    );
}

sub _make_response_message {
    my ( $self, $in_ref ) = @_;
    return [ $self->_unip( $in_ref->{what} ) ];
}

sub _make_response_event {
    my ( $self, $in_ref ) = @_;
    $in_ref->{result} = $self->_unip( $in_ref->{what} );
    return $in_ref;
}

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

    $_ = "0x$_"
        if !s/^[Uu]\+/0x/
            and /[A-Fa-f]/
            and /^[[:xdigit:]]{2,}\z/;

    $_ = oct if /^0/;

    unless ( /^\d+\z/ ) {
        eval {
            my $tmp = decode(
                length > 1 ? 'utf8' : 'iso-8859-1',
                "$_",
                1
            );

            die "'$_' is not numeric, conversion to unicode failed"
                unless length ($tmp) == 1;

            $_ = ord $tmp;
        };
        if ( $@ ) {
            ( my $err = $@ ) =~ s/ at .* line \d+.*\z//s;
            return $err;
        }
    }
    my $utf8r = encode_utf8( chr );
    my $utf8 = join ' ', map "0x$_", unpack '(H2)*', $utf8r;
    my $x;

    return sprintf "U+%X (%s): no match found", $_, $utf8
        unless $x = charinfo $_;

    return "U+$x->{code} ($utf8): $x->{name} [$utf8r]";
}

1;

__END__