if {![info exists sock]} {
set sock [socket -server connect 7654]
}
proc connect {sock host port} {
fconfigure $sock -blocking 0 -buffering line
fileevent $sock readable [list handleSocket $sock]
set ::socks($sock) $sock
}
#disconnect IS NOT BEING USED ANYWHERE
proc disconnect {sock args} {
set nick $::socks($sock)
unset ::socks($sock)
close $sock
sendText "* $nick has left the chat: [join $args]"
}
proc handleSocket {sock} {
gets $sock line
if {[eof $sock]} {
unset ::socks($sock) ;#Before closing socket, it needs to be unset.
close $sock
return
}
if {$line eq ""} return
if {[string index $line 0] eq "/"} {
set cmd [split $line]
set cmd [linsert $cmd 1 $sock]
if {[catch {eval $cmd} error] != 0} {
puts $sock "* $error"
return
}
} else {
sendText "$::socks($sock): $line"
}
}
proc sendText {text} {
foreach s [array names ::socks] {
puts $s $text
}
}
proc /msg {sock args} {
set found 0
if {[llength $args] < 2} {
puts $sock "* usage: /msg nick message"
return
}
set nick [lindex $args 0]
set message [join [lrange $args 1 end]]
foreach {s n} [array get ::socks] {
if {$n eq $nick} {
set found 1
break
}
}
if {$found} {
puts $s "$::socks($sock) whispers $message"
}
}
proc /nick {sock args} {
if {[llength $args] != 1} {
puts $sock "* usage: /nick newnick"
} else {
set newnick [lindex $args 0]
set ::socks($sock) $newnick
}
}
proc /who {sock args} {
if {[llength $args]} {
puts $sock "* usage: /who"
} else {
set nicks "* nicks:"
foreach {_ nick} [array get ::socks] {
append nicks " $nick"
}
}
puts $sock $nicks
}
vwait foreverSee also: A little Chat Server

