IrcObject
irc_process_keyboard_line
IrcObject - an [incr tcl] class
IrcObject object -originatorNickname something -originatorRealname something -originatorDescription something -originatorCommand something -originatorTarget something -originatorBody something -possibleCommand something -possibleTarget something -possibleBody something -serverName pluto.neosoft.com -serverPort 6667 -userName borg9 -longName {Ernest Borgnine} -nickName borg9 -useNicknames 0 -mySiteName hammer1.neosoft.com -replyTo something -defaultChannel #tcl -robotMode 0 -debug 0
inherits
object get_mySiteName
object open_connection
object set_normal_names
object send
message
object debug
text
object login
object log_message
line
object startlog
object stoplog
object process_server_line
origLine
object on
command procName target ""
object on_body
command procName target ""
object kick
channel user
object join_channel
channel
object channel
channel
object nick
user
object channel_message
channel message
object reply_message
message
object message
message
object channel_action
channel action
object action
action
object who
channel ""
object whois
nickname
object list_channel
channel ""
object topic
topic
object invite
nickname channel
object version
serverId ""
object ikill
nickname
object stats
server ""
object summon
user
object users
host
object notice
nickname text ""
object ping
args
object strace
server ""
object part
channel ""
object quit
message ""
object leave
message ""
object mode
args
object hide
args
object unhide
args
object status
message ""
object away
message ""
object alias
alias ""
object expand
args
object time
server ""
object names
channel ""
object admin
server ""
object grph
receiver message
object voice
receiver message
object xtra
receiver message
object whowas
nickname
object user
userName siteName serverName longName
object finger
user
object standard_message
messageTypeText
object process_body_commands
object display_message
object display_action
object display_notice
object announce_join
object announce_departure
object announce_new_nickname
object announce_mode
object announce_quit
object report_kickoff
object pong
args
object t
who command
object required_actions
object standard_actions
object receive_fp
object list_receive_filehandles
object read_your_server
#@package: IrcObject IrcObject # # Incr Tcl IRC Object # # Copyright (C) 1992-1997 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: irc.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # # Object for creating IRC bots. # constructor {config} { required_actions } method get_mySiteName {} { return [exec hostname] } method open_connection {} { echo "Connecting to $serverName, port $serverPort" if {[catch {set server_fps [server_open $serverName $serverPort]} result] == 1} { echo "$serverName/$serverPort: $result" exit 1 } echo "connection open" lassign $server_fps receive_fp send_fp set receiveFilehandles($this) $receive_fp } # # must be done before "user" is executed or it will have no effect # method set_normal_names {} { set userName [lindex [exec who am i] 0] set fp [open "/etc/passwd" r] while {[gets $fp line] >= 0} { set line [split $line ":"] if {[lindex $line 0] == $userName} { set longName [lindex $line 4] close $fp return } } close $fp echo "strange, you don't seem to have an entry in the password file" set longName "-- unknown --" } method send {message} { puts $send_fp $message flush $send_fp } method debug {text} { if !$debug return echo "$this> $text" } method login {} { user $userName $mySiteName $serverName $longName nick $nickName channel $defaultChannel } method log_message {line} { if !$logging return puts $logfp "[getclock] $line" flush $logfp } method startlog {} { if {$logging == 1} { echo "already logging..." return } echo "logging..." set logfp [open "irc.log" a] set logging 1 log_message "# logging begins at [fmtclock [getclock]]" } method stoplog {} { if {$logging == 0} { echo "wasn't logging." return } log_message "# logging ends at [fmtclock [getclock]]" close $logfp set logging 0 echo "logging stopped." } # # if first char of line is a colon, it's a name. # # If it's a name and it matches the server name, trim it. # If it's a name and it has a "!" in it, the stuff before # the "!" is a nickname and the stuff after is the realname. # # the command follows, then args, text portion starts with a colon. # #:Borgnine!borg9@nbrc.NeoSoft.COM PRIVMSG borgnine :woof # # # the variables that get set are: # # originatorRealname - the "real" name of the originator of the message # originatorNickname - the irc nickname of the message originator # originatorTarget - the target of the message originator # serverName # originatorBody # originatorCommand # method process_server_line {origLine} { set origLine [crange $origLine 0 end-1] log_message $origLine debug "$origLine" set nameString "" set originatorCommand "" set originatorTarget "" set originatorBody "" if ![regexp {:([^ ]*) ([^ ]*) ([^ ]*) :(.*)} $origLine dummy nameString originatorCommand originatorTarget originatorBody] { if ![regexp {:([^ ]*) ([^ ]*) :(.*)} $origLine dummy nameString originatorCommand originatorBody] { if ![regexp {:([^ ]*) ([^ ]*) (.*)} $origLine dummy nameString originatorCommand originatorTarget] { if ![regexp {([^ ]*) :(.*)} $origLine dummy originatorCommand nameString] { echo "couldn't parse line: $origLine" } } } } debug "nameString '$nameString' originatorCommand '$originatorCommand' originatorTarget '$originatorTarget' originatorBody '$originatorBody'" set originatorRealname "" set originatorNickname "" if {$nameString == "$serverName"} { set originatorRealname $serverName set originatorNickname $originatorRealname } else { set names [split $nameString "!"] if {[llength $names] == 2} { set originatorNickname [lindex $names 0] set originatorRealname [lindex $names 1] } } set originatorTarget [string tolower [string trim $originatorTarget]] if {$originatorTarget == $nickName} { set replyTo $originatorNickname } else { set replyTo $originatorTarget } if [info exists commandLists($originatorCommand)] { foreach commandInfo $commandLists($originatorCommand) { lassign $commandInfo procName target if {$target == "" || $originatorTarget == $target} { eval $procName } } } else { echo "'$origLine'" } } method on {command procName {target ""}} { lappend commandLists($command) [list $procName $target] } method on_body {command procName {target ""}} { lappend commandBodyLists($command) [list $procName $target] } method kick {channel user} { send "KICK $channel $user" } method join_channel {channel} { send "JOIN $channel" } method channel {channel} { send "JOIN $channel" set defaultChannel [string tolower $channel] return } method nick {user} { send "NICK $user" set nickName $user } method channel_message {channel message} { foreach line [split $message "\n"] { send "PRIVMSG $channel :$line" } } method reply_message {message} { channel_message $replyTo $message } method message {message} { channel_message $defaultChannel $message } method channel_action {channel action} { set text ":ACTION $action" send "PRIVMSG $channel $text" } method action {action} { channel_action $defaultChannel $action } method who {{channel ""}} { if {$channel == ""} { set channel $defaultChannel } send "WHO $channel" } method whois {nickname} { send "WHOIS $nickname" } # list_channel [channel] method list_channel {{channel ""}} { if {$channel == ""} { set channel $defaultChannel } send "LIST $channel" } # topic message method topic {topic} { send "TOPIC $topic" } # invite nickname [channel] method invite {nickname channel} { send "INVITE $nickname $channel" } # version [server_id] method version {{serverId ""}} { send "VERSION $serverId" } # ikill nickname method ikill {nickname} { send "KILL $nickname" } # stats [server] method stats {{server ""}} { send "STATS $server" } method summon {user} { send "SUMMON $user" } method users {host} { send "USERS $host" } # notice nickname text.. method notice {nickname {text ""}} { send "NOTICE $nickname $text" } # ping [daemon1] [daemon2] method ping {args} { send "PING $args" } # strace [server] method strace {{server ""}} { send "TRACE $server" } # part [channel] method part {{channel ""}} { if {$channel == ""} { set channel $defaultChannel } send "PART $channel" } # quit method quit {{message ""}} { send "QUIT $message" } method leave {{message ""}} { part $message } method mode {args} { send "MODE $args" } # hide nickname, or hide id@host method hide {args} { if {$args == ""} { send "HIDE" } else { foreach id $args { send "HIDE $id" } } } # unhide name, or unhide without args to unhide all hidden names method unhide {args} { if {$args == ""} { send "RESET" } else { foreach id $args { send "RESET $id" } } } method status {{message ""}} { send "STATUS $message" } method away {{message ""}} { send "AWAY $message" } method alias {{alias ""}} { send "ALIAS $alias" } # expand 1 or expand 0. expand without args is same as expand 0. method expand {args} { send "EXPAND $args" } # time [server] method time {{server ""}} { send "TIME $server" } # names [channel] method names {{channel ""}} { if {$channel == ""} { set channel $defaultChannel } send "NAMES $channel" } # admin [server], tell name of administrator of server method admin {{server ""}} { send "ADMIN $server" } # grph receiver message, send a graphics message to user method grph {receiver message} { send "GRPH $receiver $message" } # voice receiver message, send a voice message to user method voice {receiver message} { send "VOICE $receiver $message" } # xtra receiver message, send a program-specific message to user method xtra {receiver message} { send "XTRA $receiver $message" } method whowas {nickname} { send "WHOWAS $nickname" } method user {userName siteName serverName longName} { send "USER $userName $siteName $serverName :$longName" } method finger {user} { return [exec finger $user] } method standard_message {messageTypeText} { if {$originatorTarget != $nickName} { if {$originatorTarget == $defaultChannel} { echo $originatorDescription $messageTypeText $originatorBody } else { echo $originatorDescription $messageTypeText $originatorTarget $originatorBody } } else { echo $originatorDescription ${messageTypeText}YOU $originatorBody } return } method process_body_commands {} { set possibleBody "" if ![regexp {([^ ]*) ([^ ]*) (.*)} $originatorBody dummy possibleTarget possibleCommand possibleBody] { if ![regexp {([^ ]*) ([^ ]*)} $originatorBody dummy possibleTarget possibleCommand] { return } } debug "process_body_commands '$possibleTarget' '$possibleCommand' '$possibleBody'" if [info exists commandBodyLists($possibleCommand)] { foreach bodyPair $commandBodyLists($possibleCommand) { lassign $bodyPair procName target debug "comparing '$target' and '$possibleTarget'" if {$target == "" || $target == $possibleTarget} { eval $procName } } } } ##### display PRIVMSGs ##### method display_message {} { if {$useNicknames} { set originatorDescription $originatorNickname } else { set originatorDescription $originatorRealname } if {$originatorRealname == $serverName} { set originatorDescription ":" } standard_message "->" } method display_action {} { echo "($originatorTarget) $originatorDescription $originatorBody" } method display_notice {} { if {$useNicknames} { set originatorDescription $originatorNickname } else { set originatorDescription $originatorRealname } if {$originatorRealname == $serverName} { set originatorDescription ":" } standard_message "<NOTICE>" } ##### announce JOINs ##### method announce_join {} { echo "$originatorNickname ($originatorRealname) has joined channel $originatorBody" } ##### announce PARTs ##### method announce_departure {} { echo "$originatorNickname ($originatorRealname) has left channel $originatorBody" } ##### announce NICKs ##### method announce_new_nickname {} { echo "$originatorNickname ($originatorRealname) has changed their nickname to $originatorBody" } ##### announce MODEs ##### method announce_mode {} { echo "mode change by $originatorNickname ($originatorRealname): $originatorBody" } #### process QUIT ##### method announce_quit {} { echo "Signoff: $originatorNickname ($originatorBody)" } method report_kickoff {} { echo "$originatorNickname ($originatorRealname) was kicked off of channel $originatorBody" } # pong - respond to a ping method pong {args} { send "PONG $mySiteName" } # # t - send command to another tcl client # method t {who command} { mc $who eval $command } method required_actions {} { on PRIVMSG process_body_commands on PING pong } method standard_actions {} { on PRIVMSG display_message #on_body ACTION display_action on NOTICE display_notice on JOIN announce_join on PART announce_departure on NICK announce_new_nickname on QUIT announce_quit on KICK report_kickoff on MODE announce_mode } method receive_fp {} { return $receive_fp } method list_receive_filehandles {} { if [info exists receiveFilehandles] { return [array names receiveFilehandles] } } method read_your_server {} { } protected send_fp protected receive_fp protected logfp protected logging 0 protected commandLists protected commandBodyLists public originatorNickname public originatorRealname public originatorDescription public originatorCommand public originatorTarget public originatorBody public possibleCommand public possibleTarget public possibleBody public serverName "pluto.neosoft.com" public serverPort "6667" public userName "borg9" public longName "Ernest Borgnine" public nickName "borg9" public useNicknames 0 public mySiteName "hammer1.neosoft.com" public replyTo public defaultChannel "#tcl" public robotMode 0 public debug 0 common receiveFilehandles
irc_process_keyboard_line
irc_process_keyboard_line dummy command
if {[catch {set returnResult [eval $command]} catchResult] == 1} { echo $catchResult } else { if {$returnResult != ""} { echo $returnResult } }