脚本语言TCL教程:8

例子：042_time_date.tcl

;# 得到系统秒数

set systemTime [clock seconds]

;# 使用时间格式显示

puts "The time is: [clock format $systemTime -format %H:%M:%S]"

;# 使用日期格式显示

puts "The date is: [clock format $systemTime -format %D]"

;# 使用复杂的日期格式显示

puts [clock format $systemTime -format {Today is: %A, the %d of %B, %Y}]

;# 没有使用格式输出

puts "\n the default format for the time is: [clock format $systemTime]\n"

;# 得到两个时间，进行相减

set halBirthBook "Jan 12, 1997"

set halBirthMovie "Jan 12, 1992"

set bookSeconds [clock scan $halBirthBook]

set movieSeconds [clock scan $halBirthMovie]

puts "The book and movie versions of '2001, A Space Oddysey' had a"

puts "discrepency of [expr $bookSeconds - $movieSeconds] seconds in how"

puts "soon we would have sentient computers like the HAL 9000"

1.13：i/o通道－fblocked & fconfig

1．fblocked用于检查通道中是否有有效输入。当非阻塞(non0blocking)方式工作的时候，需要确定通道中是否有可用数据，或者判断通道是否被关闭。

2．对通道进行配置

格式：fconfigue channel ?param1 ?value1 ?param2 ?value2

如果只有单个参数，则参数值被返回；

如果提供了参数和值，则对参数进行设置

参数设置包括：

-blocking：设置工作模式是否阻塞，当通道中的数据不能被读写的时候(读的时候没有数据，写的时候缓冲区满)

-buffersize：设置缓冲区的大小，整型：10－1000000

-translation：设置输出结束符

=auto：自动，换行，回车，回车换行等都作为结束符

=binary：换行作为结束符

=cr：回车作为结束符

=crlf：回车换行作为结束符

=lf：换行作为结束符(UNIX标准)

例子：

;# 当客户端连接服务器端时，执行serverOpen

proc serverOpen {channel addr port} {

puts "channel: $channel - from Address: $addr Port: $port" ;#得到客户端连接时提供的ip和端口

puts "The default state for blocking is: [fconfigure $channel -blocking]" ;#得到是否阻塞模式

puts "The default buffer size is: [fconfigure $channel -buffersize ]" ;#得到缓冲区大小

;# Set this channel to be non-blocking.

fconfigure $channel -blocking 0 ;#设置为非阻塞模式

set bl [fconfigure $channel -blocking]

puts "After fconfigure the state for blocking is: $bl"

;# Change the buffer size to be smaller

fconfigure $channel -buffersize 12 ;#修改缓冲区大小

puts "After Fconfigure buffer size is: [fconfigure $channel -buffersize ]\n"

;# When input is available, read it.

fileevent $channel readable "readLine Server $channel" ;#注册函数readLine,当通道中有数据可读的时候执行函数

}

;# A proc to read a line from a channel

proc readLine {who channel} {

global didRead

global blocked

puts "There is input for $who on $channel"

set len [gets $channel line] ;#读数据

set blocked [fblocked $channel] ;#得到通道是否阻塞

puts "Characters Read: $len Fblocked: $blocked"

if {$len < 0} { ;#没有读到数据

if {$blocked} {puts "Input is blocked" ;#阻塞了

} else {

puts "The socket was closed - closing my end"

close $channel ;#客户端关闭连接, 非阻塞状态, 服务器端关闭通道

}

} else {

puts "Read $len characters: $line" ;#打印读出的数据

puts $channel "This is a return"

flush $channel ;#给通道一个返回信息

}

incr didRead;

puts "didRead : $didRead"

}

;# Set up a server to listen on port 33000

set server [socket -server serverOpen 33000] ;#建立服务器端

after 120 update; # This kicks MS-Windows machines for this application,更新事物

;# connect to port 33000

set sock [socket 127.0.0.1 33000] ;#建立客户端

set bl [fconfigure $sock -blocking]

set bu [fconfigure $sock -buffersize]

puts "Original setting for sock: Sock blocking: $bl buffersize: $bu"

fconfigure $sock -blocking No

fconfigure $sock -buffersize 8;

set bl [fconfigure $sock -blocking]

set bu [fconfigure $sock -buffersize]

puts "Modified setting for sock: Sock blocking: $bl buffersize: $bu\n"

# Send a line to the server -- NOTE flush

set didRead 0

puts -nonewline $sock "A Test Line"

flush $sock ;#这里触发了readLine,但是因为没有行结束符,读了个空,并且等待继续读,阻塞了,但是didRead被加成了一

# Loop until two reads have been done.

while {$didRead < 2} {

;# Wait for didRead to be set

vwait didRead

if {$blocked} {puts $sock "Newline" ; flush $sock; puts "SEND NEWLINE"} ;#这里触发readLine,读到了：A Test LineNewline，读到值后,状态变成了不阻塞,didRead被加成了二,所以这个循环只执行了一次

}

;# Read the return, and display it.

set len [gets $sock line]

puts "Return line: $len -- $line"

close $sock ;#这里触发了readLine,等待服务器端通道关闭后再关闭服务器端连接

vwait didRead

catch {close $server}

1.14：子解释器

1．子解释器相关命令

例子：

set i1 [interp create firstChild]

set i2 [interp create secondChild]

puts "first child interp: $i1"

puts "second child interp: $i2\n"

;#在两个子进程中分别设置name变量和过程nameis

foreach int [list $i1 $i2] {

interp eval $int [list set name $int]

interp eval $int {proc nameis {} {global name; return "nameis: $name";} }

}

foreach int [list $i1 $i2] {

interp eval $int "puts \"EVAL IN $int: name is \$name\""

puts "Return from 'nameis' is: [interp eval $int nameis]"

}

;#主进程中定义

proc rtnName {} {

global name

return "rtnName is: $name"

}

interp alias $i1 rtnName {} rtnName ;#在子进程i1中，定义 rtnName {} 的别名为rtnName, 但是这个过程中使用了主进程的name变量，子进程中没有这个变量,引起错误

puts ""

puts "firstChild reports [interp eval $i1 rtnName]"

1.15：数据库操作

1．这个例子是在unix下运行通过的，附带的说明已经非常详细了，所以不再另做讲解

例子：045_db.tcl

package requir Oratcl

1.16;# 也可以使用类似：Load libOratcl25.so 命令替代：函数或过程数组的输入和输出方法

1． 参看<：更多数组相关>，函数中数组的输入使用upvar的例子；

2． 函数输出数组使用方法：return [ array get op2 ]

例子：045_db.tcl

proc tryarrupvar { op1 } {

upvar $op1 op2

set op2(1) 2222

return [ array get op2 ]

}

set arr1(1) 1111

array set arr2 [ tryarrupvar arr1 ]

puts "The current arr2 is: $arr2(1)" ;# 打印出 2222

以下是bidz添加内容

1.17：info的用法

info cmdcount
返回当前的解释器已经执行的命令的个数。

info commands
info commands pattern
如果不给出模式，返回所有的命令的列表，内建和自建的。
模式是用C Shell匹配风格写成的。

info complete command
检查名是否完全，有无错误。

info default procname arg varname
procname的参数arg，是否有缺省值。

info exists varName
判断是否存在该变量。

info globals
info globals pattern
返回全局变量的列表，模式同样是用C Shell风格写成的。

info hostname
返回主机名。

info level
info level number
如果不给参数number则返回当前的在栈中的绝对位置，参
见uplevel中的描述。如加了参数number，则返回一个列表包
含了在该level上的命令名和参数。

info library
返回标准的Tcl脚本的可的路径。实际上是存在变量
tcl_library中。

info locals
info locals pattern
返回locale列表。

info procs
info procs pattern
返回所有的过程的列表。

info script
返回最里面的脚本（用 source 来执行）的文件名。

info tclversion
返回Tcl的版本号。

info vars
info vars pattern
返回当前可见的变量名的列表。