Catalyst::Plugin::Charsets::Japaneseで絵文字が化ける

うおー。そうだよ携帯向けサイトなのに携帯の絵文字のことをすっかり忘れてた。

でCatalyst::Plugin::Charsets::JapaneseでUTF8->SJIS変換すると絵文字が化けるわけです。

というわけで緊急で必要になったのでとりあえず対応ということでCatalyst::Plugin::Charsets::Japanese::Mobileというのを作りました。

package Catalyst::Plugin::Charsets::Japanese::Mobile;
use strict;

use Catalyst::Plugin::Charsets::Japanese;
use base qw/Class::Data::Inheritable/;
use Unicode::Japanese;
use NEXT;

__PACKAGE__->mk_classdata('charsets');
__PACKAGE__->charsets( Catalyst::Plugin::Charsets::Japanese::Mobile::Handler->new );

our $VERSION = '0.01';

sub finalize {
    my $c = shift;
    unless ( $c->response->body and not ref $c->response->body ) {
        return $c->NEXT::finalize;
    }
    unless ( $c->response->content_type =~ /^text|xml$|javascript$/ ) {
        return $c->NEXT::finalize;
    }

    my $content_type = $c->response->content_type;
    $content_type =~ s/\;\s*$//;
    $content_type =~ s/\;*\s*charset\s*\=.*$//i;
    $content_type .= sprintf("; charset=%s", $c->charsets->out->name );
    $c->response->content_type($content_type);

    my $body = $c->response->body;

    if( $c->charsets->in->name eq 'UTF-8' && utf8::is_utf8($body) ) {
        utf8::encode($body);
    }
    my $in  = $c->charsets->sjis_in($c,$c->charsets->in->abbreviation);
    my $out = $c->charsets->sjis_out($c,$c->charsets->out->method);
    
    $body = Unicode::Japanese->new($body,$in)->$out;

    $c->response->body($body);

    $c->NEXT::finalize;
}

sub prepare_parameters {
    my $c = shift;
    $c->NEXT::prepare_parameters;

    my $in  = $c->charsets->sjis_out($c,$c->charsets->in->method);
    my $out = $c->charsets->sjis_in($c,$c->charsets->out->abbreviation);

    for my $value ( values %{ $c->request->{parameters} } ) {
        if( ref $value && ref $value ne 'ARRAY' ) {
            next;
        }
        for ( ref($value) ? @{$value} : $value ) {
            $_ = Unicode::Japanese->new($_,$out)->h2zKana->$in;
            utf8::decode($_) if $c->charsets->in->name eq 'UTF-8';
        }
    }
}

sub setup {
    my $self = shift;
    $self->NEXT::setup(@_);
    my $setting = $self->config->{charsets} || 'UTF-8' ;
    if(ref $setting eq 'HASH') {
        $self->charsets->set_inner($setting->{in});
        $self->charsets->set_outer($setting->{out})
    } else {
        $self->charsets->set_inner($setting);
        $self->charsets->set_outer($setting);
    }
    if($self->debug){    
    $self->log->debug($self->charsets->in->name." is selected for inner code.");
    $self->log->debug($self->charsets->out->name." is selected for outer code.");
    }
}

sub _croak {
    my($self, $msg) = @_;
    require Carp; Carp::croak($msg);
}

package Catalyst::Plugin::Charsets::Japanese::Mobile::Handler;
use base qw/Catalyst::Plugin::Charsets::Japanese::Handler/;

sub sjis_out {
    my $self = shift;
    my $c    = shift;
    my $code = shift;
    if ( $code eq 'sjis' ) {
        # Catalyst::Plugin::MobileAgent
        $code =
            ( $c->req->mobile_agent->is_docomo )   ? 'sjis_imode'   :
            ( $c->req->mobile_agent->is_vodafone ) ? 'sjis_jsky'    :
            ( $c->req->mobile_agent->is_ezweb )    ? 'sjis_icon_au' :
                                                     'sjis'         ;
    }
    return $code;
}

sub sjis_in {
    my $self = shift;
    my $c    = shift;
    my $code = shift;
    my $out  = $self->sjis_out($c,$code);
    if ( $code eq 'sjis' ) {
        $out =~ s/_/-/g;
    }
    return $out;
}

1;

殆どCatalyst::Plugin::Charsets::Japaneseと同じような実装になってます。勝手にコピペして利用させてもらいました。# Lyoさんすみませんorz

Jcodeで変換していた部分をUnicode::Japaneseで変換するように変えました。

キャリアの判別にはCatalyst::Plugin::MobileAgentを利用しています。

あとあまりデバッグしてません。とりあえず使いながらバグが出ないか様子みます。

追記：2007/04/20

h2zの部分をh2zKanaに変更した。

Unicode::Japaneseのh2zは数値とかも全角にしてしまうみたい。