URIモジュールにutf8フラグつきの文字列を食わせたらquery_formのエンコードが化けたでござるの巻
タイトル長い。っていうかそのまんまです。
#!/usr/bin/perl use strict; use warnings; use URI; my $s = 'http://example.com/?q=%82%e2%82%e9%95v%82%c5%8aw%82%d4'; utf8::upgrade($s); my $uri = URI->new($s); my %qf = $uri->query_form; $qf{flag} = 'ON'; $uri->query_form( %qf ); my $uri_str = $uri->as_string;
これ、一見すると$uri_strは
http://example.com/?q=%82%e2%82%e9%95v%82%c5%8aw%82%d4&flag=ON
になりそうなんですが、実際には
http://example.com/?q=%C2%82%C3%A2%C2%82%C3%A9%C2%95v%C2%82%C3%85%C2%8Aw%C2%82%C3%94&flag=ON
になります*1。
ここで、qの値である「%82%e2%82%e9%95v%82%c5%8aw%82%d4」は、ShiftJISの文字列です*2。
そもそも、何でわざわざ
utf8::upgrade($s);
してんの?とお思いでしょうが、ある局面を擬似的に再現するためセットしたものです。どういう局面かというと、
- XMLのある値にShiftJISがエンコードされてURLパラメータに含まれている
- XMLをXML::LibXMLで解析して取得してきた
この場合、取得される値は自動的にutf8フラグが立っています。
つまり、XML::LibXMLを通じてDOM解析して取得してきたURLを、URIモジュールを使ってquery_formメソッドでパラメータ追加したら、予期しないURLになってしまったので、それを調査したときのメモです。(ここまで前フリ)
my %qf = $uri->query_form;
この%qfをDumperしてみると、以下のようになっていました。
### %qf: { ### q => "\x{82}\x{e2}\x{82}\x{e9}\x{95}v\x{82}\x{c5}\x{8a}w\x{82}\x{d4}" ### }
qのパラメータの値はなんと、
- ShiftJISのバイナリの値を持ち、
- utf8フラグが立っている
という目を疑うような状況になっていました。
では、この値を強制的に utf8::downgrade して純粋なShiftJISバイナリにしてやろうじゃないか。
utf8::downgrade($qf{q}); $qf{flag} = 'ON'; $uri->query_form( %qf );
これでもダメ。
### $uri_str: 'http://example.com/?q=%C2%82%C3%A2%C2%82%C3%A9%C2%95v%C2%82%C3%85%C2%8Aw%C2%82%C3%94&flag=ON'
ふと気づいたんですが、
utf8::downgrade($qf{q}); $uri->query_form( q => $qf{q}, flag => 'ON' );
これだとうまくいく。
### $uri_str: 'http://example.com/?q=%82%E2%82%E9%95v%82%C5%8Aw%82%D4&flag=ON'
で、かなり深堀りしていって分かったんだけど、URI::_query という内部モジュールで、
- query_form でバイナリのままクエリストリングにしちゃう
- query で一気に置換
してるんですね。
_query.pm :
sub query { my $self = shift; $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die; if (@_) { my $q = shift; $$self = $1; if (defined $q) { $q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego; $$self .= "?$q"; } $$self .= $3; } $2; } sub query_form { my $self = shift; my $old = $self->query; if (@_) { # 略... my @query; while (my($key,$vals) = splice(@_, 0, 2)) { $key = '' unless defined $key; $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; $key =~ s/ /+/g; $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals]; for my $val (@$vals) { $val = '' unless defined $val; $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; $val =~ s/ /+/g; push(@query, "$key=$val"); } } if (@query) { unless ($delim) { $delim = $1 if $old && $old =~ /([&;])/; $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&"; } $self->query(join($delim, @query)); } else { $self->query(undef); } } return if !defined($old) || !length($old) || !defined(wantarray); return unless $old =~ /=/; # not a form map { s/\+/ /g; uri_unescape($_) } map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old); }
つまり何がいいたいかというと、文字列連結してからエンコードしてるんで、キーにutf8フラグつきの文字列が含まれているだけで、連結後の文字列はutf8フラグ立っちゃうということです。
結局、XML::LibXMLから取得した時点で、utf8::downgradeしてやれば問題なし。
my $s = $xml->findvalue('.'); utf8::downgrade($s);
・・気づけば簡単なんだけどね。
ちなみに、
$qf{flag} = 'ON';
してるところがありますが、use utf8; してると、これがあるだけで同じ症状に陥りますので、use utf8;してるなら
{ no utf8; $qf{flag} = 'ON'; }
としてやらんとダメですね。
うーんperl の unicode周りはやっぱりハマりやすいなあ・・・・
これ考えると、「基本的に use utf8; してやって、内部では基本的にutf8フラグつき文字列として扱う」というルールに単純化するのも考えものなのかもしれないですねー。utf8のpodにも基本的に必要ないのにuse utf8;すんな、って書いてあるようだし。
追記
ブクマコメントより。
id:nihen氏:
utf8::downgradeはこの場合はASCIIであることが保障されているんであれば問題ないんだけど、意味的にはEncode::encode('latin-1', $s)と同じだからutf8::encodeのほうがよいとおもうがいかがか。
本文中に%qfにShiftJISの文字列がutf8フラグつきで入っていたところがあるところでごっちゃになってしまっていました。(ここではutf8::encodeすると化けてしまうのでutf8::downgradeでないといけない)意味的には確かに utf8::encode の方が妥当ですね。ご指摘ありがとうございます。
必要ないのにuse utf8すんな、という記述はみあたらないのだけど。
utf8のpodから、
Perl に script が UTF-8 で書かれているということを教える目的以外でこのプラグマをつかってはいけません。
のあたりを読んで、「latin-1以外の文字列をUNICODEとして扱う意図がなければ、use utf8するな」と解釈したのですが、何か勘違いしてしまっていますかね?