Reorganised so that we can have bwbridge too.

[ircbot] / bridge.tcl

diff --git a/bridge.tcl b/bridge.tcl
new file mode 100755 (executable)
index 0000000..0836203
--- /dev/null
+++ b/bridge.tcl
@@ -0,0 +1,157 @@
+# Battle.net server bridge thingy
+
+set helpfile bridgehelp
+set bnbot_callervars {nicks}
+
+source irccore.tcl
+source parsecmd.tcl
+source usebnbot.tcl
+source stdhelp.tcl
+
+proc privmsg_unlogged {p ischan params} {
+    global bots errorCode errorInfo line_org_1char
+    if {$ischan} {
+       if {[catch {
+           prefix_nick
+           set text [lindex $params 1]
+           if {"$line_org_1char" == "\001"} {
+               if {[regexp {^\?ACTION (.*)\?$} $text dummy text]} {
+                   set towrite "* $n $text"
+               } else {
+                   return
+               }
+           } else {
+               set towrite "\[$n] [lindex $params 1]"
+           }
+           foreach botid $bots {
+               upvar #0 bot/$botid/bnchan ch
+               puts $ch $towrite
+           }
+       } emsg]} {
+           log "error: $emsg $errorCode $errorInfo"
+       }
+       return 1
+    } else {
+       prefix_nick
+       execute_usercommand $p PRIVMSG $n $n \
+               [lindex $params 0] [lindex $params 1]
+       return 0
+    }
+}
+
+proc connected {} {
+    global channel
+    sendout JOIN $channel
+}
+
+proc bnnick_clean {n} {
+    if {[regexp {^[-+_0-9a-zA-Z]} $n]} { return $n }
+    return "\"$n\"";
+}
+
+def_bnbot event {l} {
+    global channel errorCode
+    if {[regexp {^1002 JOIN ([^ ]+) \w+} $l dummy n]} {
+       set bnnicks($n) 1
+       sendprivmsg $channel "[bnnick_clean $n] has joined $bnchanfn"
+    } elseif {[regexp {^1003 LEAVE ([^ ]+) \w+$} $l dummy n]} {
+       if {"$n" == "$bnnick"} return
+       catch { unset bnnicks($n) }
+       sendprivmsg $channel "[bnnick_clean $n] has left $bnchanfn"
+    } elseif {[regexp {^1004 WHISPER ([^ ]+) \w+ "(.*)"$} $l dummy n text]} {
+       if {[catch {
+           go_usercommand "$botid $n" $bnchanfn $n $n $text
+       } rv]} {
+           if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
+           bnbot_write $botid "/msg $n $rv"
+       } else {
+           set rvl {}
+           foreach mt $rv { lappend rvl [split $mt "\n"] }
+           manyset $rvl priv_msgs pub_msgs priv_acts pub_acts
+           foreach m $priv_acts { bnbot_write $botid "/msg $n The bot $m" }
+           foreach m $pub_acts { bnbot_write $botid "/me $m" }
+           foreach m $priv_msgs { bnbot_write $botid "/msg $n $m" }
+           foreach m $pub_msgs { bnbot_writemsg $botid "$n $m" }
+       }
+    } elseif {[regexp {^1001 USER ([^ ]+) \w+} $l dummy n]} {
+       if {"$n" == "$bnnick"} return
+       set bnnicks($n) 1
+    }
+}
+
+proc new_event {} {}
+
+proc msg_353 {p c dest type chan nicklist} {
+    global onchan_nicks channel nick
+    catch { unset onchan_nicks }
+    foreach n $nicklist {
+       regsub {^[@+]} $n {} n
+       if {"$n" == "$nick"} continue
+       set onchan_nicks($n) 1
+    }
+}
+
+proc tellall {msg} {
+    global bots
+    foreach botid $bots { bnbot_writemsg $botid $msg }
+}
+
+proc msg_JOIN {p c chan} {
+    global onchan_nicks
+    prefix_nick
+    tellall "$n has joined $chan"
+    set onchan_nicks($n) 1
+}
+
+proc msg_NICK {p c newnick} {
+    global onchan_nicks
+    prefix_nick
+    kill_nick $n
+    set onchan_nicks($newnick) 1
+    tellall "$n has changed nicks to $newnick"
+}
+
+proc kill_nick {n} { global onchan_nicks; catch { unset onchan_nicks($n) } }
+
+proc msg_KICK {p c chans users comment} {
+    foreach n [split $users ,] {
+       tellall "$user was kicked off $chans ($comment)"
+       kill_nick $n
+    }
+}
+proc msg_KILL {p c user why} {
+    tellall "$user was killed ($why)"
+    kill_nick $user
+}
+proc msg_PART {p c chan} {
+    prefix_nick
+    tellall "$n has left $chan"
+    kill_nick $n
+}
+proc msg_QUIT {p c why} {
+    prefix_nick
+    tellall "$n has signed off ($why)"
+    kill_nick $n
+}
+
+proc who_res {thing l} {
+    if {[llength $l]} {
+       return "$thing: [lsort -dictionary $l]"
+    } else {
+       return "$thing - empty."
+    }
+}
+
+def_bnbot who {} { who_res $bnchanfn [array names bnnicks] }
+
+def_ucmd who {
+    global bots channel onchan_nicks
+    ta_nomore
+    set o [who_res "$channel (IRC)" [array names onchan_nicks]]
+    foreach botid $bots { append o "\n" [bnbot_who $botid] }
+    return [list $o]
+}
+
+loadhelp
+ensure_connecting
+foreach botid $bots { bnbot_ensure_connecting $botid }