Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/02_regression_utf8_flag.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/02_regression_utf8_flag.t (revision 4939) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/02_regression_utf8_flag.t (revision 4939) @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More tests => 2; +use HTML::ReplacePictogramMobileJp; +use Encode; + +my $x = HTML::ReplacePictogramMobileJp->replace( + carrier => 'V', + charset => 'utf8', + html => '', + callback => sub { + my ( $unicode, $carrier ) = @_; + sprintf " $carrier", $unicode; + } +); +is $x, " V", 'return value'; +ok !Encode::is_utf8($x); + Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/98_perlcritic.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/98_perlcritic.t (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/98_perlcritic.t (revision 4899) @@ -0,0 +1,5 @@ +use strict; +use Test::More; +eval { use Test::Perl::Critic -profile => 't/perlcriticrc' }; +plan skip_all => "Test::Perl::Critic is not installed." if $@; +all_critic_ok('lib'); Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/97_podspell.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/97_podspell.t (revision 10680) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/97_podspell.t (revision 10680) @@ -0,0 +1,17 @@ +use Test::More; +eval q{ use Test::Spelling }; +plan skip_all => "Test::Spelling is not installed." if $@; +add_stopwords(map { split /[\s\:\-]/ } ); +$ENV{LANG} = 'C'; +all_pod_files_spelling_ok('lib'); +__DATA__ +Tokuhiro Matsuno +HTML::ReplacePictogramMobileJp +tokuhirom +AAJKLFJEF +GMAIL +COM +Tatsuhiko +Miyagawa +Kazuhiro +Osawa Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/99_pod.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/99_pod.t (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/99_pod.t (revision 4899) @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/perlcriticrc =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/perlcriticrc (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/perlcriticrc (revision 4899) @@ -0,0 +1,2 @@ +[TestingAndDebugging::ProhibitNoStrict] +allow=refs Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/00_compile.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/00_compile.t (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/00_compile.t (revision 4899) @@ -0,0 +1,4 @@ +use strict; +use Test::More tests => 1; + +BEGIN { use_ok 'HTML::ReplacePictogramMobileJp' } Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/01_simple.t =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/01_simple.t (revision 10678) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/t/01_simple.t (revision 10678) @@ -0,0 +1,46 @@ +use strict; +use warnings; +use Test::More tests => 18; +use HTML::ReplacePictogramMobileJp; +use Encode; +use Encode::JP::Mobile; + +is _x('I', 'utf8', encode('x-utf8-docomo', "\x{E751}")), " I"; +is _x('I', 'sjis', encode('x-sjis-docomo', "\x{E757}")), " I"; +is _x('I', 'sjis', ""), " I"; +is _x('I', 'sjis', ""), " I"; + +is _x('E', 'utf8', encode('x-utf8-ezweb', "\x{ED80}")), " E"; +is _x('E', 'utf8', ""), " E", 'kddi-utf8: kddi unicode hex cref'; +is _x('E', 'sjis', "驪"), " E", 'kddi-sjis: docomo unicode hex cref'; +is _x('E', 'sjis', ""), " E", 'kddi-sjis: kddi unicode hex cref'; +is _x('E', 'sjis', q{}), " E", ''; +is _x('E', 'utf8', q{}), " E", ''; +# is _x('E', 'sjis', encode('x-sjis-docomo', "\x{E757}")), " I", 'docomo => kddi'; +is _x('E', 'sjis', encode('x-sjis-kddi-auto', "\x{ED8D}")), " E", 'kddi-auto'; + +is _x('V', 'sjis', encode('x-sjis-softbank', "\x{E001}")), " V", 'softbank-escape'; +is _x('V', 'sjis', ""), " V", 'softbank-unicode-hex-cref-sjis'; +is _x('V', 'utf8', encode('x-utf8-softbank', "\x{E537}")), " V", 'softbank-utf8'; +is _x('V', 'utf8', ""), " V", 'softbank-utf8-hex-cref'; + +is _x('H', 'utf8', ""), " I", 'airh sjis hex cref'; +is _x('H', 'sjis', ""), " I", 'airh sjis hex cref'; +is _x('H', 'sjis', "\xf9\xfc"), " I", 'airh sjis binary'; + +sub _x { + my $carrier = shift; + my $method = shift; + my $html_ref = shift; + + HTML::ReplacePictogramMobileJp->replace( + carrier => $carrier, + charset => $method, + html => $html_ref, + callback => sub { + my ( $unicode, $carrier ) = @_; + sprintf " $carrier", $unicode; + } + ); +} + Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST (revision 4941) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST (revision 4941) @@ -0,0 +1,30 @@ +Changes +inc/Module/Install.pm +inc/Module/Install/Base.pm +inc/Module/Install/Can.pm +inc/Module/Install/Fetch.pm +inc/Module/Install/Include.pm +inc/Module/Install/Makefile.pm +inc/Module/Install/Metadata.pm +inc/Module/Install/TestBase.pm +inc/Module/Install/Win32.pm +inc/Module/Install/WriteAll.pm +inc/Spiffy.pm +inc/Test/Base.pm +inc/Test/Base/Filter.pm +inc/Test/Builder.pm +inc/Test/Builder/Module.pm +inc/Test/More.pm +lib/HTML/ReplacePictogramMobileJp.pm +lib/HTML/ReplacePictogramMobileJp/AirHPhone.pm +lib/HTML/ReplacePictogramMobileJp/Base.pm +lib/HTML/ReplacePictogramMobileJp/DoCoMo.pm +lib/HTML/ReplacePictogramMobileJp/EZweb.pm +lib/HTML/ReplacePictogramMobileJp/Vodafone.pm +Makefile.PL +MANIFEST This list of files +META.yml +README +t/00_compile.t +t/01_simple.t +t/02_regression_utf8_flag.t Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Base.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Base.pm (revision 4997) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Base.pm (revision 4997) @@ -0,0 +1,73 @@ +package HTML::ReplacePictogramMobileJp::Base; +use strict; +use warnings; +use base 'Exporter'; +our @EXPORT = qw/unicode_property unicode_hex_cref filter img_localsrc/; +use Params::Validate ':all'; +use Encode; +use Encode::JP::Mobile ':props'; +use File::ShareDir 'dist_file'; + +my $property_for = +{ + E => 'InKDDIPictograms', + I => 'InDoCoMoPictograms', + V => 'InSoftBankPictograms', +}; +sub unicode_property { + my $carrier = shift; + $_ =~ s/(\p{$property_for->{$carrier}})/callback(ord $1, $carrier)/ge; +} + +sub unicode_hex_cref { + my $carrier = shift; + $_ =~ s/&#x([A-F0-9]{4});/callback(hex $1, $carrier)/ge; +} + +sub _kddi_number2unicode_auto { + my $number = shift; + + my $fname = + File::ShareDir::dist_file( 'Encode-JP-Mobile', 'kddi-table.pl' ); + my $dat = do $fname; + for my $row (@$dat) { + if ( $row->{number} == $number ) { + return hex $row->{unicode_auto}; + } + } + return; # invalid number +} + +sub img_localsrc { + $_ =~ s{]+localsrc=["'](\d+)[^<>]+>}{ + callback(_kddi_number2unicode_auto($1), 'E'); + }ge; +} + +sub filter { + my ($charset, $decode_by, $code) = @_; + my $pkg = caller(0); + no strict 'refs'; + *{"$pkg\::$charset"} = sub { + my $class = shift; + validate( + @_, + +{ + callback => { type => CODEREF }, + html => { type => SCALAR }, + } + ); + my %args = @_; + + local $_ = decode($decode_by, $args{html}, Encode::FB_XMLCREF); + local *HTML::ReplacePictogramMobileJp::Base::callback = $args{callback}; + local *{"$pkg\::callback"} = $args{callback}; + + $code->(); + + $_ = encode($decode_by, $_); + + $_; + }; +} + +1; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/EZweb.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/EZweb.pm (revision 10677) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/EZweb.pm (revision 10677) @@ -0,0 +1,32 @@ +package HTML::ReplacePictogramMobileJp::EZweb; +use strict; +use warnings; +use HTML::ReplacePictogramMobileJp::Base; +use Encode; +use Encode::JP::Mobile ':props'; + +filter utf8 => 'x-utf8-kddi', sub { + unicode_property 'E'; + unicode_hex_cref 'E'; + img_localsrc 'E'; +}; + +# とりあえず KDDI-Auto をつかう.どっちにするべき? +filter sjis => 'x-sjis-kddi-auto', sub { + s/&#x([0-9A-F]{4});/ + my $original = $1; + # hex cref でドコモの絵文字も表示できる(sjis) + my $x = decode('cp932', pack 'H*', $original); + if ($x =~ m{(\p{InDoCoMoPictograms})}) { + HTML::ReplacePictogramMobileJp::Base::callback(ord decode('x-utf8-kddi', encode('x-utf8-kddi', $1)), 'E') + } else { + callback(hex $original, 'E') + } + /ge; + + img_localsrc 'E'; + + unicode_property 'E'; +}; + +1; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/AirHPhone.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/AirHPhone.pm (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/AirHPhone.pm (revision 4899) @@ -0,0 +1,15 @@ +package HTML::ReplacePictogramMobileJp::AirHPhone; +use strict; +use warnings; +use HTML::ReplacePictogramMobileJp::Base; + +filter utf8 => 'utf-8', sub { + unicode_hex_cref 'I'; +}; + +filter sjis => 'x-sjis-airh', sub { + unicode_property 'I'; + unicode_hex_cref 'I'; +}; + +1; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/DoCoMo.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/DoCoMo.pm (revision 10024) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/DoCoMo.pm (revision 10024) @@ -0,0 +1,23 @@ +package HTML::ReplacePictogramMobileJp::DoCoMo; +use strict; +use warnings; +use HTML::ReplacePictogramMobileJp::Base; +use Encode; + +filter utf8 => 'x-utf8-docomo', sub { + unicode_property 'I'; + unicode_hex_cref 'I'; +}; + +filter sjis => 'x-sjis-docomo', sub { + unicode_property 'I'; + unicode_hex_cref 'I'; + + s/&#([0-9]+);/ + my $original = $1; + my $x = unpack 'U*', decode 'x-sjis-imode', pack 'H*', sprintf '%x', $original; + callback($x, 'I') + /gei; +}; + +1; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Vodafone.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Vodafone.pm (revision 4938) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp/Vodafone.pm (revision 4938) @@ -0,0 +1,16 @@ +package HTML::ReplacePictogramMobileJp::Vodafone; +use strict; +use warnings; +use HTML::ReplacePictogramMobileJp::Base; + +filter utf8 => 'x-utf8-softbank', sub { + unicode_hex_cref 'V'; + unicode_property 'V'; +}; + +filter sjis => 'x-sjis-softbank', sub { + unicode_hex_cref 'V'; + unicode_property 'V'; +}; + +1; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp.pm =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp.pm (revision 10680) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/lib/HTML/ReplacePictogramMobileJp.pm (revision 10680) @@ -0,0 +1,83 @@ +package HTML::ReplacePictogramMobileJp; +use strict; +use warnings; +our $VERSION = '0.05'; +use Params::Validate ':all'; +use HTML::ReplacePictogramMobileJp::DoCoMo; +use HTML::ReplacePictogramMobileJp::EZweb; +use HTML::ReplacePictogramMobileJp::Vodafone; +use HTML::ReplacePictogramMobileJp::AirHPhone; + +my $long_name_for = +{ + I => 'DoCoMo', + E => 'EZweb', + V => 'Vodafone', + H => 'AirHPhone', +}; + +sub replace { + my $class = shift; + validate( + @_, + +{ + carrier => qr{^[IEVH]$}, + charset => qr{^(?:utf-?8|sjis)$}i, + callback => +{ type => CODEREF }, + html => +{ type => SCALAR }, + } + ); + my %args = @_; + + my $klass = join "::", __PACKAGE__, $long_name_for->{$args{carrier}}; + my $method = $args{charset} =~ /^utf-?8$/i ? 'utf8' : 'sjis'; + $klass->$method(html => $args{html}, callback => $args{callback}); +} + +1; +__END__ + +=encoding utf8 + +=for stopwords au + +=head1 NAME + +HTML::ReplacePictogramMobileJp - HTML に含まれる絵文字を置換する + +=head1 SYNOPSIS + + use HTML::ReplacePictogramMobileJp; + + HTML::ReplacePictogramMobileJp->replace( + carrier => 'I', + html => "foo", + charset => 'sjis', # or utf8 + callback => sub { + my ( $unicode, $carrier ) = @_; + # なにかする + }, + ); + +=head1 DESCRIPTION + +HTML::ReplacePictogramMobileJp は HTML に含まれる絵文字を置換するライブラリです。 +どのように置換するかは、コールバック関数で指定します。 + +=head1 AUTHOR + +Tokuhiro Matsuno Etokuhirom@gmail.comE + +=head1 THANKS TO + +Kazuhiro Osawa + +=head1 SEE ALSO + +L, L + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Makefile.PL =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Makefile.PL (revision 4998) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Makefile.PL (revision 4998) @@ -0,0 +1,13 @@ +use inc::Module::Install; +name 'HTML-ReplacePictogramMobileJp'; +all_from 'lib/HTML/ReplacePictogramMobileJp.pm'; + +requires 'Encode'; +requires 'Params::Validate'; +requires 'File::ShareDir'; +requires 'Encode::JP::Mobile' => '0.22'; + +build_requires 'Test::More'; +use_test_base; +auto_include; +WriteAll; Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Changes =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Changes (revision 10680) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/Changes (revision 10680) @@ -0,0 +1,25 @@ +Revision history for Perl extension HTML::ReplacePictogramMobileJp + +0.05 + + - ezweb can display in utf8. + (reported by yappo++) + +0.04 + + - added docomo sjis dec cref support. + +0.03 + + - au phone can display + - oops. added PREREQS. + +0.02 + + - au phone can display docomo sjis hex cref + - au phone can display kddi unicode hex cref + - softbank phone can display unicode hex cref + - oops. return value is bytes instead of unicode string. + +0.01 Fri Jan 18 20:39:18 2008 + - original version Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST.SKIP =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST.SKIP (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/MANIFEST.SKIP (revision 4899) @@ -0,0 +1,19 @@ +\bRCS\b +\bCVS\b +^MANIFEST\. +^Makefile$ +~$ +^# +\.old$ +^blib/ +^pm_to_blib +^MakeMaker-\d +\.gz$ +\.cvsignore +^t/9\d_.*\.t +^t/perlcritic +^tools/ +\.svn/ +^[^/]+\.yaml$ +^[^/]+\.pl$ +^\.shipit$ Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/README =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/README (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/README (revision 4899) @@ -0,0 +1,27 @@ +This is Perl module HTML::ReplacePictogramMobileJp. + +INSTALLATION + +HTML::ReplacePictogramMobileJp installation is straightforward. If your CPAN shell is set up, +you should just be able to do + + % cpan HTML::ReplacePictogramMobileJp + +Download it, unpack it, then build it as per the usual: + + % perl Makefile.PL + % make && make test + +Then install it: + + % make install + +DOCUMENTATION + +HTML::ReplacePictogramMobileJp documentation is available as in POD. So you can do: + + % perldoc HTML::ReplacePictogramMobileJp + +to read the documentation online with your favorite pager. + +Tokuhiro Matsuno Index: /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/.shipit =================================================================== --- /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/.shipit (revision 4899) +++ /lang/perl/HTML-ReplacePictogramMobileJp/tags/release-0.05/.shipit (revision 4899) @@ -0,0 +1,3 @@ +steps = CommitMessageWrap, FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN +svk.tagpattern = release-%v +commit_message.format = lang/perl/HTML-FilterPictogramMobileJp: %msg