+#!/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