|
Tcllibにはキュー、スタック、
二分木などのアルゴリズムフリャなデータ操作を可能にするstruct
というパッケージがあります。
ここでは、そのstructパッケージを使ってスタックの操作をしてみます。
なぜスタックかというと、すぐ下で実例が出るからです。
このような状況を指して古き偉人たちは本末転倒と呼んだわけですな (威張るなや！！)
package require struct
set stack [::struct::stack]
push $stack "one"
push $stack "two"
push $stack "three"
set value [$stack pop]
set value [$stack pop]
set value [$stack pop]
|
ごくごく簡単には、上のような感じです。::struct::stack
コマンドでスタックオブジェクト(のようなもの)を作り、
そのサブコマンドpushとpop
がそれぞれの名前の通りの操作をするために使えます。
Perlなどでは、HTML文書の解析を正規表現を駆使してできるぞ、
みたいな例がたくさん知られていますが、このような例をこそ、
各プログラマがいちいちルーチンを書くことなく標準化して使えれば便利ですよね？
Tcl/Tkの世界においてそのような役割を果たさんとするのが、
このStandard Tcl LibraryがStandardと名づけられた由縁ではなかろうかしら？
と以前のページに少し書きました。
このhtmlparseもそれに供するべくTcllib 1.1で追加されたパッケージで、
これを使えばHTML文書の構文解析がとても簡単に行えます。
まずはHTMLタグを見つけては表示するだけの簡単なサンプルです。
#! C:/Wintools/tcl/tclsh83
# Tcllib htmlparse example
# 2002/03/21
package require htmlparse
set htmlfilename [lindex $argv 0]
if {"$htmlfilename" == ""} {
puts stderr "usage: $argv0 htmlfilename"
exit
}
set fin [open $htmlfilename r]
set html [read $fin]
close $fin
proc callback {tag slash param textbehind} {
puts "<$tag> <$slash> <$param> <$textbehind>"
}
::htmlparse::parse -cmd callback $html
# end.
|
まず冒頭でpackage require htmlparseを使い、
パッケージをインポートします。
構文解析は、::htmlparse::parseコマンドで行います。
構文解析するHTMLはHTML文書ファイル全体でも、少しずつ(1行ずつとか)
でも構いません。
ここでは、HTML文書全体をreadコマンドで読み、これを一度に処理しています。
::htmlparse::parseは、HTMLタグを見つけるたびに、
コールバックプロシージャをコールします。
このプロシージャは、デフォルトでは 「::htmlparse::defaultCallback」
という組み込みのものが使われますが、
これを -cmd オプションで切り替えることができます。
このプロシージャには、4つの引数が自動的につけられます。
これすなわちサンプル中の
tag、slash、param、textbehind です。それぞれ、次のような値が入って渡されます。
| tag |
HTMLタグ(BRとかIMGとか)が入っています。 |
| slash |
開くタグなら "" 、閉じるタグなら "/" (スラッシュ)が入っています。 |
| param |
タグの属性パラメータ。例えば <A HREF="index.html" BORDER="0">
というタグなら、「HREF="index.html" BORDER="0"」が入ります。 |
| textbehind |
そのタグの後ろから、別のタグが現れるまでの文字列です。
タグで囲まれた本体ということになります。改行文字も入ります。 |
コールバックプロシージャに自分で引数をつけることも可能です。
よくある例ですが、HTML文書ファイル名も一緒に渡したい場合、
次のようになります。
proc callback {filename tag slash param textbehind} {
puts "<$tag> <$slash> <$param> <$textbehind>"
}
::htmlparse::parse -cmd "callback $filename" $html
|
●タグ閉じ忘れチェッカーを作る
さて材料は出揃いました。(は？)
上でご説明したスタックとHTML構文解析を組み合わせることにより、
HTMLのタグ閉じ忘れチェッカーが作れます。
原理はとても簡単、開くタグが現れたらスタックに積み、
閉じるタグが現れたらスタックの一番上のタグを下ろしてきて、
閉じられるタグと比べます。一致してなければ、
スタックの一番上に積まれていたタグに対応する閉じるタグがない、
ということになります。
ただし、(XHTMLではなく)HTMLの規約では、IMGタグやBRタグなど、
閉じなくても問題ないタグもあるので、それらは除いておきましょう。
そんなこんなでできたのが下のスクリプトです。
便利に、というほどではありませんが、一応実用にはなります。
コマンドラインでHTMLファイルを指定するとそのファイルを、
ディレクトリを指定するとそのディレクトリにある *.htm*
という全ファイルをチェックします。
#! C:/Wintools/tcl/tclsh83
#
# HTMLタグ閉じ忘れチェッカー
# 2002/03/21
package require struct
package require htmlparse
namespace eval Parser {
# 一般に、閉じてなくてもよいタグの場合は1を、閉じてなければ
# いけないタグの場合は0を返します。
proc isoktag tag {
set oktags {IMG BR HR LI INPUT META FRAME}
if {[lsearch $oktags [string toupper $tag]] >= 0} {
return 1
} else {
return 0
}
}
proc callback {tag slash param textbehind} {
variable stack
variable lineno
variable errorcount
# HTMLの初めに仮想的につけられコールされるタグ(hmstart)は読み飛ばす
if {"$tag" == "hmstart"} {return}
if {"$slash" == "/"} {
# 終了タグの場合
while 1 {
if {[catch { set a [$stack pop] }]} { break }
set lasttag [lindex $a 0]
set lastlineno [lindex $a 1]
if {"$lasttag" != "$tag"} {
if {! [isoktag $lasttag]} {
puts "*** おおっと！タグ $lasttag\
($lastlineno)は閉じていません。($lineno)"
incr errorcount
}
# もう一度セットし直す
} else { break }
}
# puts "終了($lineno) <$tag> <$param> <[string trim $textbehind]>"
} else {
# 開始タグの場合
$stack push [list $tag $lineno]
# puts "開始($lineno) <$tag> <$param> <[string trim $textbehind]>"
}
}
proc start htmlfilename {
variable stack
variable lineno
variable errorcount 0
set stack [::struct::stack]
set fin [open $htmlfilename r]
for {set lineno 1} {! [eof $fin]} {incr lineno} {
set html [gets $fin]
::htmlparse::parse -cmd [namespace current]::callback -incvar inc -- $html
}
close $fin
puts "完了。エラー数は $errorcount"
}
}
set htmlfilename [lindex $argv 0]
if {"$htmlfilename" == ""} {
puts stderr "usage: $argv0 htmlfilename"
exit
}
if {[file isfile $htmlfilename]} {
::Parser::start $htmlfilename
} elseif {[file isdirectory $htmlfilename]} {
foreach e [glob [file join $htmlfilename *.htm*]] {
puts "********** $e **********"
::Parser::start $e
}
}
# end.
|
そこそこ使えるのですが、このままでは開始タグが複数行にわたる場合
(タグに囲まれた部分ではなくて、タグ自身が複数行に書かれているということね)、
正しく解析できないという問題があります。
これはtcllibとしても致し方ない面かもしれませんね。
●ローカルリンク切れチェッカーを作る
さて、Tcllibのパッケージどもに囲まれた生活に慣れてきましたでしょうか。
うひひひひ…(いやだなあ)
今度は、以前出てきたuriパッケージと、
このhtmlparseパッケージを使うことで、
Webサイト内の文書同士でのリンク(ローカルリンク)
の切れているものを探す、というサンプルです。
#! C:/Wintools/tcl/tclsh83
#
# Tcllib htmlparse example
# 2002/03/21
package require uri
package require htmlparse
namespace eval Parser {
# 基点となるディレクトリbasedir から相対パスrelative にあたる
# ファイル名を返します。
proc getLocalFileName {basedir relative} {
# ドライブ名が入っていると::uri::resolveや::uri::canonicalize
# がエラーになるので、ドライブ名を抜きます。
if {[regexp {^(.:)(.*)$} $basedir all drive dir]} {
} else {
set dir $basedir
set drive ""
}
# まず、そのまま連結します。
set path [file join $dir $relative]
# .や..が含まれる場合、これを正規化します。
set path [::uri::canonicalize $path]
# 最後にドライブ名をつけて戻します。
return "$drive$path"
}
# 指定されたURLについてリンク切れのチェックを行います。
# ファイルが存在しなかったらエラーを上げます。
proc checkURL {basedir url} {
# schemeがhttp(ftp,mailtoなどは除外)、
# 相対パス(ローカルリンクチェックのみ)の場合のみチェック
if {[::uri::isrelative $url]} {
array set list [::uri::split $url]
if {"$list(scheme)" == "http"} {
set filename [getLocalFileName $basedir $url]
# リンク先はファイルのことも、ディレクトリのこともあります
if {! [file exists $filename]} {
error "おおっと！ $filename ($url) は存在しません。"
}
# puts $filename
} else {
# puts "*http以外のリンク=$url"
}
} else {
# puts "*外部リンク＝$url"
}
}
# ::htmlparse::parseで、タグを見つけたときに呼ばれます。
proc callback {baseurl tag slash param textbehind} {
variable lineno
variable errorcount
if {"$slash" == "/"} {
# puts "終了($lineno) <$tag> <$param> <[string trim $textbehind]>"
} else {
# 開始タグの場合
if {[string toupper $tag] == "A"} {
if {[regexp {(HREF|href)="(.+)"} $param all dummy href]} {
if {[catch {checkURL $baseurl $href} err]} {
puts $err
incr errorcount
}
}
}
# puts "開始($lineno) <$tag> <$param> <[string trim $textbehind]>"
}
}
proc start htmlfilename {
variable lineno
variable errorcount 0
set fin [open $htmlfilename r]
for {set lineno 1} {! [eof $fin]} {incr lineno} {
set html [gets $fin]
::htmlparse::parse \
-cmd "[namespace current]::callback [file dirname $htmlfilename]" \
-incvar inc $html
}
close $fin
puts "完了。エラー数は $errorcount"
}
}
set htmlfilename [lindex $argv 0]
if {"$htmlfilename" == ""} {
puts stderr "usage: $argv0 htmlfilename"
exit
}
if {[file isfile $htmlfilename]} {
::Parser::start $htmlfilename
} elseif {[file isdirectory $htmlfilename]} {
foreach e [glob [file join $htmlfilename *.htm*]] {
puts "********** $e **********"
::Parser::start $e
}
}
# end.
|
これまた、原理はとても簡単です。
::htmlparse::parseのコールバックプロシージャで、
タグがAのとき、paramの値からリンク先を切り出します。
リンク先が相対リンクの場合、HTML文書のディレクトリと相対リンクを連結したパスを作り、
そのパスにあたるファイル(またはディレクトリ)が存在しなければリンク切れです。
…と、やりたいことは分かるのですが、個々の処理はどうやって？
そこで、uriパッケージに助けてもらえます。
::uri::splitは前にも出てきた通り、
渡したURLをプロトコル(scheme)、パス(path)、ポート(port)、?より後ろの部分(query)
に分解して、キーと値の組からなるリストで返します。
これで、(ハイパーリンクに使うことは稀と思いますが)
?より後ろのクエリーの部分を削ることができます。
::uri::isrelativeは、リンクが相対パスなら真、
そうでなければ(絶対パスなら)偽を返します。
mailto:のメールアドレスなども偽となります。
最後に::uri::canonicalizeは、
URLを正準化(正規化)します(ここではファイルパスの正準化に使っていますが)
正準化とはなんぞ？次の例を見ていただければ一発でしょう。
/home/watasi/public_html/tcl/tk/../command/index.html
↓
/home/watasi/public_html/tcl/command/index.html
このように、.や..を解決して短くします。
なお、これを応用すれば外部リンクのリンク切れもチェックできます。
その場合はTcl処理系についているhttpパッケージを使い、
リンク先のコンテンツがダウンロードできるかどうかで、
リンク切れを判断すればよいでしょう。
(first uploaded 2002/03/23 last updated 2002/08/15, MISUMI URANO - KOUKEN HEIJIMA)
| 