## Table of Contents

IrcObject
irc_process_keyboard_line

[next] [TOC]

## Command

IrcObject - an [incr tcl] class

### Synopsis

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

### Description

    #@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

[prev] [TOC]

## Command

irc_process_keyboard_line

### Synopsis

irc_process_keyboard_line dummy command

### Description

        if {[catch {set returnResult [eval $command]} catchResult] == 1} {
    	echo $catchResult
        } else {
    	if {$returnResult != ""} {
    	    echo $returnResult
    	}
        }