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
	}
    }