次に、先ほど説明した概念に基づくテンプレート スクリプトを示します。このスクリプトでは、次を示します。
- プライベート名前空間を使用することにより、グローバル名前空間の汚染を回避 (
lshift
は名前空間foo
内のみで使用可能)。 - コマンド ライン引数の処理 (
-help
および-version
でスクリプトのバージョンを示すなど)。 -
return -error
(またはerror
) コマンドを使用して必要に応じて Tcl エラーを生成。namespace eval foo { namespace export myproc variable version 1.0 } proc foo::lshift listVar { upvar 1 $listVar L set r [lindex $L 0] set L [lreplace $L [set L 0] 0] return $r } proc foo::myproc { args } { #------------------------------------------------------- # Process command line arguments #------------------------------------------------------- set error 0 set help 0 set verbose 0 set ports {} # if {[llength $args] == 0} { incr help }; # Uncomment if necessary while {[llength $args]} { set flag [lshift args] switch -exact -- $flag { -p - -ports { set ports [lshift args] } -v - -verbose { set verbose 1 } -h - -help { incr help } -version { variable version return $version } default { if {[string match "-*" $flag]} { puts " ERROR - option '$flag' is not a valid option." incr error } else { puts "ERROR - option '$flag' is not a valid option." incr error } } } } if {$help} { set callerflag [lindex [info level [expr [info level] -1]] 0] # <-- HELP puts [format { Usage: %s [-ports|-p <listOfPorts>] [-verbose|-v] [-version] [-help|-h] Description: xxxxxxxxxxxxxxxxxxx. xxxxxxxxxxxxxxxxxxx. Example: %s -port xxxxxxxxxxxxxxx } $callerflag $callerflag ] # HELP --> return -code ok {} } # Check validity of arguments. Increment $error to generate an error if {$error} { return -code error {Oops, something is not correct} } # Do something return -code ok {} }