root/lang/perl/Encode-JP-Mobile/trunk/lib/Encode/JP/Mobile/Character.pm @ 6443

Revision 6443, 4.6 kB (checked in by tokuhirom, 6 years ago)

fixed pod.Devel::Cover++

Line 
1package Encode::JP::Mobile::Character;
2use strict;
3use warnings;
4use Encode;
5use Encode::JP::Mobile::Charnames;
6use Encode::JP::Mobile ':props';
7use File::ShareDir 'dist_file';
8use Carp;
9
10sub from_unicode {
11    my ($class, $unicode) = @_;
12    bless {unicode => $unicode}, $class;
13}
14
15sub from_number {
16    my $class = shift;
17    my %args = @_;
18    my $carrier = $args{carrier} or croak "missing carrier";
19    my $number = $args{number} or croak "missing number";
20
21    my $dat = $class->_load_map;
22
23    $carrier = +{I => 'docomo', E => 'kddi', V => 'softbank', 'H' => 'docomo'}->{$carrier};
24    $number = encode_utf8($number);
25
26    my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
27    for my $row (@{$dat->{$carrier}}) {
28        if ($row->{number} eq $number) {
29            return $class->from_unicode(hex $row->{$key});
30        }
31    }
32    croak "unknown number: $number for $carrier";
33}
34
35sub unicode_hex {
36    my ($class, ) = @_;
37    sprintf '%X', $class->{unicode};
38}
39
40my $map;
41sub _load_map {
42    $map ||= +{
43        map { $_, do( dist_file( 'Encode-JP-Mobile', "${_}-table.pl" ) ) }
44          qw/docomo kddi softbank/
45    };
46
47    return $map;
48}
49
50sub name {
51    my $self = shift;
52
53    my $dat = $self->_load_map;
54
55    for my $carrier (keys %$dat) {
56        my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
57        for my $row (@{ $dat->{$carrier} }) {
58            next unless exists $row->{'name'};
59            if (hex($row->{$key}) == $self->{unicode}) {
60                return decode_utf8($row->{name});
61            }
62        }
63    }
64
65    return;
66}
67
68sub number {
69    my $self = shift;
70
71    my $dat = $self->_load_map;
72
73    for my $carrier (keys %$dat) {
74        my $key = $carrier eq 'kddi' ? 'unicode_auto' : 'unicode';
75        for my $row (@{ $dat->{$carrier} }) {
76            next unless exists $row->{'number'};
77            if (hex($row->{$key}) == $self->{unicode}) {
78                return decode_utf8($row->{number});
79            }
80        }
81    }
82
83    return;
84}
85
86my $fallback_name_cache  = do {
87    my $src = dist_file('Encode-JP-Mobile', 'convert-map-utf8.pl');
88    do $src;
89};
90sub fallback_name {
91    my ($self, $carrier) = @_;
92    croak "missing carrier" unless $carrier;
93    croak "invalid carrier name(I or E or V)" unless $carrier =~ /^[IEVH]$/;
94
95    $carrier = +{I => 'docomo', E => 'kddi', V => 'softbank', 'H' => 'docomo'}->{$carrier};
96
97    for my $from (keys %$fallback_name_cache) {
98        if (my $row = $fallback_name_cache->{$from}->{sprintf '%X', $self->{unicode}}->{$carrier}) {
99            if ($row->{type} eq 'name') {
100                return decode 'utf8', $row->{unicode};
101            } else {
102                return;
103            }
104        }
105    }
106    return;
107}
108
109sub carrier {
110    my $self = shift;
111    my $uni = chr $self->{unicode};
112    if ($uni =~ /\p{InDoCoMoPictograms}/) {
113        return 'I';
114    } elsif ($uni =~ /\p{InSoftBankPictograms}/) {
115        return 'V';
116    } elsif ($uni =~ /\p{InKDDIAutoPictograms}/) {
117        return 'E';
118    } else {
119        return;
120    }
121}
122
1231;
124__END__
125
126=encoding utf8
127
128=head1 NAME
129
130Encode::JP::Mobile::Character - pictogram character object
131
132=head1 SYNOPSIS
133
134    my $char = Encode::JP::Mobile::Character->from_unicode(0xE63E);
135    $char->name; # => 晴れ
136
137=head1 DESCRIPTION
138
139絵文字の文字を表現するオブジェクトです。
140
141=head1 METHODS
142
143=over 4
144
145=item from_unicode
146
147    my $char = Encode::JP::Mobile::Character->from_unicode(0xE63E);
148
149unicode からインスタンスをつくります。
150
151=item from_number
152
153    my $char = Encode::JP::Mobile::Character->from_number(
154        carrier => 'I',
155        number  => "拡76",
156    );
157
158絵文字番号からインスタンスをつくります。
159
160=item name
161
162    $char->name; # => 晴れ
163
164絵文字の名称を得ます。
165
166=item unicode_hex
167
168    $char->unicode_hex; # => "E63E"
169
170ユニコードの16進数4桁による文字列の表現を返します。
171
172=item fallback_name
173
174    $char->fallback_name('I'); # => (>3<)
175
176メール受信時のキャリヤ間相互絵文字変換において、絵文字に変換されないときに変換される文字列です。
177
178引数は I, E, V, H のうちいずれかで、これは HTTP::MobileAgent 準拠です。
179
180=item number
181
182    $char->number;
183
184絵文字番号を得ます。
185
186DoCoMo の場合には「拡76」のような文字列が返ってくることに注意してください。
187
188=item carrier
189
190    $char->carrier;
191
192キャリヤを得ます。L<HTTP::MobileAgent> と同じ規則により、I, E, V のうちいずれかを返します。
193絵文字ではない場合には、undef を返します。
194
195=back
196
197=head1 AUTHOR
198
199Tokuhiro Matsuno
200
201=head1 SEE ALSO
202
203L<Encode::JP::Mobile>
204
Note: See TracBrowser for help on using the browser.