2007/05/18

XMLっぽい構造をパースする

指定した範囲の内側でだけ、テキストのパターン置換をしたい。つまり、こういうことがしたい。
gosh> str
"<title>
<en>Introduction</en>
<ja>は じ め に</ja>
</title>
<p>
<en>
Here we'll discuss about english
<footnote>
<p class="footnote">
Or, any language you speak as a native tongue.
</p>
</footnote>
.
</en>
<ja>
ここでは日本語
<footnote>
<p class="footnote">
で な く て も、母 国 語 な ら な ん で も い い。
</p>
</footnote>
について説明しよう。
</ja>
</p>"


gosh> (regexp-replace-all-among-all 'ja #/\b\s\b/ str "")
"<title>
<en>Introduction</en>
<ja>はじめに</ja>
</title>
<p>
<en>
Here we'll discuss about english
<footnote>
<p class="footnote">
Or, any language you speak as a native tongue.
</p>
</footnote>
.
</en>
<ja>
ここでは日本語
<footnote>
<p class="footnote">
でなくても、母国語ならなんでもいい。
</p>
</footnote>
について説明しよう。
</ja>
</p>"


先日のような邪道な試行錯誤をしたり、再帰下降パーザについて少し勉強したりした結果、地道にパーズするのがいちばんだということがよく分かった。PerlやJaveなら優れたXML処理のライブラリを使うべきなのかもしれないね。

置換をほどこしたい領域(上の例では<ja>...</ja>の部分)を取り出すことから考えよう。その前に、XMLっぽいテキストを構成するパーツを先頭から順番に取り出してくれるプロシージャ read-xml があると仮定する。read-xml を一回呼ぶと、「<title>」や「<p class="footnote">」のようなタグ、もしくは、タグの前後の本文を、テキストの先頭から順番にゲットできる。こんな感じ。
(with-input-from-string "aaa<p>bbb</p>ccc"
(lambda ()
(read-xml) ; ⇒ aaa
(read-xml) ; ⇒ <p>
(read-xml) ; ⇒ bbb
(read-xml) ; ⇒ </p>
(read-xml) ; ⇒ ccc
))

この read-xml でひとつずつパーツを取り出してチェックしていく。探している領域を開始するタグ(いまの例では<ja>)が取り出せたら、終了を表すタグ(いまの例では</ja>)が現れるまで次々にパーツをつないでいくことで、ほしい領域が取り出せる。領域がネストしている可能性もあるので、開始タグの数もチェックしておくようにする。ざっくり書くとこんな感じ。利便性を考えて、領域の前後の文字列も返すようにした。
(define (xml-maximal-region tagname)
(define (xmltag? e)
(and (> (string-length e) 1)
(char=? #\< (string-ref e 0))))
(define (tag->name e)
(string-trim-right
(x->string (string-drop e 1))
#\>))
(define (start-tag? e)
(and (xmltag? e)
(equal? (x->string tagname)
(tag->name e))))
(define (end-tag? e)
(and (xmltag? e)
(equal? (x->string tagname)
(string-drop (tag->name e) 1))))
(define (rest-xml)
(let R ((next (read-xml)))
(if (string-null? next)
""
(string-append next (R (read-xml))))))
(define (in-region e body c before)
(cond ((string-null? e)
(error "Premature end of input -- GET-XMLTAGGED-MAXIMAL-REGION"))
((end-tag? e)
(if (= 0 c)
(values before (string-append body e) (rest-xml))
(in-region (read-xml) (string-append body e) (- c 1) before)))
((start-tag? e)
(in-region (read-xml) (string-append body e) (+ c 1) before))
(else
(in-region (read-xml) (string-append body e) c before))))
(define (out-region e body before)
(cond ((string-null? e)
(values before "" ""))
((start-tag? e)
(in-region (read-xml) e 0 before))
(else
(out-region (read-xml) body (string-append before e)))))
(out-region (read-xml) "" ""))

この xml-maximal-region を使えば、求めるプロシージャ regexp-replace-all-among-all が簡単に定義できる。
(define (regexp-replace-all-among-all region-declaration rx str sub)
(with-input-from-string str
(lambda ()
(receive (before region after)
(xml-maximal-region region-declaration)
(string-append before
(regexp-replace-all rx region sub)
(if (string-null? after)
after
(regexp-replace-all-among-all region-declaration rx after sub)))))))
あとは read-xml を書けばいい。むずかしいところはないけど面倒。長いので、全体とあわせて下記を参照。

replace-among.scm


References

「なんでも再帰」Shiro Kawai(2003/1)
http://www.shiro.dreamhost.com/scheme/docs/tailcall-j.html

『Perl & XML』:Erik T. Ray,Jason McIntosh(2002/11)
http://www.amazon.co.jp/dp/4873111064

No comments :