Checkin to move to davenant.#

[ircbot] / bot.tcl

#!/usr/bin/tclsh8.2

set host chiark
set port 6667
set nick Blight

set sock [socket $host $port]
fconfigure $sock -buffering line
#fconfigure $sock -translation binary
fconfigure $sock -translation crlf

proc sendout {prefix command args} {
    if {[llength $args]} {
	set la [lindex $args end]
	set args [lreplace $args end end]
	foreach i $args {
	    if {[regexp {[: ]} $i]} {
		error "bad argument in output $i ($prefix $command $args)"
	    }
	}
	lappend $args :$la
    }
    set args [lreplace $args 0 -1 $command]
    if {[string length $prefix]} {
	set args [lreplace $args 
    set string "$command"
    puts $string
    puts $sock $string
}
puts $sock "USER guest 0 * :chiark testing bot"
puts $sock "NICK $nick"

proc log {data} {
    puts $data
}

proc logerror {data} {
    log $data
}	

proc onread {args} {
    global sock saveei saveec errorInfo errorCode
    
    gets $sock line
    regsub -all "\\[^ -\176\240-\376\\]" $line ? line
    set org $line
    if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
	set line $remain
    } else {
	set prefix {}
    }
    if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
	log "bad command: $org"
	return
    }
    set command [string toupper command]
    set params {}
    while {[regexp {([^ :]+) *(.*)} $line dummy thisword line]} {
	lappend params $thisword
    }
    if {[regexp {^:(.*)} $line dummy thisword]} {
	lappend params $thisword
    } elseif {[string length $line]} {
	log "junk at end: $org"
	return
    }
    set procname msg_$command
    if {[catch {
	eval [list $procname $prefix $command] $params
    } emsg]} {
	logerror "error: $emsg ($prefix $command $params)"
	if {![regexp {^invalid command name } $emsg]} {
	    set saveei $errorInfo
	    set saveec $errorCode
	}
    }
}

proc noprefix {} {
    upvar 1 p
    if {[string length $p]} { error "prefix specified" }

proc msg_PING {p s1} {
    noprefix
    puts "PONG $s1"
}

fileevent $sock readable onread

vwait terminate