#!/bin/sh
 # the next line restarts using tclsh \
 exec tclsh "$0" ${1+"$@"}


 set port 1234

 proc handle_connection {client_socket host port} {
   global client_sockets counter name2socket socket2name

   set client_name "Unnamed$counter"
   incr counter

   announce "* $client_name has connected."

   lappend client_sockets $client_socket

   set name2socket($client_name) $client_socket
   set socket2name($client_socket) $client_name

   fconfigure $client_socket -buffering line
   fileevent $client_socket readable [list receive_line_from $client_socket]

   puts $client_socket "You are logged in as \"$client_name\".  Type \"help\" to see a rundown of commands."
 }

 proc receive_line_from {client_socket} {
   global client_sockets name2socket socket2name

   set client_name $socket2name($client_socket)

   if {[catch {gets $client_socket line} send_error]} {
     clean_up_client $client_socket
     announce "* $client_name has disconnected \[Error: $error\]."
     return
   } elseif {[eof $client_socket]} {
     clean_up_client $client_socket
     announce "* $client_name has disconnected \[Connection closed by client\]."
     return
   }

   if {$line == ""} {
     puts $client_socket "You must enter some command."
     return
   }

   set first_character [string index $line 0]
   set rest [string range $line 1 end]
   if {$first_character == "\""} {
     set command_name "say"
     set command_data $rest
   } elseif {$first_character == ":"} {
     set command_name "me"
     set command_data $rest
   } elseif {![regexp {^(.+?) (.*)} $line dummy command_name command_data]} {
     # If the above line fails to find a command with supplied data, then set the
     # command name to the whole string and the data to an empty string
     set command_name $line
     set command_data ""
   }


   switch -- $command_name {
     say {
       announce "$client_name says, \"$command_data\""
     }

     me {
       announce "$client_name $command_data"
     }

     who {
       puts $client_socket "The following people are online:"
       puts $client_socket "------------"
       foreach wsocket $client_sockets {
         puts $client_socket $socket2name($wsocket)
       }
       puts $client_socket "------------"
     }

     name {
       set new_name $command_data
       if {$new_name == $client_name} {
         puts $client_socket "You already are using that name."
       } elseif {[string is word $new_name] && [string length $new_name] <= 20} {
         foreach wsocket $client_sockets {
           if {$socket2name($wsocket) == $new_name} {
             puts $client_socket "That name is already in use."
             return
           }
         }

         set socket2name($client_socket) $new_name
         unset name2socket($client_name)
         set name2socket($new_name) $client_socket
         announce "* $client_name is now known as $new_name."
       } else {
         puts $client_socket "You must pick a name which is at most 20 characters long and which consists of only alphanumeric characters and underscores."
       }
     }

     help {
       puts $client_socket "Command rundown:"
       puts $client_socket "  say Hello (or) \"Hello"
       puts $client_socket "  me waves (or) :waves"
       puts $client_socket "  who"
       puts $client_socket "  name New_Name"
       puts $client_socket "  help"
     }

     default {
       puts $client_socket "Invalid command."
     }
   }
 }

 proc announce {message} {
   global client_sockets

   foreach client_socket $client_sockets {
     puts $client_socket $message
   }
 }

 proc clean_up_client {client_socket} {
   global name2socket socket2name client_sockets

   close $client_socket

   set pos [lsearch -exact $client_sockets $client_socket]
   set client_sockets [lreplace $client_sockets $pos $pos]

   unset name2socket($socket2name($client_socket)) socket2name($client_socket)
 }

 set client_sockets [list]
 array set name2socket [list]
 array set socket2name [list]

 set counter 1

 if {[catch {socket -server handle_connection $port} listen_error]} {
   puts "Failed to listen for connections on $port: $listen_error"
 } else {
   puts "Server started on port $port!"
   vwait forever
 }