File Coverage

blib/lib/Encode/JP/Mobile/Character.pm

Criterion	Covered	Total	%
statement	89	93	95.7
branch	37	40	92.5
condition	2	2	100.0
subroutine	18	18	100.0
pod	8	8	100.0
total	154	161	95.6

package Encode::JP::Mobile::Character;
use strict;
use warnings;
use Encode;
use Encode::JP::Mobile::Charnames;
use Encode::JP::Mobile ':props';
use File::ShareDir 'dist_file';
use Carp;

sub from_unicode {
    my ($class, $unicode) = @_;
    bless {unicode => $unicode}, $class;
}

sub from_number {
    my $class = shift;
    my %args = @_;
    my $carrier = $args{carrier} or croak "missing carrier";
    my $number = $args{number} or croak "missing number";

    my $dat = $class->_load_map;

    $carrier = +{I => 'docomo', E => 'kddi', V => 'softbank', 'H' => 'docomo'}->{$carrier};
    $number = encode_utf8($number);

    my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
    for my $row (@{$dat->{$carrier}}) {
        if ($row->{number} eq $number) {
            return $class->from_unicode(hex $row->{$key});
        }
    }
    croak "unknown number: $number for $carrier";
}

sub unicode_hex {
    my ($class, ) = @_;
    sprintf '%X', $class->{unicode};
}

my $map;
sub _load_map {
    $map ||= +{
        map { $_, do( _dist_file( 'Encode-JP-Mobile', "${_}-table.pl" ) ) }
          qw/docomo kddi softbank/
    };

    return $map;
}

sub name {
    my $self = shift;

    my $dat = $self->_load_map;

    for my $carrier (keys %$dat) {
        my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
        for my $row (@{ $dat->{$carrier} }) {
            next unless exists $row->{'name'};
            if (hex($row->{$key}) == $self->{unicode}) {
                return decode_utf8($row->{name});
            }
        }
    }

    return;
}

sub name_en {
    my $self = shift;

    my $dat = $self->_load_map;

    for my $carrier (keys %$dat) {
        my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
        for my $row (@{ $dat->{$carrier} }) {
            next unless exists $row->{'name_en'};
            if (hex($row->{$key}) == $self->{unicode}) {
                return decode_utf8($row->{name_en});
            }
        }
    }

    return;
}

sub number {
    my $self = shift;

    my $dat = $self->_load_map;

    for my $carrier (keys %$dat) {
        my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
        for my $row (@{ $dat->{$carrier} }) {
            next unless exists $row->{'number'};
            if (hex($row->{$key}) == $self->{unicode}) {
                return decode_utf8($row->{number});
            }
        }
    }

    return;
}

my $fallback_name_cache  = do {
    my $src = _dist_file('Encode-JP-Mobile', 'convert-map-utf8.pl');
    do $src;
};
sub fallback_name {
    my ($self, $carrier) = @_;
    croak "missing carrier" unless $carrier;
    croak "invalid carrier name(I or E or V)" unless $carrier =~ /^[IEVH]$/;

    $carrier = +{I => 'docomo', E => 'kddi', V => 'softbank', 'H' => 'docomo'}->{$carrier};

    for my $from (keys %$fallback_name_cache) {
        if (my $row = $fallback_name_cache->{$from}->{sprintf '%X', $self->{unicode}}->{$carrier}) {
            if ($row->{type} eq 'name') {
                return decode 'utf8', $row->{unicode};
            } else {
                return;
            }
        }
    }
    return;
}

sub carrier {
    my $self = shift;
    my $uni = chr $self->{unicode};
    if ($uni =~ /\p{InDoCoMoPictograms}/) {
        return 'I';
    } elsif ($uni =~ /\p{InSoftBankPictograms}/) {
        return 'V';
    } elsif ($uni =~ /\p{InKDDIAutoPictograms}/) {
        return 'E';
    } else {
        return;
    }
}


sub _dist_file {
    local $^W = 0; no warnings 'uninitialized'; # shuts up File-ShareDir warnings
    dist_file(@_);
}

1;
__END__