ZHUOWARE BACKYARD - NOTE INDEX|ZHUOWARE BACKYARD TOP|ZHUOWARE表ページ

quote-sensitive split in Tcl

はじめに//Introduction

Tclで，文字列を空白文字で区切って一語ずつ取り出したいというだけならsplitでできる．だが，さらに「ダブルクォートではさんだ文字列は空白文字を含んでいても一語としたい」「バックスラッシュ+ダブルクォートは語に含めたい」というよくあるニーズを満たすには，どうすればいいか．

0. Tcl自体に読ませれば？

単に次のようにすればインタプリタが全部処理してくれる:

set words [eval list $line]

しかしこれは危険である．もし文字列に

 [exec cmd ...]

などが埋まっていると任意のcommandが実行されてしまう．あらかじめ [ を \[ に書き換えておけばいいかもしれないが，思いがけない危険が残りそうである．しかたなく，まじめに文字列処理することにする．

1. 正規表現でいいんでは?

1語ずつマッチさせてとっていけばいい，というアイデア．ただ，下記はバックスラッシュ+クォートがうまく読めない．正規表現で「バックスラッシュ+ダブルクォートは含んでよい」をうまく満たす書き方があるといいのだが，思いつかない．

while {[gets $fd line] >= 0} {
    set qitems {}
    while { $line != "" } {
	if { 
	    [regexp {^\"([^\"]*)\" ?(.*)$} $line dummy item rest] ||
	    [regexp {^([^ \"]*) ?(.*)$} $line dummy item rest] 
	} {
	    lappend qitems "($item)"
	    set line $rest
	    continue
	} 
	puts "format error: $line"
	break
    }
    puts $qitems
}

2. splitしてからつなぎ合わせよう

まず，ad hoc にロジックをこねてみたもの．

set sep " "
while {[gets $fd line] >= 0} {
    set words {}
    set quoting 0
    foreach w [split $line $sep] {
	set isEnd [regsub {([^\\])\"$} $w {\1} w]
	set isTop [regsub {^\"} $w "" w]
	if {! $quoting} {
	    if $isTop {
		set parts {}
		set quoting 1
	    } else {
		lappend words $w
	    }
	} 
	if $quoting {
	    lappend parts $w
	    if $isEnd {
		lappend words [join $parts $sep]
		set quoting 0
	    }
	}				
    }
    if $quoting {lappend words [join $parts $sep]}
    foreach w $words { puts -nonewline "($w)" }
    puts "="
}

次に状態遷移を明示したもの．

#           0 normal              4 cat
# 0 bare    output               append to tmp
#           ->normal             ->cat
# 1 begin   set to tmp           (error) output tmp & set to tmp
#           ->cat                -> cat
# 2 end     (error)output        append to tmp & output tmp
#           ->normal             -> normal
# 3 both    output               (error) output tmp & output
#           ->normal             -> normal
#                     x CR  output remainings, cat = 0
set isCat 0
set sep " "
while {[gets $fd line] >= 0} {
    set words {}
    foreach w [split $line $sep] {
	set isEnd [regsub {([^\\])\"$} $w {\1} w]
	set isTop [regsub {^\"} $w "" w]
	#		puts "$w: $isTop$isEnd"
	switch [expr {$isEnd * 2 + $isTop + $isCat}] {
	    1 { set part $w; set isCat 4 }
	    0 -
	    2 -
	    3 { lappend words $w }
	    4 { append part $sep $w }
	    5 { lappend words $part; set part $w }
	    6 { lappend words [append part $sep $w]; set isCat 0 }
	    7 { lappend words $part $w; set isCat 0 }
	}
    }
    if $isCat {lappend words $part}
    set isCat 0
    foreach w $words { puts -nonewline "($w)" }
    puts "="
}

これもまあ動くが，状態遷移を持ち出すとはどうもおおげさである．最終案．

set sep " "
while {[gets $fd line] >= 0} {
    set words {}
    set cnt -1
    foreach w [split $line $sep] {
	if {$cnt >= 0} {incr cnt}
	set isEnd [regsub {([^\\])\"$} $w {\1} w]
	if [regsub {^\"} $w "" w] {set cnt 0}
	lappend words $w
	if {$isEnd && $cnt >= 0} {
	    set words [lreplace $words end-$cnt end [join [lrange $words end-$cnt end] $sep]]
	    set cnt -1
	}
    }
    if {$cnt >= 0} {
	set words [lreplace $words end-$cnt end [join [lrange $words end-$cnt end] $sep]]
    }
    foreach w $words {puts -nonewline "($w)"}
}

なるべくシンプルにといろいろ考えた結果，およそ上のような形にたどりついた．もっとも，まだ網羅テストをしていないので，思いがけない考えおとしもあるかもしれないが．．．