#@package: IrcObject IrcObject

package require Itcl

#
# 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: ircbot.tcl,v 1.1.1.1 1999/03/31 20:34:40 damon Exp $
#


#
# Object for creating IRC bots.
#
itcl_class IrcObject {

    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
}

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

