SOAP::Lite のバージョンアップで文字化けた

2012-10-24

Perl

perl のバージョンあげたのにともなって XMLRPC サーバーの実装につかっていた SOAP::Lite を、0.68 から最新（0.715）にあげたら、レスポンスに日本語含むやつが文字化けしつつ途中できれたXMLが返ってきてしまうという問題がおきた。

アプリが古めかしくて、アプリ内で扱う文字列が utf8 flagged な文字列ではなく binary な文字列で統一されていて、XMLRPC のレスポンス作るとこでも、

SOAP::Data->type(string => $user->name);  ## $user->name は binary string を返す

みたいなことしてた。で、SOAP::Lite 0.711（より正確には develop なバージョンである 0.71.01 ）から SOAP::Transport::HTTP#send_receive で以下のようなことをやるようになった。

if ($] < 5.008) {
    $envelope = pack( 'C0A*', $envelope );
}
else {
    require Encode;
    $envelope = Encode::encode($encoding, $envelope);
}

とにかく Encode::encode してしまう。全部の SOAP::Data#type で string つくってるとこで Encode::decode する以外に回避方法がなさげだったので、SOAP::Data#type をコピってきて上書きしてしまうクソハックで対応した。

{
    no warnings 'redefine';
    *SOAP::Data::type = sub {
        my $self = UNIVERSAL::isa($_[0] => 'SOAP::Data') ? shift->new() : SOAP::Data->new();
        if (@_) {
            $self->{_type} = shift;
            if ($self->{_type} eq 'string') {
                my $val = shift;
                $self->value(Encode::decode_utf8($val)) unless Encode::is_utf8($val);
            }
            else {
                $self->value(@_);
            }
            return $self;
        }
        if (!defined $self->{_type} && (my @types = grep {/^\{$SOAP::Constants::NS_XSI_ALL}type$/o} keys %{$self->{_attr}})) {
            $self->{_type} = (SOAP::Utils::splitlongname(delete $self->{_attr}->{shift(@types)}))[1];
        }
        return $self->{_type};
    }
}

早く内部文字列を utf8 flagged なものに統一したいけど、あちこちにちりばめられた、

Encode::is_utf8($str) && Encode::_utf8_off($str);

的なコードを改修する量が….。