SOAP::Liteパッケージに含まれるXMLRPC::Liteで自動的にutf8フラグをはずすには、XMLRPC::Deserializer::decode_valueを上書きする。
XML::Liteを使うプログラムに以下を追加
sub XMLRPC::Deserializer::decode_value {
my $self = shift;
my $ref = shift;
my($name, $attrs, $children, $value) = @$ref;
if ($name eq 'value') {
$children ? scalar(($self->decode_object($children->[0]))[1]) : pack('C0A*',$value);
} elsif ($name eq 'array') {
return [map {scalar(($self->decode_object($_))[1])} @{XMLRPC::Deserializer::o_child($children->[0]) || []}];
} elsif ($name eq 'struct') {
return {map {
my %hash = map {XMLRPC::Deserializer::o_qname($_) => $_} @{XMLRPC::Deserializer::o_child($_) || []};
# v----- scalar is required here, because 5.005 evaluates 'undef' in list context as empty array
(XMLRPC::Deserializer::o_chars($hash{name}) => scalar(($self->decode_object($hash{value}))[1]));
} @{$children || []}};
} elsif ($name eq 'base64') {
require MIME::Base64;
MIME::Base64::decode_base64($value);
} elsif ($name =~ /^(?:int|i4|boolean|string|double|dateTime\.iso8601|methodName)$/) {
$value = pack('C0A*',$value);
return $value;
} elsif ($name =~ /^(?:params)$/) {
return [map {scalar(($self->decode_object($_))[1])} @{$children || []}];
} elsif ($name =~ /^(?:methodResponse|methodCall)$/) {
return +{map {$self->decode_object($_)} @{$children || []}};
} elsif ($name =~ /^(?:param|fault)$/) {
return scalar(($self->decode_object($children->[0]))[1]);
} else {
die "wrong element '$name'\n";
}
}
7行目と20行目をいじっています。あと、o_qnameやo_chars関数がうまく動くようにモジュール名を追加
こんなテストコードで試す
#!/usr/bin/perl
use XMLRPC::Lite;
use Devel::Peek;
my $ret = XMLRPC::Lite-> proxy("http://betty.userland.com/RPC2")->call("examples.getStateName", 41)->result;
Dump($ret);
サブルーチン追加前
SV = PV(0x85683d8) at 0x8105ea8
REFCNT = 1
FLAGS = (PADBUSY,PADMY,POK,pPOK,UTF8)
PV = 0x856e8e8 "South Dakota"?0
CUR = 12
LEN = 13
サブルーチン追加後
SV = PV(0x8568270) at 0x8105ea8
REFCNT = 1
FLAGS = (PADBUSY,PADMY,POK,pPOK)
PV = 0x856e900 "South Dakota"?0
CUR = 12
LEN = 13
具合がよければ、Jcodeなどをいれて漢字コードを変えたりもできるんじゃないないでしょうか。