Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

merge Encode::JP::Mobile::Character branch to trunk.

  • Loading branch information...
commit 2f914ac99aa5ce5ea3bbe9fc50d9214a1d758f24 1 parent be600c4
tokuhirom authored
View
4 Rakefile
@@ -50,9 +50,9 @@ unoh_files.each do |f|
end
end
-carriers.map {|x| "dat/#{x}-table.pl"}.each do |f|
+[carriers.map {|x| "dat/#{x}-table.pl"}, 'dat/convert-map-utf8.pl'].flatten.each do |f|
file f => [f.gsub(/\.pl/, '.yaml')] do
- sh "#{perl} ./tools/make-charnames-map.pl"
+ sh "#{perl} ./tools/yaml2perl.pl #{f.gsub(/\.pl/, '.yaml')} #{f}"
end
end
View
13,788 dat/convert-map-utf8.pl
13,788 additions, 0 deletions not shown
View
11,024 dat/convert-map-utf8.yaml
8,268 additions, 2,756 deletions not shown
View
19 lib/Encode/JP/Mobile.pm
@@ -33,6 +33,7 @@ define_alias( 'x-utf8-vodafone' => 'x-utf8-softbank' );
use Encode::JP::Mobile::Vodafone;
use Encode::JP::Mobile::KDDIJIS;
use Encode::JP::Mobile::ConvertPictgramSJIS;
+use Encode::JP::Mobile::Character;
sub InDoCoMoPictograms {
return <<END;
@@ -108,6 +109,24 @@ E501\tE537
END
}
+sub FB_CHARACTER {
+ my $u = shift;
+
+ my $i = 0;
+ while (
+ my @called =
+ do { package DB; @DB::args = (); caller( $i++ ) }
+ )
+ {
+ next if $called[3] ne 'Encode::encode';
+ my $enc = Encode::find_encoding( $DB::args[0] )->name;
+ my ( $charset, $carrier ) = $enc =~ /-([^-]+?)-([^-]+)/;
+ $carrier = +{ airh => 'H', docomo => 'I', vodafone => 'V', softbank => 'V', imode => 'I' }->{$carrier};
+
+ my $char = Encode::JP::Mobile::Character->from_unicode($u);
+ return encode( $charset, $char->fallback_name($carrier) );
+ }
+}
1;
View
206 lib/Encode/JP/Mobile/Character.pm
@@ -0,0 +1,206 @@
+package Encode::JP::Mobile::Character;
+use strict;
+use warnings;
+use Encode;
+use Encode::JP::Mobile::Charnames;
+use Encode::JP::Mobile;
+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 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;
+sub fallback_name {
+ my ($self, $carrier) = @_;
+ croak "missing carrier" unless $carrier;
+ croak "invalid carrier name(I or E or V)" unless $carrier =~ /^[IEVH]$/;
+
+ $fallback_name_cache ||= do {
+ my $src = dist_file('Encode-JP-Mobile', 'convert-map-utf8.pl');
+ do $src;
+ };
+
+ $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{Encode::JP::Mobile::InDoCoMoPictograms}/) {
+ return 'I';
+ } elsif ($uni =~ /\p{Encode::JP::Mobile::InSoftBankPictograms}/) {
+ return 'V';
+ } elsif ($uni =~ /\p{Encode::JP::Mobile::InKDDIAutoPictograms}/) {
+ return 'E';
+ } else {
+ return;
+ }
+}
+
+1;
+__END__
+
+=encodings utf8
+
+=head1 NAME
+
+Encode::JP::Mobile::Character - pictogram character object
+
+=head1 SYNOPSIS
+
+ my $char = Encode::JP::Mobile::Character->from_unicode(0xE63E);
+ $char->name; # => 晴れ
+
+=head1 DESCRIPTION
+
+絵文字の文字を表現するオブジェクトです。
+
+=head1 METHODS
+
+=over 4
+
+=item from_unicode
+
+ my $char = Encode::JP::Mobile::Character->from_unicode(0xE63E);
+
+unicode からインスタンスをつくります。
+
+=item from_name
+
+ my $char = Encode::JP::Mobile::Character->from_name(
+ carrier => 'I',
+ number => "拡76",
+ );
+
+絵文字番号からインスタンスをつくります。
+
+=item name
+
+ $char->name; # => 晴れ
+
+絵文字の名称を得ます。
+
+=item unicode_hex
+
+ $char->unicode_hex; # => "E63E"
+
+ユニコードの16進数4桁による文字列の表現を返します。
+
+=item fallback_name
+
+ $char->fallback_name('I'); # => (>3<)
+
+メール受信時のキャリヤ間相互絵文字変換において、絵文字に変換されないときに変換される文字列です。
+
+引数は I, E, V, H のうちいずれかで、これは HTTP::MobileAgent 準拠です。
+
+=item number
+
+ $char->number;
+
+絵文字番号を得ます。
+
+DoCoMo の場合には「拡76」のような文字列が返ってくることに注意してください。
+
+=item carrier
+
+ $char->carrier;
+
+キャリヤを得ます。L<HTTP::MobileAgent> と同じ規則により、I, E, V のうちいずれかを返します。
+絵文字ではない場合には、undef を返します。
+
+=back
+
+=head1 AUTHOR
+
+Tokuhiro Matsuno
+
+=head1 SEE ALSO
+
+L<Encode::JP::Mobile>
+
View
53 t/character.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+use utf8;
+use Encode::JP::Mobile::Character;
+use Test::More tests => 18;
+
+# docomo
+{
+ my $char = Encode::JP::Mobile::Character->from_unicode(0xE63E);
+ is $char->name, "晴れ";
+ ok Encode::is_utf8($char->name), 'flagged';
+ is $char->unicode_hex, "E63E";
+ is $char->number, 1;
+ is $char->fallback_name('I'), undef;
+}
+
+# docomo ext
+{
+ my $char = Encode::JP::Mobile::Character->from_unicode(0xE757);
+ is $char->number, "拡76", 'docomo ext';
+ ok Encode::is_utf8($char->number);
+}
+
+{
+ is(Encode::JP::Mobile::Character->from_number(carrier => 'I', number => "拡76")->unicode_hex, 'E757');
+}
+
+# KDDI
+{
+ my $char = Encode::JP::Mobile::Character->from_unicode(0xECA2);
+ is $char->fallback_name('I'), "(>3<)";
+ is $char->fallback_name('H'), "(>3<)", "airhphone is same as docomo";
+ ok Encode::is_utf8($char->fallback_name('I'));
+ is $char->name, "チュー2", "What's name for 0xECA2";
+ ok Encode::is_utf8($char->name);
+ is $char->number, 455, 'number';
+}
+
+# KDDI from number.
+{
+ is(Encode::JP::Mobile::Character->from_number(carrier => 'E', number => 455)->unicode_hex, 'ECA2');
+}
+
+# carrier
+my $map = +{
+ 0xE532 => 'V',
+ 0xECE7 => 'E',
+ 0xE6E5 => 'I',
+};
+while (my ($unicode, $carrier) = each %$map) {
+ is(Encode::JP::Mobile::Character->from_unicode($unicode)->carrier, $carrier, "carrier $carrier");
+}
+
View
8 t/fb_character.t
@@ -0,0 +1,8 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Encode;
+use Encode::JP::Mobile;
+
+is encode('x-utf8-docomo', "\x{ECA2}", \&Encode::JP::Mobile::FB_CHARACTER), "(>3<)";
+
View
19 tools/make-charnames-map.pl
@@ -1,19 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Data::Dumper;
-use YAML;
-use FindBin;
-use File::Spec::Functions;
-
-$Data::Dumper::Terse++;
-
-for my $carrier (qw/docomo softbank kddi/) {
- my $src_fname = catfile($FindBin::Bin, '..', 'dat', "${carrier}-table.yaml");
- my $dst_fname = catfile($FindBin::Bin, '..', 'dat', "${carrier}-table.pl");
-
- open my $fh, '>', $dst_fname or die $!;
- print $fh Dumper(YAML::LoadFile($src_fname));
- close $fh;
-}
-
View
5 tools/make-convert-map.pl
@@ -38,6 +38,7 @@
for my $line (@line) {
next unless $line =~ /^%/;
chomp $line;
+ $line = decode 'cp932', $line;
$file eq 'emoji_i2es.txt' && do {
my ($docomo, undef, $kddi, $softbank) = split "\t", $line;
@@ -63,9 +64,9 @@ ($)
my $key = shift;
if ($key =~ /^%/) {
$key =~ s/(%[^%]+%)/$no2uni->{$1}/ge;
- return $key;
+ return +{ type => 'pictogram', unicode => $key };
} else {
- return;
+ return +{ type => 'name', unicode => $key };
}
}
View
5 tools/make-utf8-ucm.pl
@@ -35,8 +35,9 @@ sub main {
print {$fh} "\n\n# pictogram convert map ($from => $to)\n";
for my $srcuni (sort keys %{$map->{$from}}) {
- my $dstuni = $map->{$from}{$srcuni}{$to} or next;
- printf {$fh} "<U%s> %s |1 # %s\n", $srcuni, unihex2utf8hex($dstuni), comment_for($from);
+ my $dstuni = $map->{$from}->{$srcuni}->{$to} or next;
+ next unless $dstuni->{type} eq 'pictogram';
+ printf {$fh} "<U%s> %s |1 # %s\n", $srcuni, unihex2utf8hex($dstuni->{unicode}), comment_for($from);
}
}
View
17 tools/yaml2perl.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Data::Dumper;
+use YAML;
+use FindBin;
+use File::Spec::Functions;
+
+$Data::Dumper::Terse++;
+
+die "Usage: $0 hoge.yaml hoge.pl" unless @ARGV==2;
+my ($src, $dst) = @ARGV;
+
+open my $fh, '>', $dst or die $!;
+print $fh Dumper(YAML::LoadFile($src));
+close $fh;
+
Please sign in to comment.
Something went wrong with that request. Please try again.