RCurl でコンテンツをそのまま受け取るための回避策

2013-03-16

(

)

RCurl というと R から libcurl を使うためのパッケージで、柔軟なリクエストを送ることができて便利ですよね。
が、コンテンツに Unicode （を表現する ASCII 文字列）を含むとそれを UTF-8 に書き換えるだけでなく、さらには \ を \ に変換してしまいます。
それによって JSON が壊れることがあります。
cf. JSON which includes Unicode characters is broken · Issue #1 · omegahat/RCurl

バイナリで読み込んだつもりなのに、Unicode の部分が UTF-8 に勝手に書き換えられるようなものです。あり得ないです。
RCurl はいろいろなところで使われているのでおそらく修正されることはないと思います。
影響範囲が大きそうなので自分がメンテナだったら別パッケージで対応しますね。

まぁ愚痴っててもしょーがないので回避策を考えました。

回避策

RCurl を使ってリクエストを送る関数で次のような処理を行います。

rcurlEnv <- getNamespace("RCurl")
mapUnicodeEscapes <- get("mapUnicodeEscapes", rcurlEnv)
unlockBinding("mapUnicodeEscapes", rcurlEnv)
assign("mapUnicodeEscapes", function(str) str, rcurlEnv)
on.exit({
    assign("mapUnicodeEscapes", mapUnicodeEscapes, rcurlEnv)
    lockBinding("mapUnicodeEscapes", rcurlEnv)
}, add = TRUE)

諸悪の根源は Content-Body を取得する際に encode という関数を呼ぶことなのですが、それによって最終的に呼ばれるのが RCurl:::mapUnicodeEscapes なのでそいつを一時的に書き換えています。
→ RCurl::URLContent の話で Rcurl::URL は直接 RCurl:::mapUnicodeEscapes を呼び出していました。また、RCurl::getURL であれば .mapUnicode 引数を FALSE にすることで回避可能です。
なお、RCurl:::mapUnicodeEscapes は次のような関数で、Unicode を含むと R_mapString という C の関数を呼ぶことがわかります。

> RCurl:::mapUnicodeEscapes
function (str, len = nchar(str) * 4L) 
{
    str = as.character(str)
    len = rep(as.integer(len), length = length(str))
    if (any(grepl("\\\\u[0-9A-Fa-f]", str))) 
        .Call("R_mapString", str, len, PACKAGE = "RCurl")
    else str
}
<environment: namespace:RCurl>

デモ

次のような JSON を読み込んで rjson でパースしてみます。

{"a":"\\\"\u0030\\\""}

まずは普通に RCurl::getURL を使ってみます。

> library(RCurl)
Loading required package: bitops
> library(rjson)
> json <- getURL("http://dev.abicky.net/hatena/rcurl/a.json")
> cat(json, fill = TRUE)
{"a":"\\"0\\""}
> fromJSON(json)
Error in fromJSON(json) : unexpected character: 0

取得した JSON が元の内容とだいぶ変わってる上にパースエラーになっています。

次に、次のような関数を定義して使ってみます。回避策で示したように RCurl:::mapUnicodeEscapes を書き換えている以外は RCurl::getURL を呼び出すだけの関数です。

myGetURL <- function(...) {
    rcurlEnv <- getNamespace("RCurl")
    mapUnicodeEscapes <- get("mapUnicodeEscapes", rcurlEnv)
    unlockBinding("mapUnicodeEscapes", rcurlEnv)
    assign("mapUnicodeEscapes", function(str) str, rcurlEnv)
    on.exit({
        assign("mapUnicodeEscapes", mapUnicodeEscapes, rcurlEnv)
        lockBinding("mapUnicodeEscapes", rcurlEnv)
    }, add = TRUE)
    return(getURL(...))
}

先ほどと同じように使ってみます。

> json <- myGetURL("http://dev.abicky.net/hatena/rcurl/a.json")
> cat(json, fill = TRUE)
{"a":"\\\"\u0030\\\""}
> fromJSON(json)
$a
[1] "\\\"0\\\""

取得した JSON は元の内容と同じですし、ちゃんとパースできてますね！

パッケージの関数を動的に書き換えることまできてしまう R ってカワイイですね！！