blog.nomadscafe.jp

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関数がうまく動くようにモジュール名を追加